From 7b3c83f8d0fa289c8d90ba3a1aabb5a7e4b0383e Mon Sep 17 00:00:00 2001 From: Matthias Fischmann Date: Tue, 21 May 2024 15:57:51 +0200 Subject: [PATCH 01/64] Add conversations to full ejpd info. (#3945) Co-authored-by: Magnus Viernickel Co-authored-by: Leif Battermann Co-authored-by: Stefan Berthold --- changelog.d/5-internal/WBP7005 | 1 + integration/test/API/BrigInternal.hs | 2 +- integration/test/Test/EJPD.hs | 146 ++++++++---- .../src/Wire/API/Routes/Internal/Brig/EJPD.hs | 218 +++++++++++------- .../src/Wire/API/Routes/Internal/Galley.hs | 12 + .../unit/Test/Wire/API/Roundtrip/Aeson.hs | 2 + libs/wire-api/wire-api.cabal | 1 + .../src/Wire/GalleyAPIAccess.hs | 4 + .../src/Wire/GalleyAPIAccess/Rpc.hs | 21 ++ services/brig/src/Brig/App.hs | 2 + services/brig/src/Brig/User/EJPD.hs | 82 ++++--- services/galley/src/Galley/API/Internal.hs | 54 ++++- services/galley/src/Galley/API/Query.hs | 14 +- tools/stern/src/Stern/Intra.hs | 2 +- tools/stern/test/integration/API.hs | 2 +- 15 files changed, 395 insertions(+), 168 deletions(-) create mode 100644 changelog.d/5-internal/WBP7005 diff --git a/changelog.d/5-internal/WBP7005 b/changelog.d/5-internal/WBP7005 new file mode 100644 index 00000000000..1e85e4457e2 --- /dev/null +++ b/changelog.d/5-internal/WBP7005 @@ -0,0 +1 @@ +Adapt EJPD data to current requirements. diff --git a/integration/test/API/BrigInternal.hs b/integration/test/API/BrigInternal.hs index 71bde9877dd..e153f0e7e5b 100644 --- a/integration/test/API/BrigInternal.hs +++ b/integration/test/API/BrigInternal.hs @@ -252,7 +252,7 @@ getEJPDInfo dom handles mode = do "" -> [] "include_contacts" -> [("include_contacts", "true")] bad -> error $ show bad - submit "POST" $ req & addJSONObject ["ejpd_request" .= handles] & addQueryParams query + submit "POST" $ req & addJSONObject ["EJPDRequest" .= handles] & addQueryParams query -- https://staging-nginz-https.zinfra.io/api-internal/swagger-ui/brig/#/brig/get_i_users__uid__verification_code__action_ getVerificationCode :: (HasCallStack, MakesValue user) => user -> String -> App Response diff --git a/integration/test/Test/EJPD.hs b/integration/test/Test/EJPD.hs index 36301a9cb96..60fc67b1413 100644 --- a/integration/test/Test/EJPD.hs +++ b/integration/test/Test/EJPD.hs @@ -1,8 +1,14 @@ {-# OPTIONS -Wno-ambiguous-fields #-} -module Test.EJPD (testEJPDRequest) where + +module Test.EJPD + ( testEJPDRequest, + testEJPDRequestRemote, + ) +where import API.Brig import qualified API.BrigInternal as BI +import API.Galley import API.Gundeck import Control.Lens hiding ((.=)) import Control.Monad.Reader @@ -20,17 +26,20 @@ import Testlib.Prelude setupEJPD :: HasCallStack => App (A.Value, A.Value, A.Value, A.Value, A.Value) setupEJPD = do - (owner1, _tid1, [usr1, usr2]) <- createTeam OwnDomain 3 + (owner1, tid1, [usr1, usr2]) <- createTeam OwnDomain 3 handle1 <- liftIO $ UUID.nextRandom <&> ("usr1-handle-" <>) . UUID.toString handle2 <- liftIO $ UUID.nextRandom <&> ("usr2-handle-" <>) . UUID.toString + owner1Handle <- liftIO $ UUID.nextRandom <&> ("owner1-handle-" <>) . UUID.toString void $ putHandle usr1 handle1 void $ putHandle usr2 handle2 + void $ putHandle owner1 owner1Handle email3 <- liftIO $ UUID.nextRandom <&> \uuid -> "usr3-" <> UUID.toString uuid <> "@example.com" email4 <- liftIO $ UUID.nextRandom <&> \uuid -> "usr4-" <> UUID.toString uuid <> "@example.com" email5 <- liftIO $ UUID.nextRandom <&> \uuid -> "usr5-" <> UUID.toString uuid <> "@example.com" usr3 <- randomUser OwnDomain def {BI.email = Just email3, BI.name = Just "usr3"} usr4 <- randomUser OwnDomain def {BI.email = Just email4, BI.name = Just "usr4"} usr5 <- randomUser OwnDomain def {BI.email = Just email5, BI.name = Just "usr5"} + usrRemote <- randomUser OtherDomain def {BI.email = Nothing, BI.name = Just "usrRemote"} handle3 <- liftIO $ UUID.nextRandom <&> ("usr3-handle-" <>) . UUID.toString handle4 <- liftIO $ UUID.nextRandom <&> ("usr4-handle-" <>) . UUID.toString handle5 <- liftIO $ UUID.nextRandom <&> ("usr5-handle-" <>) . UUID.toString @@ -39,8 +48,7 @@ setupEJPD = void $ putHandle usr5 handle5 connectTwoUsers usr3 usr5 - connectTwoUsers usr2 usr4 - connectTwoUsers usr4 usr5 + connectUsers [usr2, usr4, usr5, usrRemote] toks1 <- do cl11 <- objId $ addClient (usr1 %. "qualified_id") def >>= getJSON 201 @@ -69,28 +77,52 @@ setupEJPD = a1 <- uploadDownloadProfilePicture usr1 a2 <- uploadDownloadProfilePicture usr1 pure $ snd <$> [a1, a2] - assets2 <- do - (: []) . snd <$> uploadDownloadProfilePicture usr2 - assets3 <- do - (: []) . snd <$> uploadDownloadProfilePicture usr3 - assets4 <- do - (: []) . snd <$> uploadDownloadProfilePicture usr4 - - (convs1, convs2, convs4) <- do - -- FUTUREWORKI(fisx): implement this (create both team convs and regular convs) - pure (Nothing, Nothing, Nothing) - - let usr2contacts = Just $ (,"accepted") <$> [ejpd4] + assets2 <- (: []) . snd <$> uploadDownloadProfilePicture usr2 + assets3 <- (: []) . snd <$> uploadDownloadProfilePicture usr3 + assets4 <- (: []) . snd <$> uploadDownloadProfilePicture usr4 + + (convs1, convs2, convs3, convs4, convs5) <- do + let parse :: Response -> App Value + parse resp = + getJSON 201 resp <&> \val -> + object + [ "conv_name" .= do val ^?! key (fromString "name") . _String, + "conv_id" .= do val ^?! key (fromString "qualified_id") . _Object + ] + + conv1 <- + parse + =<< postConversation usr1 do + defMLS {name = Just "11", qualifiedUsers = [], team = Just tid1} + conv12 <- + parse + =<< postConversation usr1 do + defProteus {name = Just "12", qualifiedUsers = [usr2], team = Just tid1} + conv35 <- + parse + =<< postConversation + usr3 + do defProteus {name = Just "35", qualifiedUsers = [usr5]} + conv524 <- + parse + =<< postConversation usr5 do + defProteus {name = Just "524", qualifiedUsers = [usr2, usr4]} + pure (Just ([conv1, conv12]), Just ([conv12, conv524]), Just [conv35], Just [conv524], Just [conv35, conv524]) + + assertSuccess =<< postConversation usrRemote do + defProteus {name = Just "remote245", qualifiedUsers = [usr2, usr4, usr5]} + + let usr2contacts = Just $ (,"accepted") <$> [ejpd4, ejpd5] usr3contacts = Just $ (,"accepted") <$> [ejpd5] usr4contacts = Just $ (,"accepted") <$> [ejpd2, ejpd5] - usr5contacts = Just $ (,"accepted") <$> [ejpd3, ejpd4] + usr5contacts = Just $ (,"accepted") <$> [ejpd2, ejpd3, ejpd4] - ejpd0 = mkUsr owner1 Nothing [] Nothing (Just ([ejpd1, ejpd2], "list_complete")) Nothing Nothing + ejpd0 = mkUsr owner1 (Just owner1Handle) [] Nothing (Just ([ejpd1, ejpd2], "list_complete")) Nothing Nothing ejpd1 = mkUsr usr1 (Just handle1) toks1 Nothing (Just ([ejpd0, ejpd2], "list_complete")) convs1 (Just assets1) ejpd2 = mkUsr usr2 (Just handle2) toks2 usr2contacts (Just ([ejpd0, ejpd1], "list_complete")) convs2 (Just assets2) - ejpd3 = mkUsr usr3 (Just handle3) [] usr3contacts Nothing Nothing (Just assets3) + ejpd3 = mkUsr usr3 (Just handle3) [] usr3contacts Nothing convs3 (Just assets3) ejpd4 = mkUsr usr4 (Just handle4) toks4 usr4contacts Nothing convs4 (Just assets4) - ejpd5 = mkUsr usr5 (Just handle5) [] usr5contacts Nothing Nothing Nothing + ejpd5 = mkUsr usr5 (Just handle5) [] usr5contacts Nothing convs5 Nothing pure (ejpd1, ejpd2, ejpd3, ejpd4, ejpd5) where @@ -100,44 +132,55 @@ setupEJPD = A.Value {- user -} -> Maybe String {- handle (in case usr is not up to date, we pass this separately) -} -> [String {- push tokens -}] -> + -- contacts Maybe [(A.Value {- ejpd response item of contact -}, String {- relation -})] -> + -- team contacts Maybe ([A.Value {- ejpd response item -}], String {- pagination flag -}) -> - Maybe [(String {- conv name -}, String {- conv id -})] -> + -- conversations + Maybe [A.Value] -> Maybe [String {- asset url -}] -> A.Value - mkUsr usr handle toks contacts teamContacts convs assets = result + mkUsr usr hdl toks contacts teamContacts convs assets = result where result = object [ -- (We know we have "id", but using ^? instead of ^. avoids the need for a Monoid instance for Value.) - "ejpd_response_user_id" .= (usr ^? key (fromString "id")), - "ejpd_response_team_id" .= (usr ^? key (fromString "team")), - "ejpd_response_name" .= (usr ^? key (fromString "name")), - "ejpd_response_handle" .= handle, - "ejpd_response_email" .= (usr ^? key (fromString "email")), - "ejpd_response_phone" .= (usr ^? key (fromString "phone")), - "ejpd_response_push_tokens" .= toks, - "ejpd_response_contacts" .= (trimContacts _1 <$> contacts), - "ejpd_response_team_contacts" .= (teamContacts & _Just . _1 %~ trimContacts id), - "ejpd_response_conversations" .= convs, - "ejpd_response_assets" .= assets + "UserId" .= (usr ^? key (fromString "qualified_id")), + "TeamId" .= (usr ^? key (fromString "team")), + "Name" .= (usr ^? key (fromString "name")), + "Handle" .= hdl, + "Email" .= (usr ^? key (fromString "email")), + "Phone" .= (usr ^? key (fromString "phone")), + "PushTokens" .= toks, + "Contacts" + .= let f (item, relation) = object ["contact_item" .= item, "contact_relation" .= relation] + in (map (f . trimContact _1) <$> contacts), + "TeamContacts" + .= ( teamContacts + & maybe + Null + ( \(tcs, ltyp) -> + object + [ "TeamContacts" .= (trimContact id <$> tcs), + "ListType" .= ltyp + ] + ) + ), + "Conversations" .= convs, + "Assets" .= assets ] - trimContacts :: forall x. Lens' x A.Value -> [x] -> [x] - trimContacts lns = - fmap - ( lns - %~ ( \case - trimmable@(A.Object _) -> trimItem trimmable - other -> error $ show other - ) - ) + trimContact :: forall x. Lens' x A.Value -> x -> x + trimContact lns = + lns %~ \case + trimmable@(A.Object _) -> trimItem trimmable + other -> error $ show other trimItem :: A.Value -> A.Value trimItem = - (key (fromString "ejpd_response_contacts") .~ A.Null) - . (key (fromString "ejpd_response_team_contacts") .~ A.Null) - . (key (fromString "ejpd_response_conversations") .~ A.Null) + (key (fromString "Contacts") .~ A.Null) + . (key (fromString "TeamContacts") .~ A.Null) + . (key (fromString "Conversations") .~ A.Null) testEJPDRequest :: HasCallStack => App () testEJPDRequest = do @@ -145,9 +188,9 @@ testEJPDRequest = do let check :: HasCallStack => [A.Value] -> App () check want = do - let handle = cs . (^?! (key (fromString "ejpd_response_handle") . _String)) + let handle = cs . (^?! (key (fromString "Handle") . _String)) have <- BI.getEJPDInfo OwnDomain (handle <$> want) "include_contacts" - have.json `shouldMatchSpecial` object ["ejpd_response" .= want] + have.json `shouldMatchSpecial` object ["EJPDResponse" .= want] shouldMatchSpecial :: (MakesValue a, MakesValue b, HasCallStack) => a -> b -> App () shouldMatchSpecial = shouldMatchWithRules [minBound ..] resolveAssetLinks @@ -170,3 +213,12 @@ testEJPDRequest = do check [usr2] check [usr3] check [usr4, usr5] + +testEJPDRequestRemote :: HasCallStack => App () +testEJPDRequestRemote = do + usrRemote <- randomUser OtherDomain def {BI.email = Nothing, BI.name = Just "usrRemote"} + handleRemote <- liftIO $ UUID.nextRandom <&> UUID.toString + assertSuccess =<< putHandle usrRemote handleRemote + + have <- BI.getEJPDInfo OwnDomain [handleRemote] "include_contacts" + shouldBeEmpty $ have.json %. "EJPDResponse" diff --git a/libs/wire-api/src/Wire/API/Routes/Internal/Brig/EJPD.hs b/libs/wire-api/src/Wire/API/Routes/Internal/Brig/EJPD.hs index d34bd9fb78a..38bb517cb58 100644 --- a/libs/wire-api/src/Wire/API/Routes/Internal/Brig/EJPD.hs +++ b/libs/wire-api/src/Wire/API/Routes/Internal/Brig/EJPD.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE RecordWildCards #-} + -- This file is part of the Wire Server implementation. -- -- Copyright (C) 2022 Wire Swiss GmbH @@ -21,28 +23,22 @@ module Wire.API.Routes.Internal.Brig.EJPD ( EJPDRequestBody (EJPDRequestBody, ejpdRequestBody), EJPDResponseBody (EJPDResponseBody, ejpdResponseBody), - EJPDResponseItem - ( EJPDResponseItem, - ejpdResponseUserId, - ejpdResponseTeamId, - ejpdResponseName, - ejpdResponseHandle, - ejpdResponseEmail, - ejpdResponsePhone, - ejpdResponsePushTokens, - ejpdResponseContacts, - ejpdResponseTeamContacts, - ejpdResponseConversations, - ejpdResponseAssets - ), + EJPDResponseItemRoot (..), + EJPDResponseItemLeaf (..), + EJPDConvInfo (..), + EJPDContact (..), + EJPDTeamContacts (..), + toEJPDResponseItemLeaf, ) where -import Data.Aeson hiding (json) +import Data.Aeson qualified as Aeson import Data.Handle (Handle) import Data.Id (ConvId, TeamId, UserId) -import Data.OpenApi (ToSchema) -import Deriving.Swagger (CamelToSnake, CustomSwagger (..), FieldLabelModifier, StripSuffix) +import Data.OpenApi qualified as OpenAPI +import Data.Qualified +import Data.Schema +import Data.Set as Set import Imports hiding (head) import Test.QuickCheck (Arbitrary) import Wire.API.Connection (Relation) @@ -54,69 +50,135 @@ import Wire.Arbitrary (GenericUniform (..)) newtype EJPDRequestBody = EJPDRequestBody {ejpdRequestBody :: [Handle]} deriving stock (Eq, Show, Generic) deriving (Arbitrary) via (GenericUniform EJPDRequestBody) - deriving (ToSchema) via CustomSwagger '[FieldLabelModifier (CamelToSnake, StripSuffix "_body")] EJPDRequestBody + deriving (Aeson.ToJSON, Aeson.FromJSON, OpenAPI.ToSchema) via (Schema EJPDRequestBody) -newtype EJPDResponseBody = EJPDResponseBody {ejpdResponseBody :: [EJPDResponseItem]} +newtype EJPDResponseBody = EJPDResponseBody {ejpdResponseBody :: [EJPDResponseItemRoot]} deriving stock (Eq, Show, Generic) deriving (Arbitrary) via (GenericUniform EJPDResponseBody) - deriving (ToSchema) via CustomSwagger '[FieldLabelModifier (CamelToSnake, StripSuffix "_body")] EJPDResponseBody - -data EJPDResponseItem = EJPDResponseItem - { ejpdResponseUserId :: UserId, - ejpdResponseTeamId :: Maybe TeamId, - ejpdResponseName :: Name, - ejpdResponseHandle :: Maybe Handle, - ejpdResponseEmail :: Maybe Email, - ejpdResponsePhone :: Maybe Phone, - ejpdResponsePushTokens :: Set Text, -- 'Wire.API.Push.V2.Token.Token', but that would produce an orphan instance. - ejpdResponseContacts :: Maybe (Set (Relation, EJPDResponseItem)), - ejpdResponseTeamContacts :: Maybe (Set EJPDResponseItem, NewListType), - ejpdResponseConversations :: Maybe (Set (Text, ConvId)), -- name, id - ejpdResponseAssets :: Maybe (Set Text) -- urls pointing to s3 resources + deriving (Aeson.ToJSON, Aeson.FromJSON, OpenAPI.ToSchema) via (Schema EJPDResponseBody) + +data EJPDResponseItemRoot = EJPDResponseItemRoot + { ejpdResponseRootUserId :: Qualified UserId, + ejpdResponseRootTeamId :: Maybe TeamId, + ejpdResponseRootName :: Name, + ejpdResponseRootHandle :: Maybe Handle, + ejpdResponseRootEmail :: Maybe Email, + ejpdResponseRootPhone :: Maybe Phone, + ejpdResponseRootPushTokens :: Set Text, -- 'Wire.API.Push.V2.Token.Token', but that would produce an orphan instance. + ejpdResponseRootContacts :: Maybe (Set EJPDContact), + ejpdResponseRootTeamContacts :: Maybe EJPDTeamContacts, + ejpdResponseRootConversations :: Maybe (Set EJPDConvInfo), + ejpdResponseRootAssets :: Maybe (Set Text) -- urls pointing to s3 resources + } + deriving stock (Eq, Ord, Show, Generic) + deriving (Arbitrary) via (GenericUniform EJPDResponseItemRoot) + +data EJPDResponseItemLeaf = EJPDResponseItemLeaf + { ejpdResponseLeafUserId :: Qualified UserId, + ejpdResponseLeafTeamId :: Maybe TeamId, + ejpdResponseLeafName :: Name, + ejpdResponseLeafHandle :: Maybe Handle, + ejpdResponseLeafEmail :: Maybe Email, + ejpdResponseLeafPhone :: Maybe Phone, + ejpdResponseLeafPushTokens :: Set Text, -- 'Wire.API.Push.V2.Token.Token', but that would produce an orphan instance. + ejpdResponseLeafConversations :: Maybe (Set EJPDConvInfo), + ejpdResponseLeafAssets :: Maybe (Set Text) -- urls pointing to s3 resources } deriving stock (Eq, Ord, Show, Generic) - deriving (Arbitrary) via (GenericUniform EJPDResponseItem) - deriving (ToSchema) via CustomSwagger '[FieldLabelModifier CamelToSnake] EJPDResponseItem - -instance ToJSON EJPDRequestBody where - toJSON (EJPDRequestBody hs) = object ["ejpd_request" .= hs] - -instance FromJSON EJPDRequestBody where - parseJSON = withObject "EJPDRequestBody" $ EJPDRequestBody <$$> (.: "ejpd_request") - -instance ToJSON EJPDResponseBody where - toJSON (EJPDResponseBody is) = object ["ejpd_response" .= is] - -instance FromJSON EJPDResponseBody where - parseJSON = withObject "EJPDResponseBody" $ EJPDResponseBody <$$> (.: "ejpd_response") - -instance ToJSON EJPDResponseItem where - toJSON rspi = - object - [ "ejpd_response_user_id" .= ejpdResponseUserId rspi, - "ejpd_response_team_id" .= ejpdResponseTeamId rspi, - "ejpd_response_name" .= ejpdResponseName rspi, - "ejpd_response_handle" .= ejpdResponseHandle rspi, - "ejpd_response_email" .= ejpdResponseEmail rspi, - "ejpd_response_phone" .= ejpdResponsePhone rspi, - "ejpd_response_push_tokens" .= ejpdResponsePushTokens rspi, - "ejpd_response_contacts" .= ejpdResponseContacts rspi, - "ejpd_response_team_contacts" .= ejpdResponseTeamContacts rspi, - "ejpd_response_conversations" .= ejpdResponseConversations rspi, - "ejpd_response_assets" .= ejpdResponseAssets rspi - ] - -instance FromJSON EJPDResponseItem where - parseJSON = withObject "EJPDResponseItem" $ \obj -> - EJPDResponseItem - <$> obj .: "ejpd_response_user_id" - <*> obj .:? "ejpd_response_team_id" - <*> obj .: "ejpd_response_name" - <*> obj .:? "ejpd_response_handle" - <*> obj .:? "ejpd_response_email" - <*> obj .:? "ejpd_response_phone" - <*> obj .: "ejpd_response_push_tokens" - <*> obj .:? "ejpd_response_contacts" - <*> obj .:? "ejpd_response_team_contacts" - <*> obj .:? "ejpd_response_conversations" - <*> obj .:? "ejpd_response_assets" + deriving (Arbitrary) via (GenericUniform EJPDResponseItemLeaf) + +data EJPDContact + = -- | local or remote contact with relation + EJPDContactFound + { ejpdContactRelation :: Relation, + ejpdContactFound :: EJPDResponseItemLeaf + } + deriving stock (Eq, Ord, Show, Generic) + deriving (Arbitrary) via (GenericUniform EJPDContact) + deriving (Aeson.ToJSON, Aeson.FromJSON, OpenAPI.ToSchema) via Schema EJPDContact + +data EJPDTeamContacts = EJPDTeamContacts + { ejpdTeamContacts :: Set EJPDResponseItemLeaf, + ejpdTeamContactsListType :: NewListType + } + deriving stock (Eq, Ord, Show, Generic) + deriving (Arbitrary) via (GenericUniform EJPDTeamContacts) + +data EJPDConvInfo = EJPDConvInfo {ejpdConvName :: Text, ejpdConvId :: Qualified ConvId} + deriving stock (Eq, Ord, Show, Generic) + deriving (Arbitrary) via (GenericUniform EJPDConvInfo) + deriving (Aeson.ToJSON, Aeson.FromJSON, OpenAPI.ToSchema) via Schema EJPDConvInfo + +---------------------------------------------------------------------- + +toEJPDResponseItemLeaf :: EJPDResponseItemRoot -> EJPDResponseItemLeaf +toEJPDResponseItemLeaf EJPDResponseItemRoot {..} = + EJPDResponseItemLeaf + { ejpdResponseLeafUserId = ejpdResponseRootUserId, + ejpdResponseLeafTeamId = ejpdResponseRootTeamId, + ejpdResponseLeafName = ejpdResponseRootName, + ejpdResponseLeafHandle = ejpdResponseRootHandle, + ejpdResponseLeafEmail = ejpdResponseRootEmail, + ejpdResponseLeafPhone = ejpdResponseRootPhone, + ejpdResponseLeafPushTokens = ejpdResponseRootPushTokens, + ejpdResponseLeafConversations = ejpdResponseRootConversations, + ejpdResponseLeafAssets = ejpdResponseRootAssets + } + +---------------------------------------------------------------------- + +instance ToSchema EJPDRequestBody where + schema = object "EJPDRequestBody" do + EJPDRequestBody <$> ejpdRequestBody .= field "EJPDRequest" (array schema) + +instance ToSchema EJPDResponseBody where + schema = object "EJPDResponseBody" do + EJPDResponseBody <$> ejpdResponseBody .= field "EJPDResponse" (array schema) + +instance ToSchema EJPDResponseItemRoot where + schema = object "EJPDResponseItemRoot" do + EJPDResponseItemRoot + <$> ejpdResponseRootUserId .= field "UserId" schema + <*> ejpdResponseRootTeamId .= maybe_ (optField "TeamId" schema) + <*> ejpdResponseRootName .= field "Name" schema + <*> ejpdResponseRootHandle .= maybe_ (optField "Handle" schema) + <*> ejpdResponseRootEmail .= maybe_ (optField "Email" schema) + <*> ejpdResponseRootPhone .= maybe_ (optField "Phone" schema) + <*> (Set.toList . ejpdResponseRootPushTokens) .= (Set.fromList <$> field "PushTokens" (array schema)) + <*> (fmap Set.toList . ejpdResponseRootContacts) .= (Set.fromList <$$> maybe_ (optField "Contacts" (array schema))) + <*> ejpdResponseRootTeamContacts .= maybe_ (optField "TeamContacts" schema) + <*> (fmap Set.toList . ejpdResponseRootConversations) .= (Set.fromList <$$> maybe_ (optField "Conversations" (array schema))) + <*> (fmap Set.toList . ejpdResponseRootAssets) .= (Set.fromList <$$> maybe_ (optField "Assets" (array schema))) + +instance ToSchema EJPDResponseItemLeaf where + schema = object "EJPDResponseItemLeaf" do + EJPDResponseItemLeaf + <$> ejpdResponseLeafUserId .= field "UserId" schema + <*> ejpdResponseLeafTeamId .= maybe_ (optField "TeamId" schema) + <*> ejpdResponseLeafName .= field "Name" schema + <*> ejpdResponseLeafHandle .= maybe_ (optField "Handle" schema) + <*> ejpdResponseLeafEmail .= maybe_ (optField "Email" schema) + <*> ejpdResponseLeafPhone .= maybe_ (optField "Phone" schema) + <*> (Set.toList . ejpdResponseLeafPushTokens) .= (Set.fromList <$> field "PushTokens" (array schema)) + <*> (fmap Set.toList . ejpdResponseLeafConversations) .= (Set.fromList <$$> maybe_ (optField "Conversations" (array schema))) + <*> (fmap Set.toList . ejpdResponseLeafAssets) .= (Set.fromList <$$> maybe_ (optField "Assets" (array schema))) + +instance ToSchema EJPDContact where + schema = + object "EJDPContact" do + EJPDContactFound + <$> ejpdContactRelation .= field "contact_relation" schema + <*> ejpdContactFound .= field "contact_item" schema + +instance ToSchema EJPDTeamContacts where + schema = object "EJPDTeamContacts" do + EJPDTeamContacts + <$> (Set.toList . ejpdTeamContacts) .= (Set.fromList <$> field "TeamContacts" (array schema)) + <*> ejpdTeamContactsListType .= field "ListType" schema + +instance ToSchema EJPDConvInfo where + schema = + object "EJPDConvInfo" $ + EJPDConvInfo + <$> ejpdConvName .= field "conv_name" schema + <*> ejpdConvId .= field "conv_id" schema diff --git a/libs/wire-api/src/Wire/API/Routes/Internal/Galley.hs b/libs/wire-api/src/Wire/API/Routes/Internal/Galley.hs index ff4c884ce42..8e7a8991d31 100644 --- a/libs/wire-api/src/Wire/API/Routes/Internal/Galley.hs +++ b/libs/wire-api/src/Wire/API/Routes/Internal/Galley.hs @@ -38,6 +38,7 @@ import Wire.API.Event.Conversation import Wire.API.FederationStatus import Wire.API.MakesFederatedCall import Wire.API.Provider.Service (ServiceRef) +import Wire.API.Routes.Internal.Brig.EJPD import Wire.API.Routes.Internal.Galley.ConversationsIntra import Wire.API.Routes.Internal.Galley.TeamFeatureNoConfigMulti import Wire.API.Routes.Internal.Galley.TeamsIntra @@ -269,6 +270,7 @@ type InternalAPIBase = :<|> IFeatureAPI :<|> IFederationAPI :<|> IConversationAPI + :<|> IEJPDAPI type ILegalholdWhitelistedTeamsAPI = "legalhold" @@ -691,6 +693,16 @@ type IMiscAPI = :> MultiVerb1 'DELETE '[JSON] (RespondEmpty 200 "OK") ) +type IEJPDAPI = + Named + "get-conversations-by-user" + ( CanThrow 'NotConnected + :> "user" + :> Capture "user" UserId + :> "all-conversations" + :> Get '[Servant.JSON] [EJPDConvInfo] + ) + swaggerDoc :: OpenApi swaggerDoc = toOpenApi (Proxy @InternalAPI) diff --git a/libs/wire-api/test/unit/Test/Wire/API/Roundtrip/Aeson.hs b/libs/wire-api/test/unit/Test/Wire/API/Roundtrip/Aeson.hs index aefaa6cb8cd..5e464d36dec 100644 --- a/libs/wire-api/test/unit/Test/Wire/API/Roundtrip/Aeson.hs +++ b/libs/wire-api/test/unit/Test/Wire/API/Roundtrip/Aeson.hs @@ -49,6 +49,7 @@ import Wire.API.Provider.Service qualified as Provider.Service import Wire.API.Provider.Service.Tag qualified as Provider.Service.Tag import Wire.API.Push.Token qualified as Push.Token import Wire.API.Routes.FederationDomainConfig qualified as FederationDomainConfig +import Wire.API.Routes.Internal.Brig.EJPD qualified as EJPD import Wire.API.Routes.Internal.Galley.TeamsIntra qualified as TeamsIntra import Wire.API.Routes.Version qualified as Routes.Version import Wire.API.SystemSettings qualified as SystemSettings @@ -136,6 +137,7 @@ tests = testRoundTrip @Conversation.Role.ConversationRolesList, testRoundTrip @Conversation.Typing.TypingStatus, testRoundTrip @CustomBackend.CustomBackend, + testRoundTrip @EJPD.EJPDContact, testRoundTrip @Event.Conversation.Event, testRoundTrip @Event.Conversation.EventType, testRoundTrip @Event.Conversation.SimpleMember, diff --git a/libs/wire-api/wire-api.cabal b/libs/wire-api/wire-api.cabal index 9c9087dcf58..306f27e9b37 100644 --- a/libs/wire-api/wire-api.cabal +++ b/libs/wire-api/wire-api.cabal @@ -20,6 +20,7 @@ common common-all default-extensions: AllowAmbiguousTypes BangPatterns + BlockArguments ConstraintKinds DataKinds DefaultSignatures diff --git a/libs/wire-subsystems/src/Wire/GalleyAPIAccess.hs b/libs/wire-subsystems/src/Wire/GalleyAPIAccess.hs index 09222ca2261..b039bff1303 100644 --- a/libs/wire-subsystems/src/Wire/GalleyAPIAccess.hs +++ b/libs/wire-subsystems/src/Wire/GalleyAPIAccess.hs @@ -26,6 +26,7 @@ import Imports import Network.Wai.Utilities.Error qualified as Wai import Polysemy import Wire.API.Conversation +import Wire.API.Routes.Internal.Brig.EJPD (EJPDConvInfo) import Wire.API.Routes.Internal.Galley.TeamsIntra qualified as Team import Wire.API.Team import Wire.API.Team.Conversation qualified as Conv @@ -122,5 +123,8 @@ data GalleyAPIAccess m a where Maybe ConnId -> Qualified ConvId -> GalleyAPIAccess m Conversation + GetEJPDConvInfo :: + UserId -> + GalleyAPIAccess m [EJPDConvInfo] makeSem ''GalleyAPIAccess diff --git a/libs/wire-subsystems/src/Wire/GalleyAPIAccess/Rpc.hs b/libs/wire-subsystems/src/Wire/GalleyAPIAccess/Rpc.hs index 8363fcaf4a2..e05584e9a36 100644 --- a/libs/wire-subsystems/src/Wire/GalleyAPIAccess/Rpc.hs +++ b/libs/wire-subsystems/src/Wire/GalleyAPIAccess/Rpc.hs @@ -40,6 +40,7 @@ import Servant.API (toHeader) import System.Logger.Message import Util.Options import Wire.API.Conversation hiding (Member) +import Wire.API.Routes.Internal.Brig.EJPD (EJPDConvInfo) import Wire.API.Routes.Internal.Galley.TeamsIntra qualified as Team import Wire.API.Routes.Version import Wire.API.Team @@ -86,6 +87,7 @@ interpretGalleyAPIAccessToRpc disabledVersions galleyEndpoint = GetExposeInvitationURLsToTeamAdmin id' -> getTeamExposeInvitationURLsToTeamAdmin id' IsMLSOne2OneEstablished lusr qother -> checkMLSOne2OneEstablished lusr qother UnblockConversation lusr mconn qcnv -> unblockConversation v lusr mconn qcnv + GetEJPDConvInfo uid -> getEJPDConvInfo uid galleyRequest :: (Member Rpc r, Member (Input Endpoint) r) => (Request -> Request) -> Sem r (Response (Maybe LByteString)) galleyRequest req = do @@ -574,3 +576,22 @@ unblockConversation v lusr mconn (Qualified cnv cdom) = do remote :: ByteString -> Msg -> Msg remote = field "remote" + +getEJPDConvInfo :: + forall r. + ( Member TinyLog r, + Member (Error ParseException) r, + Member (Input Endpoint) r, + Member Rpc r + ) => + UserId -> + Sem r [EJPDConvInfo] +getEJPDConvInfo uid = do + debug $ + remote "galley" + . msg (val "get conversation info for ejpd") + decodeBodyOrThrow "galley" =<< galleyRequest getReq + where + getReq = + method GET + . paths ["i", "user", toByteString' uid, "all-conversations"] diff --git a/services/brig/src/Brig/App.hs b/services/brig/src/Brig/App.hs index ad1a74c246a..5c0547b26c1 100644 --- a/services/brig/src/Brig/App.hs +++ b/services/brig/src/Brig/App.hs @@ -629,8 +629,10 @@ instance HasRequestId (AppT r) where viewFederationDomain :: (MonadReader Env m) => m Domain viewFederationDomain = view (settings . Opt.federationDomain) +-- FUTUREWORK: rename to 'qualifyLocalMtl' qualifyLocal :: (MonadReader Env m) => a -> m (Local a) qualifyLocal a = toLocalUnsafe <$> viewFederationDomain <*> pure a +-- FUTUREWORK: rename to 'qualifyLocalPoly' qualifyLocal' :: (Member (Input (Local ()))) r => a -> Sem r (Local a) qualifyLocal' a = flip toLocalUnsafe a . tDomain <$> input diff --git a/services/brig/src/Brig/User/EJPD.hs b/services/brig/src/Brig/User/EJPD.hs index e04538621c0..713d4dedc22 100644 --- a/services/brig/src/Brig/User/EJPD.hs +++ b/services/brig/src/Brig/User/EJPD.hs @@ -32,16 +32,16 @@ import Control.Lens (view, (^.)) import Data.Aeson qualified as A import Data.ByteString.Conversion import Data.Handle (Handle) -import Data.Id (UserId) +import Data.Qualified import Data.Set qualified as Set import Data.Text qualified as T import Imports hiding (head) import Network.HTTP.Types.Method -import Polysemy (Member) +import Polysemy import Servant.OpenApi.Internal.Orphans () -import Wire.API.Connection (Relation, RelationWithHistory (..), relationDropHistory) +import Wire.API.Connection import Wire.API.Push.Token qualified as PushTok -import Wire.API.Routes.Internal.Brig.EJPD (EJPDRequestBody (EJPDRequestBody), EJPDResponseBody (EJPDResponseBody), EJPDResponseItem (EJPDResponseItem)) +import Wire.API.Routes.Internal.Brig.EJPD import Wire.API.Team.Member qualified as Team import Wire.API.User import Wire.GalleyAPIAccess (GalleyAPIAccess) @@ -59,19 +59,20 @@ ejpdRequest :: EJPDRequestBody -> (Handler r) EJPDResponseBody ejpdRequest (fromMaybe False -> includeContacts) (EJPDRequestBody handles) = do - ExceptT $ Right . EJPDResponseBody . catMaybes <$> forM handles go1 + ExceptT $ Right . EJPDResponseBody . catMaybes <$> forM handles responseItemForHandle where -- find uid given handle - go1 :: Handle -> (AppT r) (Maybe EJPDResponseItem) - go1 handle = do - mbUid <- wrapClient $ lookupHandle handle + responseItemForHandle :: Handle -> (AppT r) (Maybe EJPDResponseItemRoot) + responseItemForHandle hdl = do + mbUid <- wrapClient $ lookupHandle hdl mbUsr <- maybe (pure Nothing) (wrapClient . lookupUser NoPendingInvitations) mbUid - maybe (pure Nothing) (fmap Just . go2 includeContacts) mbUsr + maybe (pure Nothing) (fmap Just . responseItemForExistingUser includeContacts) mbUsr -- construct response item given uid - go2 :: Bool -> User -> (AppT r) EJPDResponseItem - go2 reallyIncludeContacts target = do + responseItemForExistingUser :: Bool -> User -> (AppT r) EJPDResponseItemRoot + responseItemForExistingUser reallyIncludeContacts target = do let uid = userId target + luid <- qualifyLocal uid ptoks <- PushTok.tokenText . view PushTok.token <$$> liftSem (getPushTokens uid) @@ -79,15 +80,17 @@ ejpdRequest (fromMaybe False -> includeContacts) (EJPDRequestBody handles) = do mbContacts <- if reallyIncludeContacts then do - contacts :: [(UserId, RelationWithHistory)] <- - wrapClient $ Conn.lookupContactListWithRelation uid + contacts <- + wrapClient $ -- FUTUREWORK: use polysemy effect, not wrapClient + Conn.lookupContactListWithRelation uid - contactsFull :: [Maybe (Relation, EJPDResponseItem)] <- - forM contacts $ \(uid', relationDropHistory -> rel) -> do - mbUsr <- wrapClient $ lookupUser NoPendingInvitations uid' - maybe (pure Nothing) (fmap (Just . (rel,)) . go2 False) mbUsr + localContacts <- + catMaybes <$> do + forM contacts $ \(uid', relationDropHistory -> rel) -> do + mbUsr <- wrapClient $ lookupUser NoPendingInvitations uid' -- FUTUREWORK: use polysemy effect, not wrapClient + maybe (pure Nothing) (fmap (Just . EJPDContactFound rel . toEJPDResponseItemLeaf) . responseItemForExistingUser False) mbUsr - pure . Just . Set.fromList . catMaybes $ contactsFull + pure . Just . Set.fromList $ localContacts else do pure Nothing @@ -97,18 +100,24 @@ ejpdRequest (fromMaybe False -> includeContacts) (EJPDRequestBody handles) = do memberList <- liftSem $ GalleyAPIAccess.getTeamMembers tid let members = (view Team.userId <$> (memberList ^. Team.teamMembers)) \\ [uid] - contactsFull :: [Maybe EJPDResponseItem] <- + contactsFull <- forM members $ \uid' -> do mbUsr <- wrapClient $ lookupUser NoPendingInvitations uid' - maybe (pure Nothing) (fmap Just . go2 False) mbUsr + maybe (pure Nothing) (fmap Just . responseItemForExistingUser False) mbUsr + + let listType = Team.toNewListType (memberList ^. Team.teamMemberListType) - pure . Just . (,Team.toNewListType (memberList ^. Team.teamMemberListType)) . Set.fromList . catMaybes $ contactsFull + pure . Just $ + EJPDTeamContacts + (Set.fromList $ toEJPDResponseItemLeaf <$> catMaybes contactsFull) + listType _ -> do pure Nothing - mbConversations <- do - -- FUTUREWORK(fisx) - pure Nothing + mbConversations <- + if reallyIncludeContacts + then liftSem $ Just . Set.fromList <$> GalleyAPIAccess.getEJPDConvInfo uid + else pure Nothing mbAssets <- do urls <- forM (userAssets target) $ \(asset :: Asset) -> do @@ -129,15 +138,16 @@ ejpdRequest (fromMaybe False -> includeContacts) (EJPDRequestBody handles) = do something -> Just (Set.fromList something) pure $ - EJPDResponseItem - uid - (userTeam target) - (userDisplayName target) - (userHandle target) - (userEmail target) - (userPhone target) - (Set.fromList ptoks) - mbContacts - mbTeamContacts - mbConversations - mbAssets + EJPDResponseItemRoot + { ejpdResponseRootUserId = tUntagged luid, + ejpdResponseRootTeamId = userTeam target, + ejpdResponseRootName = userDisplayName target, + ejpdResponseRootHandle = userHandle target, + ejpdResponseRootEmail = userEmail target, + ejpdResponseRootPhone = userPhone target, + ejpdResponseRootPushTokens = Set.fromList ptoks, + ejpdResponseRootContacts = mbContacts, + ejpdResponseRootTeamContacts = mbTeamContacts, + ejpdResponseRootConversations = mbConversations, + ejpdResponseRootAssets = mbAssets + } diff --git a/services/galley/src/Galley/API/Internal.hs b/services/galley/src/Galley/API/Internal.hs index 27177595cac..142c6df66b7 100644 --- a/services/galley/src/Galley/API/Internal.hs +++ b/services/galley/src/Galley/API/Internal.hs @@ -14,7 +14,6 @@ -- -- You should have received a copy of the GNU Affero General Public License along -- with this program. If not, see . - module Galley.API.Internal ( internalAPI, InternalAPI, @@ -86,9 +85,11 @@ import Wire.API.Federation.API import Wire.API.Federation.API.Galley import Wire.API.Federation.Error import Wire.API.Routes.API +import Wire.API.Routes.Internal.Brig.EJPD import Wire.API.Routes.Internal.Galley import Wire.API.Routes.Internal.Galley.TeamsIntra import Wire.API.Routes.MultiTablePaging (mtpHasMore, mtpPagingState, mtpResults) +import Wire.API.Routes.MultiTablePaging qualified as MTP import Wire.API.Team.Feature hiding (setStatus) import Wire.API.User.Client import Wire.NotificationSubsystem @@ -110,6 +111,57 @@ internalAPI = <@> featureAPI <@> federationAPI <@> conversationAPI + <@> iEJPDAPI + +iEJPDAPI :: API IEJPDAPI GalleyEffects +iEJPDAPI = mkNamedAPI @"get-conversations-by-user" (callsFed (exposeAnnotations ejpdGetConvInfo)) + +-- | An unpaginated, internal http interface to `Query.conversationIdsPageFrom`. Used for +-- EJPD reports. Called locally with very little data for each conv, so we don't expect +-- pagination to ever be needed. +ejpdGetConvInfo :: + forall r p. + ( p ~ CassandraPaging, + Member ConversationStore r, + Member (Error InternalError) r, + Member (Input (Local ())) r, + Member (Input Env) r, + Member (ListItems p ConvId) r, + Member (ListItems p (Remote ConvId)) r, + Member P.TinyLog r + ) => + UserId -> + Sem r [EJPDConvInfo] +ejpdGetConvInfo uid = do + luid <- qualifyLocal uid + firstPage <- Query.conversationIdsPageFrom luid initialPageRequest + getPages luid firstPage + where + initialPageRequest = mkPageRequest (MTP.MultiTablePagingState MTP.PagingLocals Nothing) + mkPageRequest = MTP.GetMultiTablePageRequest (toRange (Proxy @1000)) . Just + + getPages :: Local UserId -> ConvIdsPage -> Sem r [EJPDConvInfo] + getPages luid page = do + let convids = MTP.mtpResults page + mk :: Data.Conversation -> Maybe EJPDConvInfo + mk conv = do + let convType = conv.convMetadata.cnvmType + ejpdConvInfo = EJPDConvInfo (fromMaybe "n/a" conv.convMetadata.cnvmName) (tUntagged $ qualifyAs luid conv.convId) + -- we don't want self conversations as they don't tell us anything about connections + -- we don't want connect conversations, because the peer has not responded yet + case convType of + RegularConv -> Just ejpdConvInfo + -- FUTUREWORK(mangoiv): with GHC 9.12 we can refactor this to or-patterns + One2OneConv -> Nothing + SelfConv -> Nothing + ConnectConv -> Nothing + renderedPage <- mapMaybe mk <$> getConversations (fst $ partitionQualified luid convids) + if MTP.mtpHasMore page + then do + newPage <- Query.conversationIdsPageFrom luid (mkPageRequest . MTP.mtpPagingState $ page) + morePages <- getPages luid newPage + pure $ renderedPage <> morePages + else pure renderedPage federationAPI :: API IFederationAPI GalleyEffects federationAPI = diff --git a/services/galley/src/Galley/API/Query.hs b/services/galley/src/Galley/API/Query.hs index f46696d34bb..5f0e76809ed 100644 --- a/services/galley/src/Galley/API/Query.hs +++ b/services/galley/src/Galley/API/Query.hs @@ -343,9 +343,7 @@ conversationIdsPageFromV2 listGlobalSelf lusr Public.GetMultiTablePageRequest {. Range 1 1000 Int32 -> Sem r Public.ConvIdsPage localsAndRemotes localDomain pagingState size = do - localPage <- - pageToConvIdPage Public.PagingLocals . fmap (`Qualified` localDomain) - <$> E.listItems (tUnqualified lusr) pagingState size + localPage <- localsOnly localDomain pagingState size let remainingSize = fromRange size - fromIntegral (length (Public.mtpResults localPage)) if Public.mtpHasMore localPage || remainingSize <= 0 then -- We haven't checked the remotes yet, so has_more must always be True here. @@ -360,6 +358,16 @@ conversationIdsPageFromV2 listGlobalSelf lusr Public.GetMultiTablePageRequest {. <> Public.mtpResults remotePage } + localsOnly :: + Domain -> + Maybe C.PagingState -> + Range 1 1000 Int32 -> + Sem r Public.ConvIdsPage + localsOnly localDomain pagingState size = + pageToConvIdPage Public.PagingLocals + . fmap (`Qualified` localDomain) + <$> E.listItems (tUnqualified lusr) pagingState size + remotesOnly :: Maybe C.PagingState -> Range 1 1000 Int32 -> diff --git a/tools/stern/src/Stern/Intra.hs b/tools/stern/src/Stern/Intra.hs index 7db21d1c5f9..79a2d1d87fc 100644 --- a/tools/stern/src/Stern/Intra.hs +++ b/tools/stern/src/Stern/Intra.hs @@ -277,7 +277,7 @@ getEjpdInfo handles includeContacts = do let bdy :: Value bdy = object - [ "ejpd_request" + [ "EJPDRequest" .= (decodeUtf8With lenientDecode . toByteString' <$> handles) ] r <- diff --git a/tools/stern/test/integration/API.hs b/tools/stern/test/integration/API.hs index 83c5827773d..14fcde3b39c 100644 --- a/tools/stern/test/integration/API.hs +++ b/tools/stern/test/integration/API.hs @@ -235,7 +235,7 @@ testEjpdInfo = do h <- randomHandle void $ setHandle uid h info <- ejpdInfo True [Handle h] - liftIO $ fmap (.ejpdResponseHandle) info.ejpdResponseBody @?= [Just (Handle h)] + liftIO $ fmap (.ejpdResponseRootHandle) info.ejpdResponseBody @?= [Just (Handle h)] testUserBlacklist :: TestM () testUserBlacklist = do From b2795825e4b8d84c81343449e082fb394813cf4d Mon Sep 17 00:00:00 2001 From: Leif Battermann Date: Wed, 22 May 2024 11:48:19 +0200 Subject: [PATCH 02/64] WPB-8757 Port flaky legalhold test from galley to integration (#4057) --- changelog.d/5-internal/WPB-8757 | 1 + integration/test/Test/LegalHold.hs | 25 ++++++++ .../test/integration/API/Teams/LegalHold.hs | 62 +------------------ 3 files changed, 27 insertions(+), 61 deletions(-) create mode 100644 changelog.d/5-internal/WPB-8757 diff --git a/changelog.d/5-internal/WPB-8757 b/changelog.d/5-internal/WPB-8757 new file mode 100644 index 00000000000..55c87d5d8e3 --- /dev/null +++ b/changelog.d/5-internal/WPB-8757 @@ -0,0 +1 @@ +Ported flaky legalhold test to the new integration test suite diff --git a/integration/test/Test/LegalHold.hs b/integration/test/Test/LegalHold.hs index 175721bf399..15104532867 100644 --- a/integration/test/Test/LegalHold.hs +++ b/integration/test/Test/LegalHold.hs @@ -912,3 +912,28 @@ testLHCannotCreateGroupWithUsersInConflict = do postConversation bob defProteus {qualifiedUsers = [debora, alice], newUsersRole = "wire_member", team = Just tidAlice} >>= assertLabel 403 "missing-legalhold-consent" + +testNoConsentCannotBeInvited :: HasCallStack => App () +testNoConsentCannotBeInvited = do + -- team that is legalhold whitelisted + (legalholder, tidLH, userLHNotActivated : _) <- createTeam OwnDomain 2 + legalholdWhitelistTeam tidLH legalholder >>= assertStatus 200 + + -- team without legalhold + (peer, _tidPeer, peer2 : _) <- createTeam OwnDomain 2 + + connectUsers =<< forM [peer, userLHNotActivated] make + connectUsers =<< forM [peer2, userLHNotActivated] make + + withMockServer lhMockApp \lhDomAndPort _chan -> do + postLegalHoldSettings tidLH legalholder (mkLegalHoldSettings lhDomAndPort) >>= assertStatus 201 + cid <- postConversation userLHNotActivated defProteus {qualifiedUsers = [legalholder], newUsersRole = "wire_admin", team = Just tidLH} >>= getJSON 201 + addMembers userLHNotActivated cid (def {users = [peer], role = Just "wire_admin"}) >>= assertSuccess + -- activate legalhold for legalholder + requestLegalHoldDevice tidLH legalholder legalholder >>= assertSuccess + approveLegalHoldDevice tidLH (legalholder %. "qualified_id") defPassword >>= assertSuccess + legalholdUserStatus tidLH legalholder legalholder `bindResponse` \resp -> do + resp.status `shouldMatchInt` 200 + resp.json %. "status" `shouldMatch` "enabled" + + addMembers userLHNotActivated cid (def {users = [peer2]}) >>= assertLabel 403 "missing-legalhold-consent" diff --git a/services/galley/test/integration/API/Teams/LegalHold.hs b/services/galley/test/integration/API/Teams/LegalHold.hs index c9a3118bcf6..57dfd9f43b0 100644 --- a/services/galley/test/integration/API/Teams/LegalHold.hs +++ b/services/galley/test/integration/API/Teams/LegalHold.hs @@ -31,9 +31,7 @@ import Control.Concurrent.Chan import Control.Lens hiding ((#)) import Data.Id import Data.LegalHold -import Data.List.NonEmpty (NonEmpty (..)) import Data.PEM -import Data.Qualified (Qualified (..)) import Data.Range import Data.Time.Clock qualified as Time import Galley.Cassandra.LegalHold @@ -42,19 +40,16 @@ import Imports import Network.HTTP.Types.Status (status200, status404) import Network.Wai as Wai import Network.Wai.Handler.Warp qualified as Warp -import Network.Wai.Utilities.Error qualified as Error import Test.QuickCheck.Instances () import Test.Tasty import Test.Tasty.HUnit import TestHelpers import TestSetup import Wire.API.Connection qualified as Conn -import Wire.API.Conversation.Role (roleNameWireAdmin) import Wire.API.Provider.Service import Wire.API.Routes.Internal.Brig.Connection import Wire.API.Team.LegalHold import Wire.API.Team.Member -import Wire.API.Team.Member qualified as Team import Wire.API.Team.Permission import Wire.API.Team.Role import Wire.API.User.Client @@ -79,19 +74,7 @@ testsPublic s = GET /team/{tid}/members - show legal hold status of all members -} - testGroup - "settings.legalholdEnabledTeams" -- FUTUREWORK: ungroup this level - [ testGroup -- FUTUREWORK: ungroup this level - "teams listed" - [ testGroup - "Users are invited to a group conversation." - [ testGroup - "The group conversation contains legalhold activated users." - [testOnlyIfLhWhitelisted s "If any user in the invite has not given consent then the invite fails" testNoConsentCannotBeInvited] - ], - test s "bench hack" testBenchHack - ] - ] + test s "settings.legalholdEnabledTeams teams liested bench hack" testBenchHack ] testsInternal :: IO TestSetup -> TestTree @@ -273,49 +256,6 @@ testCannotCreateLegalHoldDeviceOldAPI = do data GroupConvInvCase = InviteOnlyConsenters | InviteAlsoNonConsenters deriving (Show, Eq, Ord, Bounded, Enum) -testNoConsentCannotBeInvited :: HasCallStack => TestM () -testNoConsentCannotBeInvited = do - localDomain <- viewFederationDomain - -- team that is legalhold whitelisted - (legalholder :: UserId, tid) <- createBindingTeam - userLHNotActivated <- (^. Team.userId) <$> addUserToTeam legalholder tid - putLHWhitelistTeam tid !!! const 200 === statusCode - - -- team without legalhold - (peer :: UserId, teamPeer) <- createBindingTeam - let qpeer = Qualified peer localDomain - peer2 <- (^. Team.userId) <$> addUserToTeam peer teamPeer - let qpeer2 = Qualified peer2 localDomain - - do - postConnection userLHNotActivated peer !!! const 201 === statusCode - void $ putConnection peer userLHNotActivated Conn.Accepted do - convId <- createTeamConvWithRole userLHNotActivated tid [legalholder] (Just "corp + us") Nothing Nothing roleNameWireAdmin - let qconvId = Qualified convId localDomain - - API.Util.postMembers userLHNotActivated (pure qpeer) qconvId - !!! const 200 === statusCode - - -- activate legalhold for legalholder - do - galley <- viewGalley - requestLegalHoldDevice legalholder legalholder tid !!! testResponse 201 Nothing - approveLegalHoldDevice (Just defPassword) legalholder legalholder tid !!! testResponse 200 Nothing - UserLegalHoldStatusResponse userStatus _ _ <- getUserStatusTyped' galley legalholder tid - liftIO $ assertEqual "approving should change status" UserLegalHoldEnabled userStatus - - API.Util.postMembers userLHNotActivated (pure qpeer2) qconvId - >>= errWith 403 (\err -> Error.label err == "missing-legalhold-consent") - - localdomain <- viewFederationDomain - API.Util.postQualifiedMembers userLHNotActivated (Qualified peer2 localdomain :| []) qconvId - >>= errWith 403 (\err -> Error.label err == "missing-legalhold-consent") - testBenchHack :: HasCallStack => TestM () testBenchHack = do {- representative sample run on an old laptop: From 5af4c2909c82a48887d620d621d36ebde65810e3 Mon Sep 17 00:00:00 2001 From: Stefan Matting Date: Wed, 22 May 2024 12:47:59 +0200 Subject: [PATCH 03/64] Update docs: Migrated Helm charts (#3931) (#4058) --- changelog.d/4-docs/WPB-7036 | 1 + charts/wire-server/values.yaml | 3 -- .../install/infrastructure-configuration.md | 14 +++--- docs/src/how-to/install/sft.md | 43 +++++-------------- docs/src/how-to/install/troubleshooting.md | 31 +++++++------ docs/src/how-to/install/web-app-settings.md | 35 +++++++-------- docs/src/understand/mls.md | 13 +++--- 7 files changed, 51 insertions(+), 89 deletions(-) create mode 100644 changelog.d/4-docs/WPB-7036 diff --git a/changelog.d/4-docs/WPB-7036 b/changelog.d/4-docs/WPB-7036 new file mode 100644 index 00000000000..0a261a1dfc9 --- /dev/null +++ b/changelog.d/4-docs/WPB-7036 @@ -0,0 +1 @@ +Adjust documentation for migrated helm charts diff --git a/charts/wire-server/values.yaml b/charts/wire-server/values.yaml index 7e41eca7838..f0488133713 100644 --- a/charts/wire-server/values.yaml +++ b/charts/wire-server/values.yaml @@ -6,11 +6,8 @@ # services: true tags: - team-settings: false - account-pages: false legalhold: false federation: false # see also galley.config.enableFederation and brig.config.enableFederation - sftd: false backoffice: false mlsstats: false integration: false diff --git a/docs/src/how-to/install/infrastructure-configuration.md b/docs/src/how-to/install/infrastructure-configuration.md index 14e00853828..a9cf8f4941d 100644 --- a/docs/src/how-to/install/infrastructure-configuration.md +++ b/docs/src/how-to/install/infrastructure-configuration.md @@ -581,19 +581,15 @@ In case of a demo install, replace `prod` with `demo`. First set the option under the `team-settings` section, `envVars` sub-section: ```yaml -# NOTE: Only relevant if you want team-settings -team-settings: - envVars: - IS_SELF_HOSTED: "true" +envVars: + IS_SELF_HOSTED: "true" ``` -Second, also set the option under the `account-pages` section: +Second, also set the option for `account-pages` helm chart: ```yaml -# NOTE: Only relevant if you want account-pages -account-pages: - envVars: - IS_SELF_HOSTED: "true" +envVars: + IS_SELF_HOSTED: "true" ``` (auth-cookie-config)= diff --git a/docs/src/how-to/install/sft.md b/docs/src/how-to/install/sft.md index dec1f3bf113..a8b7bfeaf86 100644 --- a/docs/src/how-to/install/sft.md +++ b/docs/src/how-to/install/sft.md @@ -8,28 +8,23 @@ Please refer to the following {ref}`section to better understand SFT and how it ### As part of the wire-server umbrella chart -`` sftd` `` will be installed as part of the `wire-server` umbrella chart if you set `tags.sftd: true` +The `sftd` is packaged as its own Helm chart. -In your `./values/wire-server/values.yaml` file you should set the following settings: +In your `./values/sftd/values.yaml` file you should set the following settings: ```yaml -tags: - sftd: true - -sftd: - host: sftd.example.com # Replace example.com with your domain - allowOrigin: https://webapp.example.com # Should be the address you used for the webapp deployment (Note: you must include the uri scheme "https://") +host: sftd.example.com # Replace example.com with your domain +allowOrigin: https://webapp.example.com # Should be the address you used for the webapp deployment (Note: you must include the uri scheme "https://") ``` In your `secrets.yaml` you should set the TLS keys for sftd domain: ```yaml -sftd: - tls: - crt: | - - key: | - +tls: + crt: | + + key: | + ``` You should also make sure that you configure brig to know about the SFT server in your `./values/wire-server/values.yaml` file: @@ -46,23 +41,6 @@ Now you can deploy as usual: helm upgrade wire-server wire/wire-server --values ./values/wire-server/values.yaml ``` -### Standalone - -The SFT component is also shipped as a separate helm chart. Installation is similar to installing -the charts as in {ref}`helm-prod`. - -Some people might want to run SFT separately, because the deployment lifecycle for the SFT is a bit more intricate. For example, -if you want to avoid dropping calls during an upgrade, you'd set the `terminationGracePeriodSeconds` of the SFT to a high number, to wait -for calls to drain before updating to the new version (See [technical documentation](https://github.com/wireapp/wire-server/blob/develop/charts/sftd/README.md)). that would cause your otherwise snappy upgrade of the `wire-server` chart to now take a long time, as it waits for all -the SFT servers to drain. If this is a concern for you, we advice installing `sftd` as a separate chart. - -It is important that you disable `sftd` in the `wire-server` umbrella chart, by setting this in your `./values/wire-server/values.yaml` file - -```yaml -tags: - sftd: false -``` - By default `sftd` doesn't need to set that many options, so we define them inline. However, you could of course also set these values in a `values.yaml` file. SFT will deploy a Kubernetes Ingress on `$SFTD_HOST`. Make sure that the domain name `$SFTD_HOST` points to your ingress IP as set up in {ref}`helm-prod`. The SFT also needs to be made aware of the domain name of the webapp that you set up in {ref}`helm-prod` for setting up the appropriate CSP headers. @@ -75,8 +53,7 @@ export WEBAPP_HOST=webapp.example.com Now you can install the chart: ```shell -helm upgrade --install sftd wire/sftd --set -helm install sftd wire/sftd \ +helm install sftd sftd \ --set host=$SFTD_HOST \ --set allowOrigin=https://$WEBAPP_HOST \ --set-file tls.crt=/path/to/tls.crt \ diff --git a/docs/src/how-to/install/troubleshooting.md b/docs/src/how-to/install/troubleshooting.md index b4220bd45f9..3eb1fe2a64f 100644 --- a/docs/src/how-to/install/troubleshooting.md +++ b/docs/src/how-to/install/troubleshooting.md @@ -7,22 +7,21 @@ If you have installed wire-server, but the web application page in your browser In the file that you use as override when running `helm install/update -f ` (using the webapp as an example): ```yaml -webapp: - # ... other settings... - envVars: - # ... other environment variables ... - CSP_EXTRA_CONNECT_SRC: "https://*.example.com, wss://*.example.com" - CSP_EXTRA_IMG_SRC: "https://*.example.com" - CSP_EXTRA_SCRIPT_SRC: "https://*.example.com" - CSP_EXTRA_DEFAULT_SRC: "https://*.example.com" - CSP_EXTRA_FONT_SRC: "https://*.example.com" - CSP_EXTRA_FRAME_SRC: "https://*.example.com" - CSP_EXTRA_MANIFEST_SRC: "https://*.example.com" - CSP_EXTRA_OBJECT_SRC: "https://*.example.com" - CSP_EXTRA_MEDIA_SRC: "https://*.example.com" - CSP_EXTRA_PREFETCH_SRC: "https://*.example.com" - CSP_EXTRA_STYLE_SRC: "https://*.example.com" - CSP_EXTRA_WORKER_SRC: "https://*.example.com" +# ... other settings... +envVars: + # ... other environment variables ... + CSP_EXTRA_CONNECT_SRC: "https://*.example.com, wss://*.example.com" + CSP_EXTRA_IMG_SRC: "https://*.example.com" + CSP_EXTRA_SCRIPT_SRC: "https://*.example.com" + CSP_EXTRA_DEFAULT_SRC: "https://*.example.com" + CSP_EXTRA_FONT_SRC: "https://*.example.com" + CSP_EXTRA_FRAME_SRC: "https://*.example.com" + CSP_EXTRA_MANIFEST_SRC: "https://*.example.com" + CSP_EXTRA_OBJECT_SRC: "https://*.example.com" + CSP_EXTRA_MEDIA_SRC: "https://*.example.com" + CSP_EXTRA_PREFETCH_SRC: "https://*.example.com" + CSP_EXTRA_STYLE_SRC: "https://*.example.com" + CSP_EXTRA_WORKER_SRC: "https://*.example.com" ``` For more info, you can have a look at respective charts values files, i.e.: diff --git a/docs/src/how-to/install/web-app-settings.md b/docs/src/how-to/install/web-app-settings.md index 5746780c13b..4dbc66da3a5 100644 --- a/docs/src/how-to/install/web-app-settings.md +++ b/docs/src/how-to/install/web-app-settings.md @@ -6,14 +6,13 @@ Wire desktop app is based on Electron and renders Wire web app in a chromium-bas When this flag is set to true it will prevent the web app from running in a standard browser and require the Wire desktop app for running Wire web app. -To enforce desktop application only add the following to your Helm overrides in `values/wire-server/values.yaml`: +To enforce desktop application only add the following to your configuration of the `webapp` chart: ```yaml -webapp: +# ... +envVars: # ... - envVars: - # ... - FEATURE_ENABLE_ENFORCE_DESKTOP_APPLICATION_ONLY: "true" + FEATURE_ENABLE_ENFORCE_DESKTOP_APPLICATION_ONLY: "true" ``` ## Enforce constant bit rate @@ -22,40 +21,36 @@ By default Wire users can choose, whether to use constant bit rate (CBR) or vari Since there is a theoretical risk of information leakage through packet size analysis when using Opus with variable bitrate encoding during audio calls, CBR can be fully enforced for 1:1 calls in the web app, too. -To enforce CBR add the following to your Helm overrides in `values/wire-server/values.yaml`: +To enforce CBR add the following to your config: ```yaml -webapp: +envVars: # ... - envVars: - # ... - FEATURE_ENFORCE_CONSTANT_BITRATE: "true" + FEATURE_ENFORCE_CONSTANT_BITRATE: "true" ``` ## Disable media plugins Wire is built for media plugins to be active in the chat windows so that users don't have to click the link and leave the app. In some cases it may be desired that these plugins get disabled by default. With this setting all media plugins, including but not limited to YouTube, Spotify, Soundcloud, and Vimeo can be disabled. -To disable media plugins add the following to your Helm overrides in `values/wire-server/values.yaml`: +To disable media plugins add the following to your configuration: ```yaml -webapp: +# ... +envVars: # ... - envVars: - # ... - FEATURE_ENABLE_MEDIA_EMBEDS: "false" + FEATURE_ENABLE_MEDIA_EMBEDS: "false" ``` ## Enable extra entropy (only on Windows) The Wire desktop application uses system-dependent source of random bits as an internal entropy source when generating cryptographic keys. In certain cases it may be desired to enable externally generated entropy derived from mouse movement. This option only affects Windows users. -To enable additional entropy during client creation add the following to your Helm overrides in `values/wire-server/values.yaml`: +To enable additional entropy during client creation add the following to your configuration: ```yaml -webapp: +# ... +envVars: # ... - envVars: - # ... - FEATURE_ENABLE_EXTRA_CLIENT_ENTROPY: "true" + FEATURE_ENABLE_EXTRA_CLIENT_ENTROPY: "true" ``` diff --git a/docs/src/understand/mls.md b/docs/src/understand/mls.md index a762741eacf..99e26c2f2dd 100644 --- a/docs/src/understand/mls.md +++ b/docs/src/understand/mls.md @@ -49,22 +49,19 @@ brig: setEnableMLS: true ``` -Finally, the web applications need to be made aware of *MLS*. This is done by +Finally, the webapp needs to enable made aware of *MLS*. This is done by setting the following environment variable for the web application: ```yaml -webapp: - envVars: - FEATURE_ENABLE_MLS: "true" +envVars: + FEATURE_ENABLE_MLS: "true" ``` and for the team settings web application: ```yaml -# NOTE: Only relevant if you want team-settings -team-settings: - envVars: - FEATURE_ENABLE_MLS: "true" +envVars: + FEATURE_ENABLE_MLS: "true" ``` As long as *MLS* is still an opt-in feature, please remember that in order to be able From 0e8437dbf04b6acf80ccae9149d9d97fc74ea680 Mon Sep 17 00:00:00 2001 From: Matthias Fischmann Date: Thu, 23 May 2024 12:09:55 +0200 Subject: [PATCH 04/64] Treat pending legalhold devices as not having a legalhold device (#4056) * Refactor. * Refactor. * Refactor. * Make test case fail where it should pass. * Cleanup failing test cases. - add old run traces (with approved device) back * FUTUREWORK. * Changelog. * Make failing test case pass. Pending LH devices means user *has* given consent, not the opposite! * Fix terminology. * Make default settings explicit. * Renames; fix more LH logic. transitioning from disabled to pending doesn't block any connections, but from pending to active does. * Rename. * Fixup HEAD~2 * Remove dead code. * testLHMessageExchange: Assert that message exchange works during all stages of multiple people approving the device * Fix comment wording * Delete redundant constraints * testLHMessageExchange: Ensure correct client is used to send messages * testLHNoConsentBlockOne2OneConv: Break the test in 2 for simplicity Also fix assertions about what happens when LH devices are pending * brig: Do not cause LH conflict when a user has pending device while creating connections * testLHPreventAddingNonConsentingUsers: Users are only kicked after approving the LH device * hlint * integration/connectTwoUsers: Don't worry too much if users are already connected * galley: Allow non-lh-consenting users to be added to a conv when lh is pending on a member --------- Co-authored-by: Akshay Mankar --- .../3-bug-fixes/wpb9362-lh-logic-glitch | 1 + integration/test/SetupHelpers.hs | 10 +- integration/test/Test/LegalHold.hs | 511 ++++++++---------- integration/test/Testlib/Assertions.hs | 13 +- services/brig/src/Brig/API/Connection.hs | 4 +- services/galley/src/Galley/API/LegalHold.hs | 41 +- .../src/Galley/API/LegalHold/Conflicts.hs | 34 +- services/galley/src/Galley/API/Util.hs | 2 +- 8 files changed, 285 insertions(+), 331 deletions(-) create mode 100644 changelog.d/3-bug-fixes/wpb9362-lh-logic-glitch diff --git a/changelog.d/3-bug-fixes/wpb9362-lh-logic-glitch b/changelog.d/3-bug-fixes/wpb9362-lh-logic-glitch new file mode 100644 index 00000000000..ebd0f8e3ce7 --- /dev/null +++ b/changelog.d/3-bug-fixes/wpb9362-lh-logic-glitch @@ -0,0 +1 @@ +Make pending LH requests (with no LH devices listening yet) not throw LH policy errors. This helps eg. in cases where a LH request is issued to the wrong user by accident, and the user can clear up the mistake. \ No newline at end of file diff --git a/integration/test/SetupHelpers.hs b/integration/test/SetupHelpers.hs index 341505a11de..80b3e1778fc 100644 --- a/integration/test/SetupHelpers.hs +++ b/integration/test/SetupHelpers.hs @@ -93,8 +93,8 @@ connectTwoUsers :: bob -> App () connectTwoUsers alice bob = do - bindResponse (postConnection alice bob) (\resp -> resp.status `shouldMatchInt` 201) - bindResponse (putConnection bob alice "accepted") (\resp -> resp.status `shouldMatchInt` 200) + postConnection alice bob >>= assertSuccess + putConnection bob alice "accepted" >>= assertSuccess connectUsers :: (HasCallStack, MakesValue usr) => [usr] -> App () connectUsers users = traverse_ (uncurry connectTwoUsers) $ do @@ -103,6 +103,12 @@ connectUsers users = traverse_ (uncurry connectTwoUsers) $ do b <- others pure (a, b) +assertConnection :: (HasCallStack, MakesValue alice, MakesValue bob) => alice -> bob -> String -> App () +assertConnection alice bob status = + getConnection alice bob `bindResponse` \resp -> do + resp.status `shouldMatchInt` 200 + resp.json %. "status" `shouldMatch` status + createAndConnectUsers :: (HasCallStack, MakesValue domain) => [domain] -> App [Value] createAndConnectUsers domains = do users <- for domains (flip randomUser def) diff --git a/integration/test/Test/LegalHold.hs b/integration/test/Test/LegalHold.hs index 15104532867..583a1a4c49f 100644 --- a/integration/test/Test/LegalHold.hs +++ b/integration/test/Test/LegalHold.hs @@ -23,9 +23,10 @@ import API.Common import API.Galley import API.GalleyInternal import Control.Error (MaybeT (MaybeT), runMaybeT) -import Control.Lens ((.~), (^?!)) +import Control.Lens ((.~), (^?), (^?!)) import Control.Monad.Reader (asks, local) import Control.Monad.Trans.Class (lift) +import Data.Aeson.Lens import qualified Data.ByteString.Char8 as BS8 import Data.ByteString.Lazy (LazyByteString) import qualified Data.Map as Map @@ -55,9 +56,12 @@ testLHPreventAddingNonConsentingUsers = do postLegalHoldSettings tid owner (mkLegalHoldSettings lhDomAndPort) >>= assertStatus 201 george <- randomUser OwnDomain def - georgeQId <- george %. "qualified_id" - connectUsers =<< forM [alice, george] make - connectUsers =<< forM [alex, george] make + georgeQId <- objQidObject george + hannes <- randomUser OwnDomain def + hannesQId <- objQidObject hannes + + connectUsers [alice, george, hannes] + connectUsers [alex, george, hannes] conv <- postConversation alice (defProteus {qualifiedUsers = [alex], team = Just tid}) >>= getJSON 201 -- the guest should be added to the conversation @@ -71,6 +75,16 @@ testLHPreventAddingNonConsentingUsers = do -- now request legalhold for alex (but not alice) requestLegalHoldDevice tid owner alex >>= assertSuccess + -- the guest should not be removed from the conversation before approving + checkConvHasOtherMembers conv alice [alex, george] + + -- it should be possible to add the another guest while the LH device is not approved + addMembers alex conv def {users = [hannesQId]} `bindResponse` \resp -> do + resp.status `shouldMatchInt` 200 + resp.json %. "type" `shouldMatch` "conversation.member-join" + checkConvHasOtherMembers conv alice [alex, george, hannes] + + approveLegalHoldDevice tid alex defPassword >>= assertSuccess -- the guest should be removed from the conversation checkConvHasOtherMembers conv alice [alex] @@ -94,20 +108,21 @@ testLHMessageExchange :: HasCallStack => TaggedBool "clients1New" -> TaggedBool "clients2New" -> - TaggedBool "consentFrom1" -> - TaggedBool "consentFrom2" -> App () -testLHMessageExchange (TaggedBool clients1New) (TaggedBool clients2New) (TaggedBool consentFrom1) (TaggedBool consentFrom2) = do +testLHMessageExchange (TaggedBool clients1New) (TaggedBool clients2New) = do + -- We used to throw LegalholdConflictsOldClients if clients didn't have LH capability, but we + -- don't do that any more because that broke things. + -- Related: https://github.com/wireapp/wire-server/pull/4056 withMockServer lhMockApp $ \lhDomAndPort _chan -> do (owner, tid, [mem1, mem2]) <- createTeam OwnDomain 3 let clientSettings :: Bool -> AddClient clientSettings allnew = if allnew - then def -- (`{acapabilities = Just ["legalhold-implicit-consent"]}` is the default) + then def {acapabilities = Just ["legalhold-implicit-consent"]} -- (is should be the default) else def {acapabilities = Nothing} - client1 <- objId $ addClient (mem1 %. "qualified_id") (clientSettings clients1New) >>= getJSON 201 - _client2 <- objId $ addClient (mem2 %. "qualified_id") (clientSettings clients2New) >>= getJSON 201 + void $ addClient (mem1 %. "qualified_id") (clientSettings clients1New) >>= getJSON 201 + void $ addClient (mem2 %. "qualified_id") (clientSettings clients2New) >>= getJSON 201 legalholdWhitelistTeam tid owner >>= assertSuccess legalholdIsTeamInWhitelist tid owner >>= assertSuccess @@ -115,91 +130,63 @@ testLHMessageExchange (TaggedBool clients1New) (TaggedBool clients2New) (TaggedB conv <- postConversation mem1 (defProteus {qualifiedUsers = [mem2], team = Just tid}) >>= getJSON 201 + let getClients :: Value -> App [Value] + getClients mem = do + res <- getClientsQualified mem OwnDomain mem + val <- getJSON 200 res + asList val + + assertMessageSendingWorks :: HasCallStack => App () + assertMessageSendingWorks = do + clients1 <- getClients mem1 + clients2 <- getClients mem2 + + clientIds1 <- traverse objId clients1 + clientIds2 <- traverse objId clients2 + + proteusRecipients <- mkProteusRecipients mem1 [(mem1, clientIds1), (mem2, clientIds2)] "hey there" + + let proteusMsg senderClient = + Proto.defMessage @Proto.QualifiedNewOtrMessage + & #sender . Proto.client .~ (senderClient ^?! hex) + & #recipients .~ [proteusRecipients] + & #reportAll .~ Proto.defMessage + + sender clients = + let senderClient = head $ filter (\c -> c ^? key (fromString "type") /= Just (toJSON "legalhold")) clients + in T.unpack $ senderClient ^?! key (fromString "id") . _String + postProteusMessage mem1 (conv %. "qualified_id") (proteusMsg (sender clients1)) >>= assertSuccess + postProteusMessage mem2 (conv %. "qualified_id") (proteusMsg (sender clients2)) >>= assertSuccess + + assertMessageSendingWorks + requestLegalHoldDevice tid owner mem1 >>= assertSuccess + assertMessageSendingWorks + requestLegalHoldDevice tid owner mem2 >>= assertSuccess - when consentFrom1 $ do - approveLegalHoldDevice tid (mem1 %. "qualified_id") defPassword >>= assertSuccess - when consentFrom2 $ do - approveLegalHoldDevice tid (mem2 %. "qualified_id") defPassword >>= assertSuccess + assertMessageSendingWorks - let getCls :: Value -> App [String] - getCls mem = do - res <- getClientsQualified mem OwnDomain mem - val <- getJSON 200 res - cls <- asList val - objId `mapM` cls - cs1 :: [String] <- getCls mem1 -- it's ok to include the sender, backend will filter it out. - cs2 :: [String] <- getCls mem2 - - length cs1 `shouldMatchInt` if consentFrom1 then 2 else 1 - length cs2 `shouldMatchInt` if consentFrom2 then 2 else 1 - - do - successfulMsgForOtherUsers <- mkProteusRecipients mem1 [(mem1, cs1), (mem2, cs2)] "hey there" - let successfulMsg = - Proto.defMessage @Proto.QualifiedNewOtrMessage - & #sender . Proto.client .~ (client1 ^?! hex) - & #recipients .~ [successfulMsgForOtherUsers] - & #reportAll .~ Proto.defMessage - bindResponse (postProteusMessage mem1 (conv %. "qualified_id") successfulMsg) $ \resp -> do - let check :: HasCallStack => Int -> Maybe String -> App () - check status Nothing = do - resp.status `shouldMatchInt` status - check status (Just label) = do - resp.status `shouldMatchInt` status - resp.json %. "label" `shouldMatch` label - - let -- there are two equally valid ways to write this down (feel free to remove one if it gets in your way): - _oneWay = case (clients1New, clients2New, consentFrom1, consentFrom2) of - (_, _, False, False) -> - -- no LH in the picture - check 201 Nothing - (True, True, _, _) -> - if consentFrom1 /= consentFrom2 - then -- no old clients, but users disagree on LH - check 403 (Just "missing-legalhold-consent") - else -- everybody likes LH - check 201 Nothing - _ -> - -- everything else - check 403 (Just "missing-legalhold-consent-old-clients") - - theOtherWay = case (clients1New, clients2New, consentFrom1, consentFrom2) of - -- NB: "consent" always implies "has an active LH device" - (False, False, False, False) -> - -- no LH in the picture - check 201 Nothing - (False, True, False, False) -> - -- no LH in the picture - check 201 Nothing - (True, False, False, False) -> - -- no LH in the picture - check 201 Nothing - (True, True, False, False) -> - -- no LH in the picture - check 201 Nothing - (True, True, False, True) -> - -- all clients new, no consent from sender, recipient has LH device - check 403 (Just "missing-legalhold-consent") - (True, True, True, False) -> - -- all clients new, no consent from recipient, sender has LH device - check 403 (Just "missing-legalhold-consent") - (True, True, True, True) -> - -- everybody happy with LH - check 201 Nothing - _ -> pure () - - -- _oneWay -- run this if you want to make sure both ways are equivalent, but please don't commit! - theOtherWay + approveLegalHoldDevice tid (mem1 %. "qualified_id") defPassword >>= assertSuccess + fmap length (getClients mem1) `shouldMatchInt` 2 + assertMessageSendingWorks + + approveLegalHoldDevice tid (mem2 %. "qualified_id") defPassword >>= assertSuccess + fmap length (getClients mem2) `shouldMatchInt` 2 + assertMessageSendingWorks data TestClaimKeys = TCKConsentMissing -- (team not whitelisted, that is) | TCKConsentAndNewClients deriving (Show, Generic) +data LHApprovedOrPending + = LHApproved + | LHPending + deriving (Show, Generic) + -- | Cannot fetch prekeys of LH users if requester has not given consent or has old clients. -testLHClaimKeys :: TestClaimKeys -> App () -testLHClaimKeys testmode = do +testLHClaimKeys :: LHApprovedOrPending -> TestClaimKeys -> App () +testLHClaimKeys approvedOrPending testmode = do withMockServer lhMockApp $ \lhDomAndPort _chan -> do (lowner, ltid, [lmem]) <- createTeam OwnDomain 2 (powner, ptid, [pmem]) <- createTeam OwnDomain 2 @@ -209,7 +196,9 @@ testLHClaimKeys testmode = do postLegalHoldSettings ltid lowner (mkLegalHoldSettings lhDomAndPort) >>= assertStatus 201 requestLegalHoldDevice ltid lowner lmem >>= assertSuccess - approveLegalHoldDevice ltid (lmem %. "qualified_id") defPassword >>= assertSuccess + case approvedOrPending of + LHApproved -> approveLegalHoldDevice ltid (lmem %. "qualified_id") defPassword >>= assertSuccess + LHPending -> pure () let addc caps = addClient pmem (settings caps) >>= assertSuccess settings caps = @@ -218,39 +207,49 @@ testLHClaimKeys testmode = do lastPrekey = Just $ head someLastPrekeysRendered, acapabilities = caps } - in case testmode of - TCKConsentMissing -> - addc $ Just ["legalhold-implicit-consent"] - TCKConsentAndNewClients -> do - addc $ Just ["legalhold-implicit-consent"] - legalholdWhitelistTeam ptid powner >>= assertSuccess - legalholdIsTeamInWhitelist ptid powner >>= assertSuccess - - llhdev :: String <- do + in addc $ Just ["legalhold-implicit-consent"] + + case testmode of + TCKConsentMissing -> pure () + TCKConsentAndNewClients -> do + legalholdWhitelistTeam ptid powner >>= assertSuccess + legalholdIsTeamInWhitelist ptid powner >>= assertSuccess + + llhdevs :: [String] <- do let getCls :: Value -> App [String] getCls mem = do res <- getClientsQualified mem OwnDomain mem val <- getJSON 200 res cls <- asList val objId `mapM` cls - getCls lmem <&> \case - [d] -> d - bad -> error $ show bad + getCls lmem let assertResp :: HasCallStack => Response -> App () - assertResp resp = case testmode of - TCKConsentMissing -> do + assertResp resp = case (testmode, llhdevs) of + (TCKConsentMissing, (_ : _)) -> do resp.status `shouldMatchInt` 403 resp.json %. "label" `shouldMatch` "missing-legalhold-consent" - TCKConsentAndNewClients -> do + (TCKConsentAndNewClients, (_ : _)) -> do + resp.status `shouldMatchInt` 200 + (_, []) -> do + -- no lh devices: no reason to be shy! resp.status `shouldMatchInt` 200 - bindResponse (getUsersPrekeysClient pmem (lmem %. "qualified_id") llhdev) $ assertResp - bindResponse (getUsersPrekeyBundle pmem (lmem %. "qualified_id")) $ assertResp + bindResponse (getUsersPrekeyBundle pmem (lmem %. "qualified_id")) assertResp + case llhdevs of + [llhdev] -> + -- retrieve lh client if /a + bindResponse (getUsersPrekeysClient pmem (lmem %. "qualified_id") llhdev) assertResp + [] -> + -- we're probably doing the LHPending thing right now + pure () + bad@(_ : _ : _) -> + -- fail if there is more than one. + assertFailure ("impossible -- more than one LH device: " <> show bad) slmemdom <- asString $ lmem %. "qualified_id.domain" slmemid <- asString $ lmem %. "qualified_id.id" - let userClients = Map.fromList [(slmemdom, Map.fromList [(slmemid, Set.fromList [llhdev])])] + let userClients = Map.fromList [(slmemdom, Map.fromList [(slmemid, Set.fromList llhdevs)])] bindResponse (getMultiUserPrekeyBundle pmem userClients) $ assertResp testLHAddClientManually :: App () @@ -588,179 +587,114 @@ testLHGetMembersIncludesStatus = do type TB s = TaggedBool s -testLHNoConsentBlockOne2OneConv :: TB "connect first" -> TB "team peer" -> TB "approve LH" -> TB "test pending connection" -> App () -testLHNoConsentBlockOne2OneConv - (MkTagged connectFirst) - (MkTagged teampeer) - (MkTagged approveLH) - (MkTagged testPendingConnection) = do - -- team users - -- alice (team owner) and bob (member) - (alice, tid, []) <- createTeam OwnDomain 1 - bob <- - if teampeer - then do - (walice, _tid, []) <- createTeam OwnDomain 1 - -- FUTUREWORK(mangoiv): creating a team on a second backend - -- causes this bug: https://wearezeta.atlassian.net/browse/WPB-6640 - pure walice - else randomUser OwnDomain def +enableLH :: (MakesValue tid, MakesValue teamAdmin, MakesValue targetUser, HasCallStack) => tid -> teamAdmin -> targetUser -> Bool -> App (Maybe String) +enableLH tid teamAdmin targetUser approveLH = do + -- alice requests a legalhold device for herself + requestLegalHoldDevice tid teamAdmin targetUser + >>= assertStatus 201 - legalholdWhitelistTeam tid alice + when approveLH do + approveLegalHoldDevice tid targetUser defPassword >>= assertStatus 200 + legalholdUserStatus tid targetUser targetUser `bindResponse` \resp -> do + resp.status `shouldMatchInt` 200 + resp.json %. "status" `shouldMatch` if approveLH then "enabled" else "pending" + if approveLH + then Just <$> lhDeviceIdOf targetUser + else pure Nothing - let doEnableLH :: HasCallStack => App (Maybe String) - doEnableLH = do - -- alice requests a legalhold device for herself - requestLegalHoldDevice tid alice alice - >>= assertStatus 201 +testLHConnectionsWithNonConsentingUsers :: App () +testLHConnectionsWithNonConsentingUsers = do + (alice, tid, []) <- createTeam OwnDomain 1 + bob <- randomUser OwnDomain def + carl <- randomUser OwnDomain def + dee <- randomUser OwnDomain def - when approveLH do - approveLegalHoldDevice tid alice defPassword - >>= assertStatus 200 - legalholdUserStatus tid alice alice `bindResponse` \resp -> do - resp.status `shouldMatchInt` 200 - resp.json %. "status" `shouldMatch` if approveLH then "enabled" else "pending" - if approveLH - then Just <$> lhDeviceIdOf alice - else pure Nothing + legalholdWhitelistTeam tid alice + >>= assertStatus 200 - doDisableLH :: HasCallStack => App () - doDisableLH = - disableLegalHold tid alice alice defPassword - >>= assertStatus 200 + withMockServer lhMockApp \lhDomAndPort _chan -> do + postLegalHoldSettings tid alice (mkLegalHoldSettings lhDomAndPort) + >>= assertStatus 201 - withMockServer lhMockApp \lhDomAndPort _chan -> do - postLegalHoldSettings tid alice (mkLegalHoldSettings lhDomAndPort) - >>= assertStatus 201 + requestLegalHoldDevice tid alice alice + >>= assertStatus 201 + + -- Connections are not blocked before LH is approved by alice + connectTwoUsers alice bob + bobConvId <- getConnection alice bob `bindResponse` \resp -> resp.json %. "qualified_conversation" + + postConnection dee alice >>= assertSuccess + deeConvId <- getConnection alice dee `bindResponse` \resp -> resp.json %. "qualified_conversation" + + approveLegalHoldDevice tid alice defPassword + >>= assertStatus 200 + + -- Connections with bob and dee are now in missing-legalhold-consent state + -- and the 1:1 convs are broken + assertConnection alice bob "missing-legalhold-consent" + assertConnection bob alice "missing-legalhold-consent" + getConversation bob bobConvId + >>= assertLabel 403 "access-denied" + + assertConnection alice dee "missing-legalhold-consent" + assertConnection dee alice "missing-legalhold-consent" + getConversation dee deeConvId + >>= assertLabel 403 "access-denied" + + -- Connections are blocked after alice approves the LH device + postConnection carl alice + >>= assertLabel 403 "missing-legalhold-consent" + postConnection alice carl + >>= assertLabel 403 "missing-legalhold-consent" + + disableLegalHold tid alice alice defPassword + >>= assertStatus 200 + + -- Disabling LH restores connection status and 1:1 convs + assertConnection alice bob "accepted" + assertConnection bob alice "accepted" + getConversation bob bobConvId `bindResponse` \resp -> do + resp.status `shouldMatchInt` 200 + resp.json %. "members.others.0.qualified_id" `shouldMatch` objQidObject alice - if not connectFirst - then do - void doEnableLH - postConnection alice bob - >>= assertLabel 403 "missing-legalhold-consent" - - postConnection bob alice - >>= assertLabel 403 "missing-legalhold-consent" - else do - alicec <- objId $ addClient alice def >>= getJSON 201 - bobc <- objId $ addClient bob def >>= getJSON 201 - - postConnection alice bob - >>= assertStatus 201 - mbConvId <- - if testPendingConnection - then pure Nothing - else - Just - <$> do - putConnection bob alice "accepted" - >>= getJSON 200 - %. "qualified_conversation" - - -- we need to take away the pending/ sent status for the connections - [lastNotifAlice, lastNotifBob] <- for [(alice, alicec), (bob, bobc)] \(user, client) -> do - -- we get two events if bob accepts alice's request - let numEvents = if testPendingConnection then 1 else 2 - last <$> awaitNotifications user client Nothing numEvents isUserConnectionNotif - - mbLHDevice <- doEnableLH - - let assertConnectionsMissingLHConsent = - for_ [(bob, alice), (alice, bob)] \(a, b) -> - getConnections a `bindResponse` \resp -> do - resp.status `shouldMatchInt` 200 - conn <- assertOne =<< do resp.json %. "connections" & asList - conn %. "status" `shouldMatch` "missing-legalhold-consent" - conn %. "from" `shouldMatch` objId a - conn %. "to" `shouldMatch` objId b - - assertConnectionsMissingLHConsent - - [lastNotifAlice', lastNotifBob'] <- for [(alice, alicec, lastNotifAlice), (bob, bobc, lastNotifBob)] \(user, client, lastNotif) -> do - awaitNotification user client (Just lastNotif) isUserConnectionNotif >>= \notif -> - notif %. "payload.0.connection.status" `shouldMatch` "missing-legalhold-consent" - $> notif - - for_ [(bob, alice), (alice, bob)] \(a, b) -> - putConnection a b "accepted" - >>= assertLabel 403 "bad-conn-update" - - -- putting the connection to "accepted" with 403 doesn't change the - -- connection status - assertConnectionsMissingLHConsent - - bobc2 <- objId $ addClient bob def >>= getJSON 201 - - let -- \| we send a message from bob to alice, but only if - -- we have a conversation id and a legalhold device - -- we first create a message that goes to recipients - -- chosen by the first callback passed - -- then send the message using proteus - -- and in the end running the assertino callback to - -- verify the result - sendMessageFromBobToAlice :: - HasCallStack => - (String -> [String]) -> - -- \^ if we have the legalhold device registered, this - -- callback will be passed the lh device - (Response -> App ()) -> - -- \^ the callback to verify our response (an assertion) - App () - sendMessageFromBobToAlice recipients assertion = - for_ ((,) <$> mbConvId <*> mbLHDevice) \(convId, device) -> do - successfulMsgForOtherUsers <- - mkProteusRecipients - bob -- bob is the sender - [(alice, recipients device), (bob, [bobc])] - -- we send to clients of alice, maybe the legalhold device - -- we need to send to our other clients (bobc) - "hey alice (and eve)" -- the message - let bobaliceMessage = - Proto.defMessage @Proto.QualifiedNewOtrMessage - & #sender . Proto.client .~ (bobc2 ^?! hex) - & #recipients .~ [successfulMsgForOtherUsers] - & #reportAll .~ Proto.defMessage - -- make sure that `convId` is not just the `convId` but also - -- contains the domain because `postProteusMessage` will take the - -- comain from the `convId` json object - postProteusMessage bob convId bobaliceMessage - `bindResponse` assertion - - sendMessageFromBobToAlice (\device -> [alicec, device]) \resp -> do - resp.status `shouldMatchInt` 404 - - -- now we disable legalhold - doDisableLH - - for_ mbLHDevice \lhd -> - local (setTimeoutTo 90) $ - awaitNotification alice alicec noValue isUserClientRemoveNotif >>= \notif -> - notif %. "payload.0.client.id" `shouldMatch` lhd - - let assertStatusFor user status = - getConnections user `bindResponse` \resp -> do - resp.status `shouldMatchInt` 200 - conn <- assertOne =<< do resp.json %. "connections" & asList - conn %. "status" `shouldMatch` status - - if testPendingConnection - then do - assertStatusFor alice "sent" - assertStatusFor bob "pending" - else do - assertStatusFor alice "accepted" - assertStatusFor bob "accepted" - - for_ [(alice, alicec, lastNotifAlice'), (bob, bobc, lastNotifBob')] \(user, client, lastNotif) -> do - awaitNotification user client (Just lastNotif) isUserConnectionNotif >>= \notif -> - notif %. "payload.0.connection.status" `shouldMatchOneOf` ["sent", "pending", "accepted"] - - sendMessageFromBobToAlice (const [alicec]) \resp -> do - resp.status `shouldMatchInt` 201 - - sendMessageFromBobToAlice (\device -> [device]) \resp -> do - resp.status `shouldMatchInt` 412 + assertConnection alice dee "pending" + assertConnection dee alice "sent" + getConversation dee deeConvId `bindResponse` \resp -> do + resp.status `shouldMatchInt` 200 + resp.json %. "members.others.0.qualified_id" `shouldMatch` objQidObject alice + +testLHConnectionsWithConsentingUsers :: App () +testLHConnectionsWithConsentingUsers = do + (alice, teamA, []) <- createTeam OwnDomain 1 + (bob, teamB, [barbara]) <- createTeam OwnDomain 2 + + legalholdWhitelistTeam teamA alice + >>= assertStatus 200 + legalholdWhitelistTeam teamB bob + >>= assertStatus 200 + + withMockServer lhMockApp \lhDomAndPort _chan -> do + postLegalHoldSettings teamA alice (mkLegalHoldSettings lhDomAndPort) + >>= assertStatus 201 + + requestLegalHoldDevice teamA alice alice + >>= assertStatus 201 + + -- Connections are not blocked before LH is approved by alice + connectTwoUsers alice bob + + approveLegalHoldDevice teamA alice defPassword + >>= assertStatus 200 + + -- Connection with bob is now in whatever state + getConnection bob alice `bindResponse` \resp -> do + resp.status `shouldMatchInt` 200 + resp.json %. "status" `shouldMatch` "accepted" + + -- Connections are not blocked after alice approves the LH device because + -- teamB has implicit consent + connectTwoUsers alice barbara data GroupConvAdmin = LegalholderIsAdmin @@ -774,8 +708,8 @@ data GroupConvAdmin -- As to who gets to stay: -- - admins will stay over members -- - local members will stay over remote members. -testLHNoConsentRemoveFromGroup :: GroupConvAdmin -> App () -testLHNoConsentRemoveFromGroup admin = do +testLHNoConsentRemoveFromGroup :: LHApprovedOrPending -> GroupConvAdmin -> App () +testLHNoConsentRemoveFromGroup approvedOrPending admin = do (alice, tidAlice, []) <- createTeam OwnDomain 1 (bob, tidBob, []) <- createTeam OwnDomain 1 legalholdWhitelistTeam tidAlice alice >>= assertStatus 200 @@ -804,24 +738,41 @@ testLHNoConsentRemoveFromGroup admin = do getConversation user qConvId >>= assertStatus 200 requestLegalHoldDevice tidAlice alice alice >>= assertStatus 201 - approveLegalHoldDevice tidAlice alice defPassword >>= assertStatus 200 + case approvedOrPending of + LHApproved -> approveLegalHoldDevice tidAlice alice defPassword >>= assertStatus 200 + LHPending -> pure () + legalholdUserStatus tidAlice alice alice `bindResponse` \resp -> do - resp.json %. "status" `shouldMatch` "enabled" resp.status `shouldMatchInt` 200 + resp.json %. "status" `shouldMatch` case approvedOrPending of + LHApproved -> "enabled" + LHPending -> "pending" case admin of LegalholderIsAdmin -> do - for_ [aws, bws] do awaitMatch (isConvLeaveNotifWithLeaver bob) + case approvedOrPending of + LHApproved -> for_ [aws, bws] do awaitMatch (isConvLeaveNotifWithLeaver bob) + LHPending -> pure () getConversation alice qConvId >>= assertStatus 200 - getConversation bob qConvId >>= assertLabel 403 "access-denied" + getConversation bob qConvId >>= case approvedOrPending of + LHApproved -> assertLabel 403 "access-denied" + LHPending -> assertStatus 200 PeerIsAdmin -> do - for_ [aws, bws] do awaitMatch (isConvLeaveNotifWithLeaver alice) + case approvedOrPending of + LHApproved -> for_ [aws, bws] do awaitMatch (isConvLeaveNotifWithLeaver alice) + LHPending -> pure () getConversation bob qConvId >>= assertStatus 200 - getConversation alice qConvId >>= assertLabel 403 "access-denied" + getConversation alice qConvId >>= case approvedOrPending of + LHApproved -> assertLabel 403 "access-denied" + LHPending -> assertStatus 200 BothAreAdmins -> do - for_ [aws, bws] do awaitMatch (isConvLeaveNotifWithLeaver bob) + case approvedOrPending of + LHApproved -> for_ [aws, bws] do awaitMatch (isConvLeaveNotifWithLeaver bob) + LHPending -> pure () getConversation alice qConvId >>= assertStatus 200 - getConversation bob qConvId >>= assertLabel 403 "access-denied" + getConversation bob qConvId >>= case approvedOrPending of + LHApproved -> assertLabel 403 "access-denied" + LHPending -> assertStatus 200 testLHHappyFlow :: App () testLHHappyFlow = do diff --git a/integration/test/Testlib/Assertions.hs b/integration/test/Testlib/Assertions.hs index ac86c962147..7d19a5401a4 100644 --- a/integration/test/Testlib/Assertions.hs +++ b/integration/test/Testlib/Assertions.hs @@ -240,9 +240,18 @@ shouldContainString :: -- | The expected value String -> App () -super `shouldContainString` sub = do +shouldContainString = shouldContain + +shouldContain :: + (Eq a, Show a, HasCallStack) => + -- | The actual value + [a] -> + -- | The expected value + [a] -> + App () +super `shouldContain` sub = do unless (sub `isInfixOf` super) $ do - assertFailure $ "String:\n" <> show super <> "\nDoes not contain:\n" <> show sub + assertFailure $ "String or List:\n" <> show super <> "\nDoes not contain:\n" <> show sub printFailureDetails :: AssertionFailure -> IO String printFailureDetails (AssertionFailure stack mbResponse msg) = do diff --git a/services/brig/src/Brig/API/Connection.hs b/services/brig/src/Brig/API/Connection.hs index cc499656310..45445657f23 100644 --- a/services/brig/src/Brig/API/Connection.hs +++ b/services/brig/src/Brig/API/Connection.hs @@ -205,10 +205,10 @@ checkLegalholdPolicyConflict uid1 uid2 = do status2 <- lift (getLegalHoldStatus uid2) >>= catchProfileNotFound let oneway s1 s2 = case (s1, s2) of + (LH.UserLegalHoldNoConsent, LH.UserLegalHoldEnabled) -> throwE ConnectMissingLegalholdConsent (LH.UserLegalHoldNoConsent, LH.UserLegalHoldNoConsent) -> pure () (LH.UserLegalHoldNoConsent, LH.UserLegalHoldDisabled) -> pure () - (LH.UserLegalHoldNoConsent, LH.UserLegalHoldPending) -> throwE ConnectMissingLegalholdConsent - (LH.UserLegalHoldNoConsent, LH.UserLegalHoldEnabled) -> throwE ConnectMissingLegalholdConsent + (LH.UserLegalHoldNoConsent, LH.UserLegalHoldPending) -> pure () (LH.UserLegalHoldDisabled, _) -> pure () (LH.UserLegalHoldPending, _) -> pure () (LH.UserLegalHoldEnabled, _) -> pure () diff --git a/services/galley/src/Galley/API/LegalHold.hs b/services/galley/src/Galley/API/LegalHold.hs index 79a3eb942e4..bc6d94f7161 100644 --- a/services/galley/src/Galley/API/LegalHold.hs +++ b/services/galley/src/Galley/API/LegalHold.hs @@ -288,7 +288,7 @@ removeSettings' tid = luid <- qualifyLocal (member ^. userId) removeLegalHoldClientFromUser (tUnqualified luid) LHService.removeLegalHold tid (tUnqualified luid) - changeLegalholdStatus tid luid (member ^. legalHoldStatus) UserLegalHoldDisabled -- (support for withdrawing consent is not planned yet.) + changeLegalholdStatusAndHandlePolicyConflicts tid luid (member ^. legalHoldStatus) UserLegalHoldDisabled -- (support for withdrawing consent is not planned yet.) -- | Learn whether a user has LH enabled and fetch pre-keys. -- Note that this is accessible to ANY authenticated user, even ones outside the team @@ -364,7 +364,7 @@ grantConsent lusr tid = do =<< fmap (view legalHoldStatus) <$> getTeamMember tid (tUnqualified lusr) case userLHStatus of lhs@UserLegalHoldNoConsent -> - changeLegalholdStatus tid lusr lhs UserLegalHoldDisabled $> GrantConsentSuccess + changeLegalholdStatusAndHandlePolicyConflicts tid lusr lhs UserLegalHoldDisabled $> GrantConsentSuccess UserLegalHoldEnabled -> pure GrantConsentAlreadyGranted UserLegalHoldPending -> pure GrantConsentAlreadyGranted UserLegalHoldDisabled -> pure GrantConsentAlreadyGranted @@ -420,7 +420,12 @@ requestDevice lzusr tid uid = do member <- noteS @'TeamMemberNotFound =<< getTeamMember tid uid case member ^. legalHoldStatus of UserLegalHoldEnabled -> throwS @'UserLegalHoldAlreadyEnabled - lhs@UserLegalHoldPending -> RequestDeviceAlreadyPending <$ provisionLHDevice zusr luid lhs + lhs@UserLegalHoldPending -> + -- FUTUREWORK: we create a new device if a pending one is found. this helps with + -- recovering from lost credentials (but where would that happen?). on the other + -- hand. do we properly gc the old pending device? maybe we should just throw an error + -- here? + RequestDeviceAlreadyPending <$ provisionLHDevice zusr luid lhs lhs@UserLegalHoldDisabled -> RequestDeviceSuccess <$ provisionLHDevice zusr luid lhs UserLegalHoldNoConsent -> throwS @'NoUserLegalHoldConsent where @@ -436,7 +441,7 @@ requestDevice lzusr tid uid = do (lastPrekey', prekeys) <- requestDeviceFromService luid -- We don't distinguish the last key here; brig will do so when the device is added LegalHoldData.insertPendingPrekeys (tUnqualified luid) (unpackLastPrekey lastPrekey' : prekeys) - changeLegalholdStatus tid luid userLHStatus UserLegalHoldPending + changeLegalholdStatusAndHandlePolicyConflicts tid luid userLHStatus UserLegalHoldPending notifyClientsAboutLegalHoldRequest zusr (tUnqualified luid) lastPrekey' requestDeviceFromService :: Local UserId -> Sem r (LastPrekey, [Prekey]) @@ -520,7 +525,7 @@ approveDevice lzusr connId tid uid (Public.ApproveLegalHoldForUserRequest mPassw LHService.confirmLegalHold clientId tid (tUnqualified luid) legalHoldAuthToken -- TODO: send event at this point (see also: -- https://github.com/wireapp/wire-server/pull/802#pullrequestreview-262280386) - changeLegalholdStatus tid luid userLHStatus UserLegalHoldEnabled + changeLegalholdStatusAndHandlePolicyConflicts tid luid userLHStatus UserLegalHoldEnabled where assertUserLHPending :: UserLegalHoldStatus -> @@ -588,12 +593,12 @@ disableForUser lzusr tid uid (Public.DisableLegalHoldForUserRequest mPassword) = -- TODO: send event at this point (see also: related TODO in this module in -- 'approveDevice' and -- https://github.com/wireapp/wire-server/pull/802#pullrequestreview-262280386) - changeLegalholdStatus tid luid userLHStatus UserLegalHoldDisabled + changeLegalholdStatusAndHandlePolicyConflicts tid luid userLHStatus UserLegalHoldDisabled --- | Allow no-consent => consent without further changes. If LH device is requested, enabled, --- or disabled, make sure the affected connections are screened for policy conflict (anybody --- with no-consent), and put those connections in the appropriate blocked state. -changeLegalholdStatus :: +-- | Allow no-consent or requested => consent without further changes. If LH device is +-- enabled, or disabled, make sure the affected connections are screened for policy conflict +-- (anybody with no-consent), and put those connections in the appropriate blocked state. +changeLegalholdStatusAndHandlePolicyConflicts :: ( Member BackendNotificationQueueAccess r, Member BrigAccess r, Member ConversationStore r, @@ -621,24 +626,24 @@ changeLegalholdStatus :: UserLegalHoldStatus -> UserLegalHoldStatus -> Sem r () -changeLegalholdStatus tid luid old new = do +changeLegalholdStatusAndHandlePolicyConflicts tid luid old new = do case old of UserLegalHoldEnabled -> case new of UserLegalHoldEnabled -> noop UserLegalHoldPending -> illegal - UserLegalHoldDisabled -> update >> removeblocks + UserLegalHoldDisabled -> update >> removeBlocks UserLegalHoldNoConsent -> illegal -- UserLegalHoldPending -> case new of - UserLegalHoldEnabled -> update + UserLegalHoldEnabled -> addBlocks >> update UserLegalHoldPending -> noop - UserLegalHoldDisabled -> update >> removeblocks + UserLegalHoldDisabled -> update >> removeBlocks UserLegalHoldNoConsent -> illegal -- UserLegalHoldDisabled -> case new of UserLegalHoldEnabled -> illegal - UserLegalHoldPending -> addblocks >> update - UserLegalHoldDisabled -> {- in case the last attempt crashed -} removeblocks + UserLegalHoldPending -> update + UserLegalHoldDisabled -> {- in case the last attempt crashed -} removeBlocks UserLegalHoldNoConsent -> {- withdrawing consent is not (yet?) implemented -} illegal -- UserLegalHoldNoConsent -> case new of @@ -648,8 +653,8 @@ changeLegalholdStatus tid luid old new = do UserLegalHoldNoConsent -> noop where update = LegalHoldData.setUserLegalHoldStatus tid (tUnqualified luid) new - removeblocks = void $ putConnectionInternal (RemoveLHBlocksInvolving (tUnqualified luid)) - addblocks = do + removeBlocks = void $ putConnectionInternal (RemoveLHBlocksInvolving (tUnqualified luid)) + addBlocks = do blockNonConsentingConnections (tUnqualified luid) handleGroupConvPolicyConflicts luid new noop = pure () diff --git a/services/galley/src/Galley/API/LegalHold/Conflicts.hs b/services/galley/src/Galley/API/LegalHold/Conflicts.hs index 4f898bd4856..e70ffff0f3d 100644 --- a/services/galley/src/Galley/API/LegalHold/Conflicts.hs +++ b/services/galley/src/Galley/API/LegalHold/Conflicts.hs @@ -56,7 +56,6 @@ data LegalholdConflictsOldClients = LegalholdConflictsOldClients guardQualifiedLegalholdPolicyConflicts :: ( Member BrigAccess r, Member (Error LegalholdConflicts) r, - Member (Error LegalholdConflictsOldClients) r, Member (Input (Local ())) r, Member (Input Opts) r, Member TeamStore r, @@ -82,7 +81,6 @@ guardQualifiedLegalholdPolicyConflicts protectee qclients = do guardLegalholdPolicyConflicts :: ( Member BrigAccess r, Member (Error LegalholdConflicts) r, - Member (Error LegalholdConflictsOldClients) r, Member (Input Opts) r, Member TeamStore r, Member P.TinyLog r @@ -107,7 +105,6 @@ guardLegalholdPolicyConflictsUid :: forall r. ( Member BrigAccess r, Member (Error LegalholdConflicts) r, - Member (Error LegalholdConflictsOldClients) r, Member TeamStore r, Member P.TinyLog r ) => @@ -128,15 +125,6 @@ guardLegalholdPolicyConflictsUid self (Map.keys . userClients -> otherUids) = do anyClientHasLH :: Bool anyClientHasLH = Client.LegalHoldClientType `elem` (Client.clientType <$> allClientsMetadata) - anyClientIsOld :: Bool - anyClientIsOld = any isOld allClientsMetadata - where - isOld :: Client.Client -> Bool - isOld = - (Client.ClientSupportsLegalholdImplicitConsent `Set.notMember`) - . Client.fromClientCapabilityList - . Client.clientCapabilities - checkAnyConsentMissing :: Sem r Bool checkAnyConsentMissing = do users :: [User] <- accountUser <$$> getUsers (self : otherUids) @@ -148,7 +136,11 @@ guardLegalholdPolicyConflictsUid self (Map.keys . userClients -> otherUids) = do mbMem <- getTeamMember tid (Wire.API.User.userId user) case mbMem of Nothing -> pure True -- it's weird that there is a member id but no member, we better bail - Just mem -> pure $ mem ^. legalHoldStatus `notElem` [UserLegalHoldDisabled, UserLegalHoldEnabled] + Just mem -> pure $ case mem ^. legalHoldStatus of + UserLegalHoldDisabled -> False + UserLegalHoldPending -> False + UserLegalHoldEnabled -> False + UserLegalHoldNoConsent -> True Nothing -> do pure True -- personal users can not give consent or <$> checkUserConsentMissing `mapM` users @@ -157,22 +149,12 @@ guardLegalholdPolicyConflictsUid self (Map.keys . userClients -> otherUids) = do Log.field "self" (toByteString' self) Log.~~ Log.field "allClients" (toByteString' $ show allClients) Log.~~ Log.field "allClientsMetadata" (toByteString' $ show allClientsMetadata) - Log.~~ Log.field "anyClientIsOld" (toByteString' anyClientIsOld) Log.~~ Log.field "anyClientHasLH" (toByteString' anyClientHasLH) Log.~~ Log.msg ("guardLegalholdPolicyConflicts[1]" :: Text) -- when no other client is under LH, then we're good and can leave this function. but... when anyClientHasLH $ do P.debug $ Log.msg ("guardLegalholdPolicyConflicts[5]: anyClientHasLH" :: Text) - if anyClientIsOld && False -- https://wearezeta.atlassian.net/browse/WPB-6392 - then do - -- you can't effectively give consent as long as you have old clients: when using the - -- old clients, you still would not be exposed to the popups and red dot where - -- required. - P.debug $ Log.msg ("guardLegalholdPolicyConflicts[2]: anyClientIsOld" :: Text) - throw LegalholdConflictsOldClients - else do - P.debug $ Log.msg ("guardLegalholdPolicyConflicts[3]: checkConsentMissing?" :: Text) - whenM checkAnyConsentMissing $ do - P.debug $ Log.msg ("guardLegalholdPolicyConflicts[4]: checkConsentMissing!" :: Text) - throw LegalholdConflicts + whenM checkAnyConsentMissing $ do + P.debug $ Log.msg ("guardLegalholdPolicyConflicts[4]: checkConsentMissing!" :: Text) + throw LegalholdConflicts diff --git a/services/galley/src/Galley/API/Util.hs b/services/galley/src/Galley/API/Util.hs index dc4b824449e..efd53d5af79 100644 --- a/services/galley/src/Galley/API/Util.hs +++ b/services/galley/src/Galley/API/Util.hs @@ -924,7 +924,7 @@ registerRemoteConversationMemberships now lusr lc = deleteOnUnreachable $ do userLHEnabled :: UserLegalHoldStatus -> Bool userLHEnabled = \case UserLegalHoldEnabled -> True - UserLegalHoldPending -> True + UserLegalHoldPending -> False UserLegalHoldDisabled -> False UserLegalHoldNoConsent -> False From 5d6494e04c2356f9c02f4e549c6fc634081a1c75 Mon Sep 17 00:00:00 2001 From: Amit Sagtani Date: Thu, 23 May 2024 16:45:20 +0200 Subject: [PATCH 05/64] Update k8ssandra test cluster chart (#4011) * create variables for configs in on-prem env * add changelog * fix linting issues --- .../5-internal/k8ssandra-test-cluster-chart-variables | 1 + .../templates/k8ssandra-cluster.yaml | 4 ++-- charts/k8ssandra-test-cluster/values.yaml | 8 ++++++++ 3 files changed, 11 insertions(+), 2 deletions(-) create mode 100644 changelog.d/5-internal/k8ssandra-test-cluster-chart-variables diff --git a/changelog.d/5-internal/k8ssandra-test-cluster-chart-variables b/changelog.d/5-internal/k8ssandra-test-cluster-chart-variables new file mode 100644 index 00000000000..6799efaf807 --- /dev/null +++ b/changelog.d/5-internal/k8ssandra-test-cluster-chart-variables @@ -0,0 +1 @@ +Added prometheus enable and datacenter size variables for k8ssandra-test-cluster helm chart. diff --git a/charts/k8ssandra-test-cluster/templates/k8ssandra-cluster.yaml b/charts/k8ssandra-test-cluster/templates/k8ssandra-cluster.yaml index 35197d8b8fd..33c39c50d90 100644 --- a/charts/k8ssandra-test-cluster/templates/k8ssandra-cluster.yaml +++ b/charts/k8ssandra-test-cluster/templates/k8ssandra-cluster.yaml @@ -9,7 +9,7 @@ spec: serverVersion: "3.11.11" telemetry: prometheus: - enabled: true + enabled: {{ .Values.prometheus.enabled }} resources: requests: cpu: 1 @@ -33,7 +33,7 @@ spec: datacenters: - metadata: name: datacenter-1 - size: 1 + size: {{ .Values.datacenter.size }} storageConfig: cassandraDataVolumeClaimSpec: storageClassName: {{ .Values.storageClassName }} diff --git a/charts/k8ssandra-test-cluster/values.yaml b/charts/k8ssandra-test-cluster/values.yaml index a34ca0da5f5..239dba3c21d 100644 --- a/charts/k8ssandra-test-cluster/values.yaml +++ b/charts/k8ssandra-test-cluster/values.yaml @@ -30,3 +30,11 @@ syncCACertToSecret: false # Limit syncing to this namespace. Otherwise, the secret is synced to all # namespaces. # syncCACertNamespace: + +# For telemetry data +prometheus: + enabled: true + +# Size of the datacenter +datacenter: + size: 1 From 693d66be6c40e948ea57ee7f265a4e5bf7381cbb Mon Sep 17 00:00:00 2001 From: Matthias Fischmann Date: Sat, 25 May 2024 21:58:13 +0200 Subject: [PATCH 06/64] Increase test coverage ever so slightly. (#4061) --- integration/test/Test/LegalHold.hs | 15 +++++++++++---- 1 file changed, 11 insertions(+), 4 deletions(-) diff --git a/integration/test/Test/LegalHold.hs b/integration/test/Test/LegalHold.hs index 583a1a4c49f..b0f4db871cc 100644 --- a/integration/test/Test/LegalHold.hs +++ b/integration/test/Test/LegalHold.hs @@ -871,20 +871,27 @@ testNoConsentCannotBeInvited = do legalholdWhitelistTeam tidLH legalholder >>= assertStatus 200 -- team without legalhold - (peer, _tidPeer, peer2 : _) <- createTeam OwnDomain 2 + (peer, _tidPeer, [peer2, peer3]) <- createTeam OwnDomain 3 - connectUsers =<< forM [peer, userLHNotActivated] make - connectUsers =<< forM [peer2, userLHNotActivated] make + connectUsers [peer, userLHNotActivated] + connectUsers [peer2, userLHNotActivated] withMockServer lhMockApp \lhDomAndPort _chan -> do postLegalHoldSettings tidLH legalholder (mkLegalHoldSettings lhDomAndPort) >>= assertStatus 201 cid <- postConversation userLHNotActivated defProteus {qualifiedUsers = [legalholder], newUsersRole = "wire_admin", team = Just tidLH} >>= getJSON 201 addMembers userLHNotActivated cid (def {users = [peer], role = Just "wire_admin"}) >>= assertSuccess + -- activate legalhold for legalholder requestLegalHoldDevice tidLH legalholder legalholder >>= assertSuccess + legalholdUserStatus tidLH legalholder legalholder `bindResponse` \resp -> do + resp.status `shouldMatchInt` 200 + resp.json %. "status" `shouldMatch` "pending" + + addMembers userLHNotActivated cid (def {users = [peer2]}) >>= assertSuccess + approveLegalHoldDevice tidLH (legalholder %. "qualified_id") defPassword >>= assertSuccess legalholdUserStatus tidLH legalholder legalholder `bindResponse` \resp -> do resp.status `shouldMatchInt` 200 resp.json %. "status" `shouldMatch` "enabled" - addMembers userLHNotActivated cid (def {users = [peer2]}) >>= assertLabel 403 "missing-legalhold-consent" + addMembers userLHNotActivated cid (def {users = [peer3]}) >>= assertLabel 403 "not-connected" From 352fbda42a3222f6362217ab7610eff9357457bd Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Marko=20Dimja=C5=A1evi=C4=87?= Date: Mon, 27 May 2024 10:41:54 +0200 Subject: [PATCH 07/64] [WPB-6718] Implement TLS support in Wire's Redis interface (#4016) * dockerephemeral: Run redis-cluster with TLS * Update hedis pin to support TLS with all nodes of a redis-cluster * gundeck.integration.yaml: Use IP address of the redis cluster node The certificates are valid only for IP addresses * Use fork of crypton-x509-validation to support IP Address validation * charts/{gundeck,integration}: Support TLS for redis hack: Enable TLS on redis and configure gundeck to not verify CA hack: Configure custom CA for redis in gundeck --------- Co-authored-by: Akshay Mankar Co-authored-by: Paolo Capriotti --- changelog.d/2-features/redis-tls | 20 ++++++ charts/gundeck/templates/_helpers.tpl | 40 +++++++++++ charts/gundeck/templates/configmap.yaml | 14 +++- charts/gundeck/templates/deployment.yaml | 18 +++++ charts/gundeck/templates/redis-ca-secret.yaml | 30 ++++++++ charts/gundeck/templates/tests/configmap.yaml | 2 + .../templates/tests/gundeck-integration.yaml | 9 +++ charts/gundeck/values.yaml | 35 ++++++++-- .../templates/integration-integration.yaml | 7 ++ deploy/dockerephemeral/docker-compose.yaml | 39 ++++++++++- .../docker/elasticsearch-ca.pem | 30 ++++---- .../docker/elasticsearch-cert.pem | 32 ++++----- .../docker/elasticsearch-key.pem | 50 +++++++------- deploy/dockerephemeral/docker/redis-ca.pem | 19 ++++++ .../docker/redis-node-1-cert.pem | 20 ++++++ .../docker/redis-node-1-key.pem | 27 ++++++++ .../dockerephemeral/docker/redis-node-1.conf | 11 ++- .../docker/redis-node-2-cert.pem | 20 ++++++ .../docker/redis-node-2-key.pem | 27 ++++++++ .../dockerephemeral/docker/redis-node-2.conf | 11 ++- .../docker/redis-node-3-cert.pem | 20 ++++++ .../docker/redis-node-3-key.pem | 27 ++++++++ .../dockerephemeral/docker/redis-node-3.conf | 11 ++- .../docker/redis-node-4-cert.pem | 20 ++++++ .../docker/redis-node-4-key.pem | 27 ++++++++ .../dockerephemeral/docker/redis-node-4.conf | 11 ++- .../docker/redis-node-5-cert.pem | 20 ++++++ .../docker/redis-node-5-key.pem | 27 ++++++++ .../dockerephemeral/docker/redis-node-5.conf | 11 ++- .../docker/redis-node-6-cert.pem | 20 ++++++ .../docker/redis-node-6-key.pem | 27 ++++++++ .../dockerephemeral/docker/redis-node-6.conf | 13 +++- .../federation-v0/integration-ca.pem | 34 +++++----- .../federation-v0/integration-leaf-key.pem | 50 +++++++------- .../federation-v0/integration-leaf.pem | 34 +++++----- .../src/developer/reference/config-options.md | 62 +++++++++++++++++ hack/bin/selfsigned.sh | 40 +++++++++++ hack/helm_vars/certs/elasticsearch-ca-key.pem | 27 ++++++++ hack/helm_vars/certs/elasticsearch-ca.pem | 19 ++++++ hack/helm_vars/certs/values.yaml.gotmpl | 68 +++++++++++++++++++ .../elasticsearch-ca-key.pem | 27 -------- .../elasticsearch-certs/elasticsearch-ca.pem | 19 ------ .../es-cert-issuer.yaml.gotmpl | 17 ----- .../redis-cluster/values.yaml.gotmpl | 3 + hack/helm_vars/wire-server/values.yaml.gotmpl | 8 +++ hack/helmfile.yaml | 26 +++++-- nix/haskell-pins.nix | 17 ++++- services/gundeck/default.nix | 2 + services/gundeck/gundeck.cabal | 1 + services/gundeck/gundeck.integration.yaml | 7 +- services/gundeck/src/Gundeck/Env.hs | 31 ++++++++- services/gundeck/src/Gundeck/Options.hs | 8 ++- services/gundeck/test/integration/API.hs | 18 +++-- services/integration.yaml | 2 + .../conf/nginz/integration-ca-key.pem | 50 +++++++------- .../conf/nginz/integration-ca.pem | 34 +++++----- .../conf/nginz/integration-leaf-key.pem | 50 +++++++------- .../conf/nginz/integration-leaf.pem | 34 +++++----- 58 files changed, 1085 insertions(+), 298 deletions(-) create mode 100644 changelog.d/2-features/redis-tls create mode 100644 charts/gundeck/templates/redis-ca-secret.yaml create mode 100644 deploy/dockerephemeral/docker/redis-ca.pem create mode 100644 deploy/dockerephemeral/docker/redis-node-1-cert.pem create mode 100644 deploy/dockerephemeral/docker/redis-node-1-key.pem create mode 100644 deploy/dockerephemeral/docker/redis-node-2-cert.pem create mode 100644 deploy/dockerephemeral/docker/redis-node-2-key.pem create mode 100644 deploy/dockerephemeral/docker/redis-node-3-cert.pem create mode 100644 deploy/dockerephemeral/docker/redis-node-3-key.pem create mode 100644 deploy/dockerephemeral/docker/redis-node-4-cert.pem create mode 100644 deploy/dockerephemeral/docker/redis-node-4-key.pem create mode 100644 deploy/dockerephemeral/docker/redis-node-5-cert.pem create mode 100644 deploy/dockerephemeral/docker/redis-node-5-key.pem create mode 100644 deploy/dockerephemeral/docker/redis-node-6-cert.pem create mode 100644 deploy/dockerephemeral/docker/redis-node-6-key.pem create mode 100644 hack/helm_vars/certs/elasticsearch-ca-key.pem create mode 100644 hack/helm_vars/certs/elasticsearch-ca.pem create mode 100644 hack/helm_vars/certs/values.yaml.gotmpl delete mode 100644 hack/helm_vars/elasticsearch-certs/elasticsearch-ca-key.pem delete mode 100644 hack/helm_vars/elasticsearch-certs/elasticsearch-ca.pem delete mode 100644 hack/helm_vars/elasticsearch-certs/es-cert-issuer.yaml.gotmpl diff --git a/changelog.d/2-features/redis-tls b/changelog.d/2-features/redis-tls new file mode 100644 index 00000000000..d2823f0cf1e --- /dev/null +++ b/changelog.d/2-features/redis-tls @@ -0,0 +1,20 @@ +Support connecting to Redis over TLS + +It can be enabled by setting these options on the wire-server helm chart: + +```yaml +gundeck: + config: + redis: + enableTls: true + + # When custom CAs are required, one of these must be set: + tlsCa: + tlsCaSecretRef: + name: + key: + + # When TLS needs to be used without verification: + insecureSkipVerifyTls: true +``` +(##) diff --git a/charts/gundeck/templates/_helpers.tpl b/charts/gundeck/templates/_helpers.tpl index ed317e0b213..e51069720fc 100644 --- a/charts/gundeck/templates/_helpers.tpl +++ b/charts/gundeck/templates/_helpers.tpl @@ -23,3 +23,43 @@ created one (in case the CA is provided as PEM string.) {{- dict "name" "gundeck-cassandra" "key" "ca.pem" | toYaml -}} {{- end -}} {{- end -}} + +{{- define "configureRedisCa" -}} +{{ or (hasKey .redis "tlsCa") (hasKey .redis "tlsCaSecretRef") }} +{{- end -}} + +{{- define "redisTlsSecretName" -}} +{{- if .redis.tlsCaSecretRef -}} +{{ .redis.tlsCaSecretRef.name }} +{{- else }} +{{- print "gundeck-redis-ca" -}} +{{- end -}} +{{- end -}} + +{{- define "redisTlsSecretKey" -}} +{{- if .redis.tlsCaSecretRef -}} +{{ .redis.tlsCaSecretRef.key }} +{{- else }} +{{- print "ca.pem" -}} +{{- end -}} +{{- end -}} + +{{- define "configureAdditionalRedisCa" -}} +{{ and (hasKey . "redisAdditionalWrite") (or (hasKey .redisAdditionalWrite "additionalTlsCa") (hasKey .redis "additionalTlsCaSecretRef")) }} +{{- end -}} + +{{- define "additionalRedisTlsSecretName" -}} +{{- if .redis.additionalTlsCaSecretRef -}} +{{ .redis.additionalTlsCaSecretRef.name }} +{{- else }} +{{- print "gundeck-additional-redis-ca" -}} +{{- end -}} +{{- end -}} + +{{- define "additionalRedisTlsSecretKey" -}} +{{- if .redis.additionalTlsCaSecretRef -}} +{{ .redis.additionalTlsCaSecretRef.key }} +{{- else }} +{{- print "ca.pem" -}} +{{- end -}} +{{- end -}} diff --git a/charts/gundeck/templates/configmap.yaml b/charts/gundeck/templates/configmap.yaml index bd49b906760..446fa7bab39 100644 --- a/charts/gundeck/templates/configmap.yaml +++ b/charts/gundeck/templates/configmap.yaml @@ -33,10 +33,22 @@ data: host: {{ .redis.host }} port: {{ .redis.port }} connectionMode: {{ .redis.connectionMode }} + enableTls: {{ .redis.enableTls }} + insecureSkipVerifyTls: {{ .redis.insecureSkipVerifyTls }} + {{- if eq (include "configureRedisCa" .) "true" }} + tlsCa: /etc/wire/gundeck/redis-ca/{{ include "redisTlsSecretKey" .}} + {{- end }} {{- if .redisAdditionalWrite }} redisAdditionalWrite: - {{- toYaml .redisAdditionalWrite | nindent 6 }} + host: {{ .redisAdditionalWrite.host }} + port: {{ .redisAdditionalWrite.port }} + connectionMode: {{ .redisAdditionalWrite.connectionMode }} + enableTls: {{ .redisAdditionalWrite.enableTls }} + insecureSkipVerifyTls: {{ .redisAdditionalWrite.insecureSkipVerifyTls }} + {{- if eq (include "configureAdditionalRedisCa" .) "true" }} + tlsCa: /etc/wire/gundeck/additional-redis-ca/{{ include "additionalRedisTlsSecretKey" .}} + {{- end }} {{- end }} # Gundeck uses discovery for AWS access key / secrets diff --git a/charts/gundeck/templates/deployment.yaml b/charts/gundeck/templates/deployment.yaml index ec1e064ccc2..5afbdd9c4cf 100644 --- a/charts/gundeck/templates/deployment.yaml +++ b/charts/gundeck/templates/deployment.yaml @@ -37,6 +37,16 @@ spec: secret: secretName: {{ (include "tlsSecretRef" .Values.config | fromYaml).name }} {{- end}} + {{- if eq (include "configureRedisCa" .Values.config) "true" }} + - name: "redis-ca" + secret: + secretName: {{ include "redisTlsSecretName" .Values.config }} + {{- end }} + {{- if eq (include "configureAdditionalRedisCa" .Values.config) "true" }} + - name: "additional-redis-ca" + secret: + secretName: {{ include "additionalRedisTlsSecretName" .Values.config }} + {{- end }} containers: - name: gundeck image: "{{ .Values.image.repository }}:{{ .Values.image.tag }}" @@ -52,6 +62,14 @@ spec: - name: "gundeck-cassandra" mountPath: "/etc/wire/gundeck/cassandra" {{- end }} + {{- if eq (include "configureRedisCa" .Values.config) "true" }} + - name: "redis-ca" + mountPath: "/etc/wire/gundeck/redis-ca/" + {{- end }} + {{- if eq (include "configureAdditionalRedisCa" .Values.config) "true" }} + - name: "additional-redis-ca" + mountPath: "/etc/wire/gundeck/additional-redis-ca/" + {{- end }} env: {{- if hasKey .Values.secrets "awsKeyId" }} - name: AWS_ACCESS_KEY_ID diff --git a/charts/gundeck/templates/redis-ca-secret.yaml b/charts/gundeck/templates/redis-ca-secret.yaml new file mode 100644 index 00000000000..84c6aa59128 --- /dev/null +++ b/charts/gundeck/templates/redis-ca-secret.yaml @@ -0,0 +1,30 @@ +--- +{{- if not (empty .Values.config.redis.tlsCa) }} +apiVersion: v1 +kind: Secret +metadata: + name: "gundeck-redis-ca" + labels: + app: gundeck + chart: {{ .Chart.Name }}-{{ .Chart.Version | replace "+" "_" }} + release: "{{ .Release.Name }}" + heritage: "{{ .Release.Service }}" +type: Opaque +data: + ca.pem: {{ .Values.redis.tlsCa | b64enc | quote }} +{{- end }} +--- +{{- if not (empty .Values.config.redis.additionalTlsCa) }} +apiVersion: v1 +kind: Secret +metadata: + name: "gundeck-additional-redis-ca" + labels: + app: gundeck + chart: {{ .Chart.Name }}-{{ .Chart.Version | replace "+" "_" }} + release: "{{ .Release.Name }}" + heritage: "{{ .Release.Service }}" +type: Opaque +data: + ca.pem: {{ .Values.redis.additionalTlsCa | b64enc | quote }} +{{- end }} diff --git a/charts/gundeck/templates/tests/configmap.yaml b/charts/gundeck/templates/tests/configmap.yaml index b3e1423acf6..dd05cb6d4df 100644 --- a/charts/gundeck/templates/tests/configmap.yaml +++ b/charts/gundeck/templates/tests/configmap.yaml @@ -44,3 +44,5 @@ data: host: redis-ephemeral-2-master port: 6379 connectionMode: master + enableTls: false + insecureSkipVerifyTls: false diff --git a/charts/gundeck/templates/tests/gundeck-integration.yaml b/charts/gundeck/templates/tests/gundeck-integration.yaml index 088ed679bdb..9aa7b56347d 100644 --- a/charts/gundeck/templates/tests/gundeck-integration.yaml +++ b/charts/gundeck/templates/tests/gundeck-integration.yaml @@ -18,6 +18,11 @@ spec: secret: secretName: {{ (include "tlsSecretRef" .Values.config | fromYaml).name }} {{- end}} + {{- if eq (include "configureRedisCa" .Values.config) "true" }} + - name: "redis-ca" + secret: + secretName: {{ include "redisTlsSecretName" .Values.config }} + {{- end }} containers: - name: integration # TODO: When deployed to staging (or real AWS env), _all_ tests should be run @@ -63,6 +68,10 @@ spec: - name: "gundeck-cassandra" mountPath: "/etc/wire/gundeck/cassandra" {{- end }} + {{- if eq (include "configureRedisCa" .Values.config) "true" }} + - name: "redis-ca" + mountPath: "/etc/wire/gundeck/redis-ca/" + {{- end }} env: # these dummy values are necessary for Amazonka's "Discover" - name: AWS_ACCESS_KEY_ID diff --git a/charts/gundeck/values.yaml b/charts/gundeck/values.yaml index 80816a0eaad..ea8b6406a51 100644 --- a/charts/gundeck/values.yaml +++ b/charts/gundeck/values.yaml @@ -20,21 +20,42 @@ config: logNetStrings: false cassandra: host: aws-cassandra -# To enable TLS provide a CA: -# tlsCa: -# -# Or refer to an existing secret (containing the CA): -# tlsCaSecretRef: -# name: -# key: + # To enable TLS provide a CA: + # tlsCa: + # + # Or refer to an existing secret (containing the CA): + # tlsCaSecretRef: + # name: + # key: redis: host: redis-ephemeral-master port: 6379 connectionMode: "master" # master | cluster + enableTls: false + insecureSkipVerifyTls: false + # To configure custom TLS CA, please provide one of these: + # tlsCa: + # + # Or refer to an existing secret (containing the CA): + # tlsCaSecretRef: + # name: + # key: + + # To enable additional writes during a migration: # redisAdditionalWrite: # host: redis-two # port: 6379 # connectionMode: master + # enableTls: false + # insecureSkipVerifyTls: false + # + # # To configure custom TLS CA, please provide one of these: + # # tlsCa: + # # + # # Or refer to an existing secret (containing the CA): + # # tlsCaSecretRef: + # # name: + # # key: bulkPush: true aws: region: "eu-west-1" diff --git a/charts/integration/templates/integration-integration.yaml b/charts/integration/templates/integration-integration.yaml index fa5e32bb604..324f6ebe609 100644 --- a/charts/integration/templates/integration-integration.yaml +++ b/charts/integration/templates/integration-integration.yaml @@ -80,6 +80,10 @@ spec: secret: secretName: {{ .Values.config.elasticsearch.tlsCaSecretRef.name }} + - name: redis-ca + secret: + secretName: {{ .Values.config.redis.tlsCaSecretRef.name }} + {{- if eq (include "useCassandraTLS" .Values.config) "true" }} - name: integration-cassandra secret: @@ -239,6 +243,9 @@ spec: - name: elasticsearch-ca mountPath: /etc/wire/brig/elasticsearch-ca + - name: redis-ca + mountPath: /etc/wire/gundeck/redis-ca + {{- if eq (include "useCassandraTLS" .Values.config) "true" }} - name: "integration-cassandra" mountPath: "/certs" diff --git a/deploy/dockerephemeral/docker-compose.yaml b/deploy/dockerephemeral/docker-compose.yaml index b44ad1932d0..c5aa74fe889 100644 --- a/deploy/dockerephemeral/docker-compose.yaml +++ b/deploy/dockerephemeral/docker-compose.yaml @@ -90,7 +90,26 @@ services: redis-cluster: image: 'redis:6.0-alpine' - command: redis-cli --cluster create 172.20.0.31:6373 172.20.0.32:6374 172.20.0.33:6375 172.20.0.34:6376 172.20.0.35:6377 172.20.0.36:6378 --cluster-replicas 1 --cluster-yes -a very-secure-redis-cluster-password + command: + - redis-cli + - --cluster + - create + - 172.20.0.31:6373 + - 172.20.0.32:6374 + - 172.20.0.33:6375 + - 172.20.0.34:6376 + - 172.20.0.35:6377 + - 172.20.0.36:6378 + - --cluster-replicas + - "1" + - --cluster-yes + - -a + - very-secure-redis-cluster-password + - --cacert + - /usr/local/etc/redis/ca.pem + - --tls + volumes: + - ./docker/redis-ca.pem:/usr/local/etc/redis/ca.pem networks: redis: ipv4_address: 172.20.0.30 @@ -109,6 +128,9 @@ services: volumes: - redis-node-1-data:/var/lib/redis - ./docker/redis-node-1.conf:/usr/local/etc/redis/redis.conf + - ./docker/redis-node-1-cert.pem:/usr/local/etc/redis/cert.pem + - ./docker/redis-node-1-key.pem:/usr/local/etc/redis/key.pem + - ./docker/redis-ca.pem:/usr/local/etc/redis/ca.pem networks: redis: ipv4_address: 172.20.0.31 @@ -120,6 +142,9 @@ services: volumes: - redis-node-2-data:/var/lib/redis - ./docker/redis-node-2.conf:/usr/local/etc/redis/redis.conf + - ./docker/redis-node-2-cert.pem:/usr/local/etc/redis/cert.pem + - ./docker/redis-node-2-key.pem:/usr/local/etc/redis/key.pem + - ./docker/redis-ca.pem:/usr/local/etc/redis/ca.pem networks: redis: ipv4_address: 172.20.0.32 @@ -131,6 +156,9 @@ services: volumes: - redis-node-3-data:/var/lib/redis - ./docker/redis-node-3.conf:/usr/local/etc/redis/redis.conf + - ./docker/redis-node-3-cert.pem:/usr/local/etc/redis/cert.pem + - ./docker/redis-node-3-key.pem:/usr/local/etc/redis/key.pem + - ./docker/redis-ca.pem:/usr/local/etc/redis/ca.pem networks: redis: ipv4_address: 172.20.0.33 @@ -142,6 +170,9 @@ services: volumes: - redis-node-4-data:/var/lib/redis - ./docker/redis-node-4.conf:/usr/local/etc/redis/redis.conf + - ./docker/redis-node-4-cert.pem:/usr/local/etc/redis/cert.pem + - ./docker/redis-node-4-key.pem:/usr/local/etc/redis/key.pem + - ./docker/redis-ca.pem:/usr/local/etc/redis/ca.pem networks: redis: ipv4_address: 172.20.0.34 @@ -153,6 +184,9 @@ services: volumes: - redis-node-5-data:/var/lib/redis - ./docker/redis-node-5.conf:/usr/local/etc/redis/redis.conf + - ./docker/redis-node-5-cert.pem:/usr/local/etc/redis/cert.pem + - ./docker/redis-node-5-key.pem:/usr/local/etc/redis/key.pem + - ./docker/redis-ca.pem:/usr/local/etc/redis/ca.pem networks: redis: ipv4_address: 172.20.0.35 @@ -164,6 +198,9 @@ services: volumes: - redis-node-6-data:/var/lib/redis - ./docker/redis-node-6.conf:/usr/local/etc/redis/redis.conf + - ./docker/redis-node-6-cert.pem:/usr/local/etc/redis/cert.pem + - ./docker/redis-node-6-key.pem:/usr/local/etc/redis/key.pem + - ./docker/redis-ca.pem:/usr/local/etc/redis/ca.pem networks: redis: ipv4_address: 172.20.0.36 diff --git a/deploy/dockerephemeral/docker/elasticsearch-ca.pem b/deploy/dockerephemeral/docker/elasticsearch-ca.pem index d4ef94d4d2a..f56c3396fcf 100644 --- a/deploy/dockerephemeral/docker/elasticsearch-ca.pem +++ b/deploy/dockerephemeral/docker/elasticsearch-ca.pem @@ -1,19 +1,19 @@ -----BEGIN CERTIFICATE----- -MIIDHjCCAgagAwIBAgIUXd/KjPrGXSmRyZ4Q/9O3LPGB70owDQYJKoZIhvcNAQEL +MIIDHjCCAgagAwIBAgIUSYROJq4Fwdnd/Jfaeyg2Fk6cCKEwDQYJKoZIhvcNAQEL BQAwJzElMCMGA1UEAxMcZWxhc3RpY3NlYXJjaC5jYS5leGFtcGxlLmNvbTAeFw0y -NDA0MjIxMjA0MDBaFw0yOTA0MjExMjA0MDBaMCcxJTAjBgNVBAMTHGVsYXN0aWNz +NDA0MjkxMjQ2MDBaFw0yOTA0MjgxMjQ2MDBaMCcxJTAjBgNVBAMTHGVsYXN0aWNz ZWFyY2guY2EuZXhhbXBsZS5jb20wggEiMA0GCSqGSIb3DQEBAQUAA4IBDwAwggEK -AoIBAQC0R+Ptk46Hd8SrR+S/dM7nGvhYA2ErWUFhpyUDWi7VpUpTgtlyTzmNgxAl -h9QWn8GuqvwqCFBnbiLL+OV6EsT1/fKt/3iYVv+myg5gBTPHt/QNaHZ5E7wMdwDR -HRuAKQI9kCdZZZ7/prVPTQDx0E12yxMWbE+NgvYfNmkJXSG3Y5S5ihE8RO+JZYec -AWfc3iwEZeD7d9WnVsb0sM+iJwMOOTlxKSI8Cw+ukcXdTh9pmxyQNZVd1tSGX/NH -281EKroIPLqIAxgy1d2cUqiCKIf4pGEbijb8m/OkoFez+7vjmD57A8uSuwyXz7+x -E2uRJFAisug5zdb8KWAJBlEkggWbAgMBAAGjQjBAMA4GA1UdDwEB/wQEAwIBBjAP -BgNVHRMBAf8EBTADAQH/MB0GA1UdDgQWBBQ1/LWQ/Ckxpc7HdBp6mNBfZNQssDAN -BgkqhkiG9w0BAQsFAAOCAQEAfGo1ONgSfTwRtT/ZsZgAnseqZSQCuvUQ4nrg2dDe -cFZtC05EczfmPx7G7Q2VeF9ZU56m/Ep57gE4W2wwVIwoG3Zam0kG4HirkgLNPagf -j3RkDrCvrjeESYFj7qwdnmgFNxotlC0KjHkGrfdT7gTDSWoNE3tobxyFaT1YQyBB -L6oRVlKa6O0ivgADUw/VMIARqFgCni/PhaHd4UlR9bgLVQ4MEVb463MMpGAdK4ZZ -l1bYVRf0pTeYnEiUG2HXt/1JFzSowFoZD8wVOXa0kcxy9SK/UCX8PVzMx06G4Ion -NNkzz9uSme9hAQlVsW6gxzl0NhwOtClpPIlvEqHwgF54KQ== +AoIBAQDMOswRecurkvL3ONZ2g63L2UVgd8VHUYMAImbcZz8e/P0NxjR79Se2/kvV +r57A3iem4Vjqjh7OXf6AebNh6QQGyBO0SgCGOcKymPhatucDN2isTGKpMF10mUZE +RCX5JWC2nUG7lpBaKpZ5l8IWyZphh0O4JpMO9FUbnPPWg7vdVfwM4+20t4jB0LFF +21b8wxy+JZ6G8Oi9I8DwUlmpgINcmsu1PKx82gNQ6Ey5M1CUPODg3Bm5nH79m2KQ +jqWXJSvWwLqL8ZUr257pCwPgWkYuwleodcKdmSVaz3FpR28xUapFRP+/G4i/RMf3 +soAzQVinbq3qLJGOkdVwfT9iTCPjAgMBAAGjQjBAMA4GA1UdDwEB/wQEAwIBBjAP +BgNVHRMBAf8EBTADAQH/MB0GA1UdDgQWBBTMfBqgo5cmKmYOfq79rwuw4oKRfDAN +BgkqhkiG9w0BAQsFAAOCAQEAPi4E/Q23DbSFLtRMxNIWl+aX8Ps50KJzIhrv9T1d +q0t73lXe6agQjKUVBqaf662JZ/r5ihBNiiaU7x5ieaz+3OaA8QsHuGd67p/eDu1L +zoX+EfagpIuT1r3aJeo0551pGhYDw+xhtaib/kc5sxfUBL5EoCyVi0RpwAH7cFwr +FOsVaOVetqbfTUqDYdnXufrV+IX9ZtXnz6yvdKdizdDrz6P+yBxGKQeYMkCGiUvY +nFvb1F5WH0lCM1klJilW8WHvGDsEmhgCRoRfJvlUk/I217KumCXPHh6pwiT5VwWL +ANPKWH9AyHvyXsP44zF4OMtEqQJVzxzPdnmPwWWH10iptA== -----END CERTIFICATE----- diff --git a/deploy/dockerephemeral/docker/elasticsearch-cert.pem b/deploy/dockerephemeral/docker/elasticsearch-cert.pem index 5de2ffadd23..0dcaef43035 100755 --- a/deploy/dockerephemeral/docker/elasticsearch-cert.pem +++ b/deploy/dockerephemeral/docker/elasticsearch-cert.pem @@ -1,20 +1,20 @@ -----BEGIN CERTIFICATE----- -MIIDTzCCAjegAwIBAgIUZg82eQUqHA61XD0suiu4Gp5C0rswDQYJKoZIhvcNAQEL +MIIDTzCCAjegAwIBAgIUL99uqBawgDCHt3QSK/GFH1YuQ8MwDQYJKoZIhvcNAQEL BQAwJzElMCMGA1UEAxMcZWxhc3RpY3NlYXJjaC5jYS5leGFtcGxlLmNvbTAeFw0y -NDA0MjIxMjA0MDBaFw0yNTA0MjIxMjA0MDBaMAAwggEiMA0GCSqGSIb3DQEBAQUA -A4IBDwAwggEKAoIBAQC4I8zWkyQGetTaVB7GuDi8dDqEabCHis6TVaA8hORbCSs/ -swlPM5e8gJuyuQIOiyC07Ai4sl/C5lyjbMK4eaBz+jB3tGA1YEgZzruZiKJV0JlN -kzTWFly5960quj7XuD2vlJ+0+ozT3GDsykh675mBx6LRF+/eWd9VFcexxqXvj0GC -M+01ffT8Ue0CvhxtGhg89m1NY4Lo3n/22PCPHnSqMJGbTx7gVpUs1eDQ6rgMIoES -kstFLgq5JiTr4ojLq1q2iGjAbxR+DCle/6abUMCcegBHBN6n5hAPO4X++T/moOta -3FIjwJN68SGRG3V4BNOE1x1nunKxQjKzsOqU0SvbAgMBAAGjgZkwgZYwDgYDVR0P +NDA0MjkxMjQ2MDBaFw0yNTA0MjkxMjQ2MDBaMAAwggEiMA0GCSqGSIb3DQEBAQUA +A4IBDwAwggEKAoIBAQDAcLADA+sdJUM4cJ8NI0hF+xnlLqCNqbIt9DLgGzqflPcg +NP9grELdFlPsJwpev3vb98YQobM4IbVf/KLAgUzXxsMyGM+srmzWXdMWw3ZoRCBg +udZGHEZowJ6eqcvMYP1WIeUfyxMdJiIljUJvw2C497MGI/ltNFTkj2igub0tO9d3 +9ALIpNc+Zgv+FwrxQMQyinzzZvOd8nlZ+0mkbCTUYdVQbQV/5A5dbpPYFZqckECd +vWIdE3wEZIuKfuaXh9pP4h2eWeWqyYneHR+kk8Rg8AGyPSQDEKXbLvaVhmHBoR+Y +Dd358/B8sblwe9VjVQJisDMKdEm7fFYW7gxQEeA9AgMBAAGjgZkwgZYwDgYDVR0P AQH/BAQDAgWgMB0GA1UdJQQWMBQGCCsGAQUFBwMBBggrBgEFBQcDAjAMBgNVHRMB -Af8EAjAAMB0GA1UdDgQWBBTsbRvngQ1YdeLmiHuDEHTWlTufXjAfBgNVHSMEGDAW -gBQ1/LWQ/Ckxpc7HdBp6mNBfZNQssDAXBgNVHREBAf8EDTALgglsb2NhbGhvc3Qw -DQYJKoZIhvcNAQELBQADggEBAElA1AylS20xyMtFlFda/f3neLapwRf9beVLbzR3 -4N+VaN6ZeUeO62E5t1nFWayguapPkAPW5YkQtW72KlthcIKKwu+WOMUxUJmiVfJJ -hNtBSx5RpEoiJ7qi0gQCUshYoU/B5tlRTgy+vstXCbP9ME/B2Oqn2RN5PsrRmiYU -/hJ6WqQiRaX7ysrn1cCyDMjCpBv2s4QZVBD/08l8sZfeOpxxgWj6cy4ucHn3Vbvi -4MQvwWPuAGpJy7w77v1na8DRjEnMlYoMyoDVjKAFBwwTo+8rWfLsnDSWtAHDQJsI -eluO9vR0JNNEp3f/mV4lqeFwdgN6cJzYDfePdWpqGrTSL4U= +Af8EAjAAMB0GA1UdDgQWBBRl/0SDwVrMKGh7qI61cv+J5NJrKTAfBgNVHSMEGDAW +gBTMfBqgo5cmKmYOfq79rwuw4oKRfDAXBgNVHREBAf8EDTALgglsb2NhbGhvc3Qw +DQYJKoZIhvcNAQELBQADggEBALBOvIBacwxw0za1O73EsAn1WIN7sdYIMQPNk5Q5 +gSeJs7zrvIbvIuVJdA7JWppE23ex36a87UPvJg0kfPjZQbZCVakL5YQgbFuskFOn +9yGiS5c/HF0gEuAwbelkAhIzGFHOF8gOFkjgsbA7ptuWGiCdxPzDMw6LAhehrdKT +xqjxPmLOtOHSz43/8FY0BTtrB4Y/yvBkz/AWNMn9WkSr9lPUHrD3+Amemlzp8a42 +qDk9wmcia5E0u50y8TvS3dz5vIS1uEXeqoK18qW+Sb7ManDvSbXf0oxFm/ZAmC5j +9q+nOCYZHWFmjizMHDK3C2VoGYtbN3d0JLdC2B9XFC54B5g= -----END CERTIFICATE----- diff --git a/deploy/dockerephemeral/docker/elasticsearch-key.pem b/deploy/dockerephemeral/docker/elasticsearch-key.pem index ee573176b4d..7a527e61e95 100755 --- a/deploy/dockerephemeral/docker/elasticsearch-key.pem +++ b/deploy/dockerephemeral/docker/elasticsearch-key.pem @@ -1,27 +1,27 @@ -----BEGIN RSA PRIVATE KEY----- -MIIEpAIBAAKCAQEAuCPM1pMkBnrU2lQexrg4vHQ6hGmwh4rOk1WgPITkWwkrP7MJ -TzOXvICbsrkCDosgtOwIuLJfwuZco2zCuHmgc/owd7RgNWBIGc67mYiiVdCZTZM0 -1hZcufetKro+17g9r5SftPqM09xg7MpIeu+Zgcei0Rfv3lnfVRXHscal749BgjPt -NX30/FHtAr4cbRoYPPZtTWOC6N5/9tjwjx50qjCRm08e4FaVLNXg0Oq4DCKBEpLL -RS4KuSYk6+KIy6tatohowG8UfgwpXv+mm1DAnHoARwTep+YQDzuF/vk/5qDrWtxS -I8CTevEhkRt1eATThNcdZ7pysUIys7DqlNEr2wIDAQABAoIBABR7lvt/XpCB9U9b -8Bh2wYjk/OVhxEsve48UBUD2H1ipCnCJf82ZlZVYUPlubvYjL74wS0AQR2qsqT1c -icRvcxOzjtSh8dm+HgcQ4flQI46cJ5FjgIsX7bSaAl8wXHEug14WkDVXcXbXmsh8 -L9fM8yxmgovzt7DqGleilpYF3Mtq2bNYMm7q74SKSaiz/FplgYpFJJ+jWG4ExELN -mzmMFjQQ77n0ORsnyXAzIHy4XE5loj2oHlLene5XUbNv02Bi4kY5GRADVaxEphKK -YD6m2ktLHJXzfqpsdmzup3nKi7j+m0sOcMr3SC+JBqjwwG6cyhENmPxi6fKK4XhS -bPo2JyECgYEA3ovs9f5jUMV0uZ/4jGI9rNGXgQo1DPpY2zz8UvYBN/erk8+PLxK1 -mNns5Lt5UFeduRwwbNSIUR817dLLeRnNClxOjS3aaT6jCciHVGiXkWFzCbnaV9Xl -Ozv4V+s9Duwu7sqAnZrW47ykjU9G9UrsmlidoLDKXHwAshwDXkN7wiMCgYEA09Hm -ZyC4ypR94yUMmgCKq57T5mfYJEXZoe6KlQ8zTJCOjOZesl767vrjV4hijML9I25U -dqLCxf+7ifJWhgfBJNbXfHAVEPWVkazJ1ZF/6UXvKIUoHfcL9/aNQv2uX1kto7sR -wUSSxIDxaNqtnRB3gYS67PKju0ZvFU3d0qtDPukCgYAeLK7Gc+WXcA5xlMUok7F1 -Gz4FmxKyXcdqgoxb20szAXvcIMpzQYAp53J9WQYL5LVYAgB24SJSjX7MbkZ0dxEc -FIP6FHuGxZ1pmCzxPvU+Gw50BSUbv77DF1CG6zhuK4v5iK+Drxjv7AYLuvIOFEic -bOOChDYL8CxP+ghi4ZeILQKBgQCfeFt6MMxu17SfGfmOx/Gem4j04iF7zYq3uxti -dXstnXd05MtOhutsmD4oXGm1h+eEkT/NwWPaJVpP1L8HUTc8QPMioE974Sil7+xU -eaJPQXN4kidNx/yexmQ7lzl8V2tg5SnM04+bmWgmhNxIb2lJfWAtm89g4vomk+T5 -Ai8yYQKBgQDAEtH13565FJnd0qxYI+o1ooNbAhVQx/bR6tWaMF3/h4fQi5vTn1/6 -Z6f9Y8koJSoxNxkN1hpg0h2SqzAFtvUfpSyRMaYunm4VXNRsGOJALzgOwGlZ/3C9 -v6tnxXBASSfwOeFr3ToYlTTJg6b612cTHb6w4VyDA+Sy96YLbnd9Cg== +MIIEowIBAAKCAQEAwHCwAwPrHSVDOHCfDSNIRfsZ5S6gjamyLfQy4Bs6n5T3IDT/ +YKxC3RZT7CcKXr972/fGEKGzOCG1X/yiwIFM18bDMhjPrK5s1l3TFsN2aEQgYLnW +RhxGaMCenqnLzGD9ViHlH8sTHSYiJY1Cb8NguPezBiP5bTRU5I9ooLm9LTvXd/QC +yKTXPmYL/hcK8UDEMop882bznfJ5WftJpGwk1GHVUG0Ff+QOXW6T2BWanJBAnb1i +HRN8BGSLin7ml4faT+IdnlnlqsmJ3h0fpJPEYPABsj0kAxCl2y72lYZhwaEfmA3d ++fPwfLG5cHvVY1UCYrAzCnRJu3xWFu4MUBHgPQIDAQABAoIBAAof46LE+gG2jCrU +Ago26P6Fj383TMsnOnCggGy6AgOTWs0e/LChX4MyQYgTJcCGYoXYK1uEpmE1pM1A +BXALXXecxXhFRefX5XIBzbFM51Xk/68XF+boZevs9mtyk35VO/7kGaHqlT7bWsCP +BgfLR7NzlL+l9OGB91VvFhoeq41NmVP/qLEeQRxYEGIuhsQ3cuCd6GnX2lnbqMFX +1KeseJXL7IuCvkiLc0x1PFX2AwXnLXI0sVcPdcO6ekfWBJmId8/+q10/DaCbLHPY +SAbX0tmO1CAz6PpHnzWgsji0JVxlmohk8dlp+d706TCtInQmwTnm1sXnpUUMOQLZ +LmrGZQECgYEA2PksOsTL+gakrYdIGD0/p4oxlaBogkFEHNv9ul2IeZTRkbDn6kVl +beNsyBKhDqnfgtRfZiLU8bQLDMTw10vzWzXyZghWIDkePVy/98qIDZKCzQ6pTNoY +o0pUuSVcNB6DyOEDlT3pimsSDhHDhK+IPf6XMsL2P+/+D8JxkL0DxlkCgYEA4w3a +cKTj++lDsNvdIgRSjYGuW8Kj2S3nyDkL9qn/kPIDUeuZwxPCDcX+xGgHLv+YI9im +x24CMPtk7av9/YJxWj2v6chSjjr283uqrY83isAL94hAmO2HC632wvoWIIeSbgdD +u3375kvsR8M5kVltVUU03hInFVNmqP9i2SCn9IUCgYBDqgFHGpRaFrRIgYXUOVWe +lBQ+i1XMOTpanaiU9BJZiDWK79aDUrz89g24n0am4gcYL87IdVhfQDyp8MkC+2ab +LUm41CS3y9hIXqJnTjv7r5MnC8l0dBd25Pli++mzP0jt3m5Vnoc0aYup45RLzsn4 +O2s/o1lUOy3KEGOGNcv1kQKBgQCn+UO1OgeAAh4V5VI/LDt2fI3lTKWysgdbVPjI +zxNGxAQ4wrfKXf+d+PB1lRBbcLO5MTqRJ41vd0w/mJIazjnVrPVLWuvYVT8E+mRW +ajGI8HLp+V7wxCi4N0brD+D2x9VImQ8+0gFdaqWuoXshUKtV/hESiRNo735vYCBc +yY/3kQKBgAhWQTx4SnH0RZdglC7yyWRgaQLs8sTN9PIKUN7rwwCxhxLw8DblVnvN +0QuwHwhQXQuNMrVojpr+zjFR9MJqvTEapfygGxLXlUFFnUGmdG5ejpxLppy/rj8n +HJ+5kgnS2Cw8CLsK4NE26DVqdMGOywZa2UZu9Yn293RO0Wu8pNRa -----END RSA PRIVATE KEY----- diff --git a/deploy/dockerephemeral/docker/redis-ca.pem b/deploy/dockerephemeral/docker/redis-ca.pem new file mode 100644 index 00000000000..11abcf1541f --- /dev/null +++ b/deploy/dockerephemeral/docker/redis-ca.pem @@ -0,0 +1,19 @@ +-----BEGIN CERTIFICATE----- +MIIDDjCCAfagAwIBAgIUXuktejnrKBHV68B+WH1eONMIhDcwDQYJKoZIhvcNAQEL +BQAwHzEdMBsGA1UEAxMUcmVkaXMuY2EuZXhhbXBsZS5jb20wHhcNMjQwNDI5MTI0 +NjAwWhcNMjkwNDI4MTI0NjAwWjAfMR0wGwYDVQQDExRyZWRpcy5jYS5leGFtcGxl +LmNvbTCCASIwDQYJKoZIhvcNAQEBBQADggEPADCCAQoCggEBAO2+EAh/J21wqCmM +tcFh2vPZXb7ssVY75FfhUw/2JVjhh46vI3aO58g6FW6MT6tmJL81/HnGSiDaKw2o +5MD8wi0QMiTUp5sfwNuF3MfKKXxK3/S7Ue6SXMbpvpQkrQjdQmQ8pqC07CPUSetG +WhUPO/Pb7SKYZgY+XG2FsPQFH0cpPqTcqDX9ZA3Ron45ox5WCQB9tLnNU5+OB3vt +lvvCr5s7cAtsV/T6TGUD3obILWimjnNOBbHBc37qGSCzwerIgbZX2EgVEaKvAIDw +kUkxqisjukcnmG7KlvXF/YeD2dXrDr5MqusSWUY/zSfMDvFtCKAfzKANM+XKm4Lr +c0HBAEECAwEAAaNCMEAwDgYDVR0PAQH/BAQDAgEGMA8GA1UdEwEB/wQFMAMBAf8w +HQYDVR0OBBYEFEPmDlC9GfIxXt/Bj53TrS99/NXaMA0GCSqGSIb3DQEBCwUAA4IB +AQAw5CtNPdpPusNGBfKvcEfpBmedi7AgkY5bDqQiy3GOPB/PgnxS0zkKzLN0GoTg +I7azplHoUwoUX1mOGPraB0POuLMq9it4+tn5NChNSeAOVuomS83/AJkALaZRHQvp +0+7DWd7gYe6b0TPjErpKQS0OJO5IxozNQxTo39X6pGVV46mvtvHrVJWEecWjhyKi +viEB3ellqCqGK4opWq7rxvlvJvOiUPwNM7eCigFFWODtMCmcjNpgUqlGWa9rmrlY +Xn6jFWU+JzxXfrM8Isnk1TWinwnSFs9q9xV725g4Oaze87uvgkapMTGtGLWiSszG +DpxpABe/kIz5EkTBfJSL9Q7i +-----END CERTIFICATE----- diff --git a/deploy/dockerephemeral/docker/redis-node-1-cert.pem b/deploy/dockerephemeral/docker/redis-node-1-cert.pem new file mode 100644 index 00000000000..afe2ff8f0bc --- /dev/null +++ b/deploy/dockerephemeral/docker/redis-node-1-cert.pem @@ -0,0 +1,20 @@ +-----BEGIN CERTIFICATE----- +MIIDSzCCAjOgAwIBAgIUWt3CgFmrYNrum+X6kJUSXzoOL7wwDQYJKoZIhvcNAQEL +BQAwHzEdMBsGA1UEAxMUcmVkaXMuY2EuZXhhbXBsZS5jb20wHhcNMjQwNDI5MTI0 +NjAwWhcNMjUwNDI5MTI0NjAwWjAAMIIBIjANBgkqhkiG9w0BAQEFAAOCAQ8AMIIB +CgKCAQEAsDlKPvdkaOLaSQ9KaSy6sDn6eLPAGDQz6yihfsEVUN4wIwT4KnMxOODv +BdEx/iag9VgbRW1nAWLibLJ+MO4lPKBp4mfnILzZJVMdDJS/NL5qar0eojcpZt5d +IMPiNm1aY/bnIE3H/+mWy10E1vGaNFRyHEZo9+Y9b/smHbMc6HeDTma+uYnE5JAR +0lLTWB4Owk8i+4gdqExOfzZCThzTyqDOnXclEySiWUSuLEX/DKiyutZ1VO4dXyR3 +Zuig5ZD7NKQcx9GekIM5bQ3ms7qrSZ+yf86NzlM+jrVdGu0V5TSm+8TXjvRDrw1f +rBpm6l6pApKr2dogCkUlVj0051ncsQIDAQABo4GdMIGaMA4GA1UdDwEB/wQEAwIF +oDAdBgNVHSUEFjAUBggrBgEFBQcDAQYIKwYBBQUHAwIwDAYDVR0TAQH/BAIwADAd +BgNVHQ4EFgQUgpwh2XebMZ8EUmWOXPbiV5jj/gUwHwYDVR0jBBgwFoAUQ+YOUL0Z +8jFe38GPndOtL3381dowGwYDVR0RAQH/BBEwD4IHcmVkaXMtMYcErBQAHzANBgkq +hkiG9w0BAQsFAAOCAQEAjyD3Uqajjrr2R1r5rJPL2LIMN51BVy/NqrONNdPgUFvf +xELDlAqJDYsXVZwimUVN/SfqwOuN93Q6VQjrIQosnpQKpKApDQ95frq9nmzhIFTG +XOUpgUv96KWfsQmS4TVu38fVdE/J2FAcEOtqgMyxpX/oTDbU4XD1WDVHT4EAWQDh +/MuoQRBqmVP1viZLRNVIrld5SR4WBtNCwAyR40jxpH5hRH6QzasjkHAV01/Gc+pD +E9WJXRemXRkrNlWKktPAz3qzpnbI1Pupd2GrYrp/mmyY07XERaQ+VfJvnxj8TN3L +f9fxNAbyGAGIgOhQgyALgHQxGgz9i2j4mr+FVvp/rw== +-----END CERTIFICATE----- diff --git a/deploy/dockerephemeral/docker/redis-node-1-key.pem b/deploy/dockerephemeral/docker/redis-node-1-key.pem new file mode 100644 index 00000000000..b90430b476b --- /dev/null +++ b/deploy/dockerephemeral/docker/redis-node-1-key.pem @@ -0,0 +1,27 @@ +-----BEGIN RSA PRIVATE KEY----- +MIIEowIBAAKCAQEAsDlKPvdkaOLaSQ9KaSy6sDn6eLPAGDQz6yihfsEVUN4wIwT4 +KnMxOODvBdEx/iag9VgbRW1nAWLibLJ+MO4lPKBp4mfnILzZJVMdDJS/NL5qar0e +ojcpZt5dIMPiNm1aY/bnIE3H/+mWy10E1vGaNFRyHEZo9+Y9b/smHbMc6HeDTma+ +uYnE5JAR0lLTWB4Owk8i+4gdqExOfzZCThzTyqDOnXclEySiWUSuLEX/DKiyutZ1 +VO4dXyR3Zuig5ZD7NKQcx9GekIM5bQ3ms7qrSZ+yf86NzlM+jrVdGu0V5TSm+8TX +jvRDrw1frBpm6l6pApKr2dogCkUlVj0051ncsQIDAQABAoIBACixAejqPUBO6bKn +GjqQ/obEzIZkkz3DiB2L40aelSp4M8tSUW+T69DDd83zEUUrbE1ay+lLKtbSG5CX +4rWvt9949xo1fdQ8ZzPMLlACZOhr86y0AMfaTvAW9pAjSy/gLlgY4iO+cikwqgZJ +c12iqkXdHgBTbdeYTaV268U937X5yFcuf70ySLBAFJc2AYp8IVnpQtt3zZC214Ag +9ot3hPppn7l8BS5DWncbSwtAfSd+1Tujj1a7qESO4zlFWp3F404lvsnezHolgL1p ++blY1u8GmNkFAYCRMTwaqfNcMNr3BE2KqqMDa2ByGEqvPgtu+4GVnJjuLt32UGuG +wLXHNkECgYEA6Ezr7uuUUKTCI3Q+KV036BzLg+69pL0NEo1cnwUZFoX6tMAwxK0p +u3R7k1bvOysQlcYjekCtmUOCTNvaqaVK0eNiffJQ5OdxfX/DW+KqRPw7Vmg9Rgru +DojbL8Xe7kPUN/hWGOhkVZEIU2+Gt5fjMr1lvMezOmP0Smh7k7dKvOkCgYEAwjPK +6dyBuqW7NQGwTTNjrOnY3koATPXudBMiYpJY6EErtOMMPVeb2gvRAJpxZuykGD66 +4Zj/SQxWkbtxgWP1r/2NQYcz2Zmblwh20+h77yS/y+ac9f7LfG4yLTr3puimF4t1 +x2+Qr07VUDp8sx30nsarr/q+NAWsC+e7Kdk6JIkCgYBi/TxgsGSgRMUxxHwktkN3 +lqWmz9piU+k5KaH5ZXu+XFNsKKXfeYbaCZYLQDVrejt0B13g36TaNalVxS4VsokC +janPz61nDbUP7Jy8EAfMo8tJU9wgd9HfwbPdVK1dzOum+hz+OjFfQRFSNKksnP3F +Bm5PFq4qSKO1/XYDiUzA2QKBgHKwg7V5NGQ2XEkBpkzxfHwx3pHowiSxWRHT+wqb +w0XmtxksvZ28j55GPDhO/Yn7Vy26XkO9R4ascrO+L1pq3j4BT9rTLhvkS672oLal +Jgwld9/DYg8lWqcxrRBpMrivzOc6xWPyz0+5DuFCqUJe/oiGa/6R5qJydxjQ0gf0 +8hGBAoGBAOKZuY994jVHkm+yqgtyJkQQRoSoW8dSfrr087YqDv4ibxlmyyEGvm+e +06TQiq9I8mr+kijNHeHGZbE/JzQEdve5QH6LODMjnqR6r9Z2TY7GqGYssZFdCohG +EE9zSR2j4CFkdSc+/VF1oYamsz9KpwmHyYTFdYEj+6fmUU1FHccd +-----END RSA PRIVATE KEY----- diff --git a/deploy/dockerephemeral/docker/redis-node-1.conf b/deploy/dockerephemeral/docker/redis-node-1.conf index 011df166cda..f30468e3e11 100644 --- a/deploy/dockerephemeral/docker/redis-node-1.conf +++ b/deploy/dockerephemeral/docker/redis-node-1.conf @@ -1,7 +1,16 @@ -port 6373 +port 0 +tls-port 6373 +tls-cert-file /usr/local/etc/redis/cert.pem +tls-key-file /usr/local/etc/redis/key.pem +tls-ca-cert-file /usr/local/etc/redis/ca.pem +tls-auth-clients no +tls-cluster yes + cluster-enabled yes cluster-config-file nodes.conf cluster-node-timeout 5000 + appendonly yes + requirepass very-secure-redis-cluster-password masterauth very-secure-redis-cluster-password \ No newline at end of file diff --git a/deploy/dockerephemeral/docker/redis-node-2-cert.pem b/deploy/dockerephemeral/docker/redis-node-2-cert.pem new file mode 100644 index 00000000000..197c0fe13f4 --- /dev/null +++ b/deploy/dockerephemeral/docker/redis-node-2-cert.pem @@ -0,0 +1,20 @@ +-----BEGIN CERTIFICATE----- +MIIDSzCCAjOgAwIBAgIUTfzZA/HviaUtA/woHZJ/zXlvNHUwDQYJKoZIhvcNAQEL +BQAwHzEdMBsGA1UEAxMUcmVkaXMuY2EuZXhhbXBsZS5jb20wHhcNMjQwNDI5MTI0 +NjAwWhcNMjUwNDI5MTI0NjAwWjAAMIIBIjANBgkqhkiG9w0BAQEFAAOCAQ8AMIIB +CgKCAQEAtIF3npW2eNVRJpkyHkj9WjfZu4Lzjwkbx58LUIdQEV+F2Qm6bZkHLjEi +yqofA8vtuqixbmNuAeTrbpA8ChtGetmUhz8+iyWGNe6LwS15opb3FGA9Kj5Lwp4z +GtVdrbE+NauBRElILXXyirt9NsJTM6RWY8tZrhrjz4m20yGRRsVvVbi2tBsGDRDe +6TL+6acxtVi1DBCYXB5IaffM2Bjvu04ZWpDrRtfuiuyRmcO5E0D8UOAem83ujmtI +vl5dWfqSsfDl1YW708l4cfWq2ZSONmflKGU0+Nw4fVuiMfnKFN6y20ZfAMSdSs4+ +uKv1UoEwESgfjw783PfSBAso7aQNSwIDAQABo4GdMIGaMA4GA1UdDwEB/wQEAwIF +oDAdBgNVHSUEFjAUBggrBgEFBQcDAQYIKwYBBQUHAwIwDAYDVR0TAQH/BAIwADAd +BgNVHQ4EFgQURKDvYGOeSDaI9TkmN12XKCr62EswHwYDVR0jBBgwFoAUQ+YOUL0Z +8jFe38GPndOtL3381dowGwYDVR0RAQH/BBEwD4IHcmVkaXMtMocErBQAIDANBgkq +hkiG9w0BAQsFAAOCAQEAm2hcglMpoiTcDXkNo2rh8OknE8Fb4o79xmzKEABVCmOm +aAiniZAKBUz+vW6mT4GTGegyLHh0g82PZMYSk/UOtRitKkrpiBBNZBnUGtpUgN+C +Yalx6RCc6nbhSbzi5jk+DIG/6CswpzkXG4Hrw0zEFQWNBIL4sI7K6cjXKmKL7jfV +fo4DcjszkmFcgXxjz7UTCZKMF0pZ3qKnCvO8pq3wQ80pgnK9o4E8cOmRZpybMObL +JwApaUoxNik3yFzfeiVSEm9K3fFyJ/6jrvqPPIWUKPOTdcQdUTv+1jcnwZ3GFzya +WfgPqF32QQCapRCUCyzXgU98N+LsUOFCM7Mt+td5Xw== +-----END CERTIFICATE----- diff --git a/deploy/dockerephemeral/docker/redis-node-2-key.pem b/deploy/dockerephemeral/docker/redis-node-2-key.pem new file mode 100644 index 00000000000..b85a0f9c29e --- /dev/null +++ b/deploy/dockerephemeral/docker/redis-node-2-key.pem @@ -0,0 +1,27 @@ +-----BEGIN RSA PRIVATE KEY----- +MIIEpAIBAAKCAQEAtIF3npW2eNVRJpkyHkj9WjfZu4Lzjwkbx58LUIdQEV+F2Qm6 +bZkHLjEiyqofA8vtuqixbmNuAeTrbpA8ChtGetmUhz8+iyWGNe6LwS15opb3FGA9 +Kj5Lwp4zGtVdrbE+NauBRElILXXyirt9NsJTM6RWY8tZrhrjz4m20yGRRsVvVbi2 +tBsGDRDe6TL+6acxtVi1DBCYXB5IaffM2Bjvu04ZWpDrRtfuiuyRmcO5E0D8UOAe +m83ujmtIvl5dWfqSsfDl1YW708l4cfWq2ZSONmflKGU0+Nw4fVuiMfnKFN6y20Zf +AMSdSs4+uKv1UoEwESgfjw783PfSBAso7aQNSwIDAQABAoIBAQCrVu22EgS4ZDx4 +uBhz2PLsrXE3ZdFN5+Z/sT+rPBZLt3G1GF/nYsgHF8sftyZjkzLg6Porf6RPlf3I +4I6tRUC8okYzr1vt9zuTfBEa2NDJ/iUhKU1GCQYfAc4e3YPjuQgFJ/w3Vpx10qzc +9aWg0grqTUdXyRIiixHN0bpCZW2iT3UJV43aK2Y19Sv/IMw4ANFn2Kn14m7iHLTT +Oh7gVHxPQWgnw1xItfpmKEnqWeyI4IqzMU/FlxrNaUGBiq4/+It/zZAtczRIwa3X +bjis//xHbzU9e/8dPFaEASiorIcfXqv5alO9O7pkDO+9iQYHIpIkX1u3NRDm5/S0 +6j92f8VZAoGBANYVGs1WtRjfCBCSAfme3KvlCgAbhzKiM9333CdCfhYMdBxbWaG3 +sfC/xmCmnCDtF8d9zbhiTxJ/MrsRLJajmH6Bps+PZZPUQEctPR9W+cMWqjgUjfSY +rwb9V9liKx/UIXQehwkbE8JJDCeMF00BSJ0aM0fnH9jTaHrFqyrF8QAVAoGBANfZ +U/g2phWaAJWIn6a1yxjezgwPNJOe0J9K+zTif9CxRK4qjgGDyAAr6yBCnW2k9xbs +wjcvQe3OV097GIBznZDQmF+3llUXn0FnTe7dne+wh+RsbldakeA6dSNM+jM+LSSh +X0MqtVjAKDR43lZNLWzK7R87lkTyRuUeUnogFM/fAoGAUFT7CbJPolWOoSkotJJ4 +G8iGSCQMR2O2MsSfR9wblAp4R2u/5n8Xtk9AEWRzkadmFOWQHHBHW5l/X9LB+ITK +5C2ieqBEbYRn2k2PcgMhFaObnA+adP4WL3lBTcEYjYj8RKZv5WrTr0PZ270lwS+K +H+mE9KY1vRcXTXp/ED3WgUECgYEAqe1UJ9KOCe+FijNWzJ3N2DR/rgrCb3zV7LHQ +9h9iVF9aHGswBI1EhK4OmwUWft0iERAvDdbMZnTNU6sq7OUYJIuziZc0aKUCITE8 +r1IVJj+pm/CpJWgN86LR2Qqe5nyKeY35Ox2CSu5sOHL3RqXXnxBagP4eHQVHPtUS +RUbAW60CgYA9lLqeekzDjM5zZSSOWpnlh39ObsQ0dHA6d/OlEqZnI/vcUH0HSh2K +qKtalL7vv3nwt4cB51Bhyl1BXOtPKRnUEGIWaM4c/qxXE0R8PqfQa003gPALgwaZ +74bNvJTut/AnKuoWugWWwLdPWgr3Xi2D5cDIea+wX7IsIluRMgMHmw== +-----END RSA PRIVATE KEY----- diff --git a/deploy/dockerephemeral/docker/redis-node-2.conf b/deploy/dockerephemeral/docker/redis-node-2.conf index fa2850e9234..f95904911fe 100644 --- a/deploy/dockerephemeral/docker/redis-node-2.conf +++ b/deploy/dockerephemeral/docker/redis-node-2.conf @@ -1,7 +1,16 @@ -port 6374 +port 0 +tls-port 6374 +tls-cert-file /usr/local/etc/redis/cert.pem +tls-key-file /usr/local/etc/redis/key.pem +tls-ca-cert-file /usr/local/etc/redis/ca.pem +tls-auth-clients no +tls-cluster yes + cluster-enabled yes cluster-config-file nodes.conf cluster-node-timeout 5000 + appendonly yes + requirepass very-secure-redis-cluster-password masterauth very-secure-redis-cluster-password \ No newline at end of file diff --git a/deploy/dockerephemeral/docker/redis-node-3-cert.pem b/deploy/dockerephemeral/docker/redis-node-3-cert.pem new file mode 100644 index 00000000000..e883bdb2c3d --- /dev/null +++ b/deploy/dockerephemeral/docker/redis-node-3-cert.pem @@ -0,0 +1,20 @@ +-----BEGIN CERTIFICATE----- +MIIDSzCCAjOgAwIBAgIUTorva53MIkurIdKFSyZmJR/8UKMwDQYJKoZIhvcNAQEL +BQAwHzEdMBsGA1UEAxMUcmVkaXMuY2EuZXhhbXBsZS5jb20wHhcNMjQwNDI5MTI0 +NjAwWhcNMjUwNDI5MTI0NjAwWjAAMIIBIjANBgkqhkiG9w0BAQEFAAOCAQ8AMIIB +CgKCAQEA00nlA/2dwqnzW+fvLfeje12cbB6gFf3w9+UU4R6uXmXYguVK0QquIcqd +e2vvsR3So4nryGQucZYzDVqhFx11Q+nXFj3ucMmffXy1fLPxsExlct234sKvZJ5k +WlI9nd3ApJ65KfRQVyk6hI+Z30+0NJS6YeDNSAy5uP7Ir3r3l++uFxsfmeTN7Gjy +HtCVdXrGACXxnm5A9mYApnIaArSdBjpY0PTusPhMj/2OnCjnY06Q4xm3jaPpO6ku +f8m+W3CQlZg7/JYLBafHyS0OxNWNxNY839pSV3C5PVlcl8dKPjZvYmBotDig8LmI +GNfKzyP5PHd4+q4YrCY7gtTslah25QIDAQABo4GdMIGaMA4GA1UdDwEB/wQEAwIF +oDAdBgNVHSUEFjAUBggrBgEFBQcDAQYIKwYBBQUHAwIwDAYDVR0TAQH/BAIwADAd +BgNVHQ4EFgQUenIQo9JRyLCNWRFssHJoc16LtEYwHwYDVR0jBBgwFoAUQ+YOUL0Z +8jFe38GPndOtL3381dowGwYDVR0RAQH/BBEwD4IHcmVkaXMtM4cErBQAITANBgkq +hkiG9w0BAQsFAAOCAQEAGici445nGuUKcjXtknyYbDD5bMA8+69SO27AaH/xvR5G +nLJe1b0lhVvZk6n8ZELvpSTPe5Uk2DmoME3FioA80tNURz5f+xtnVnyjoJE30/vs +Gdh6yym/GO0zlZc769toW/NVFMQqjyrFJuvzWyvYDXW1Fc2M41bnOIe5t7GAxGl8 +XX3TO7l6S50JoYRtC/xZQe2EOj6h37lyA3Ks3p5uHSwPTFZzOsLGzPApTInifZ9w +LUDABGLjghAUz80+YiV91TBYf9knTIwW+1SUltRnjnrLKLeXmWE2nKKsPmxgr9Xt +GuxsycvyGDhwv4jlEvLVpzUPQC4CB0ksxW42nX2sGg== +-----END CERTIFICATE----- diff --git a/deploy/dockerephemeral/docker/redis-node-3-key.pem b/deploy/dockerephemeral/docker/redis-node-3-key.pem new file mode 100644 index 00000000000..7b111f5e89a --- /dev/null +++ b/deploy/dockerephemeral/docker/redis-node-3-key.pem @@ -0,0 +1,27 @@ +-----BEGIN RSA PRIVATE KEY----- +MIIEpAIBAAKCAQEA00nlA/2dwqnzW+fvLfeje12cbB6gFf3w9+UU4R6uXmXYguVK +0QquIcqde2vvsR3So4nryGQucZYzDVqhFx11Q+nXFj3ucMmffXy1fLPxsExlct23 +4sKvZJ5kWlI9nd3ApJ65KfRQVyk6hI+Z30+0NJS6YeDNSAy5uP7Ir3r3l++uFxsf +meTN7GjyHtCVdXrGACXxnm5A9mYApnIaArSdBjpY0PTusPhMj/2OnCjnY06Q4xm3 +jaPpO6kuf8m+W3CQlZg7/JYLBafHyS0OxNWNxNY839pSV3C5PVlcl8dKPjZvYmBo +tDig8LmIGNfKzyP5PHd4+q4YrCY7gtTslah25QIDAQABAoIBAQCZpO2VplKXYRCn +r5Q9IAxQxHTgJrEQ7PXSvlIdljsESBlWrjhmpNaVmgpE2uuVJ3OqGrxLn5YqYSfE +uTfVYEWK2jvfX6/JcsS48vvir9O7+QH4soRqsFns2EVvbMiDyOKykv1hJdlaWI/G +H8qsGgCYD+MtE9UTZLWVcikrekcbwwvIXqNNskHcViYXOabYEvgyQ5KvqLi6AYtY +NQl8UgPY5VGWCzJqBmuH13wS3/bPxF3jIEWQbErD7coRr992F5KTQMQ9k5w8PXQo +ZLmXaceQV0KqWdlXRfB43W1OyH7mLp+zrJLitjRYIozkwTeFc+FN9PYlJqIeBejI +6C8l3eOtAoGBAO27YamdcG9lkXIwvZPRQM1/hHTy7/1d5xB0hpSWmDDg7iA3kSZg +gooEqr1TQV/jDicoPcEe4iNJwc5pKBxF5qZqyrup77nETuvZc0Zd5J2YfQFJtIG8 +RkJV1/97HFy3Sns1mqfHOqjzcqq9pGdfHq/ElZoDtAWqcYIItpygCP2bAoGBAOOG +U0bEVq1AXsM/EKXZ3pMoio4uMhir94VN8/TYkDbdNViBV31Ri8UvitARn7Sq93Co +I0+71iRK6QOD2BdAk6ZqJksJ9zuMiAarVWgu4qInW/NoqECqNeb4XMEou863cm4W +/nnYe3vmnTWjiSQctsD2imcYIH3IO9nkFiLj9eV/AoGAOIe2UX7+nX6pd13ftqar +ojIQbT7XkoghyefrmKm2xui1tzN/cIDCic9SSnLhuMtlMip/hMyzOXDwhQS8ZPy6 +PBho3Pcr6iCkI7ExmCn7kv4Pu56rLa53ho6jLj04IVP0ghfdDshxSnuZaMBvt6UG +xwUYDeeTh0VgeGtaASSM/sECgYEAy1ns6BznEyWrDHo7GOBmq8PaQkVLhP191mjb +l4RPMJn46ceAOIM/ltdtC5YU1VbQnKHKHaNWO02wgPG/mtienmfVHdAkZdauZLeR +N/JfoGnpJt3tMw5t6qcjz4fmg1U2MureOmyfwRdWfvBQzDPVqxUukgHgWEs0IwRW +PIzd42UCgYAgbp1uGhGUMGodtl+donLLZwQtS190UOQ/WLY4RiIZLW76PAvWFOo0 +qy7pbYbewGiLOjKTO4UWndHOaCE6zQr7qIcBdlCGSO56azCYaOb3xe/jbn6EDq2R +mutZBgUms0OXPHfa2tB1ndrvedLI8fRWazWrol6OTD78hH5bb6MD2A== +-----END RSA PRIVATE KEY----- diff --git a/deploy/dockerephemeral/docker/redis-node-3.conf b/deploy/dockerephemeral/docker/redis-node-3.conf index 81d01b5421f..4a190e10f96 100644 --- a/deploy/dockerephemeral/docker/redis-node-3.conf +++ b/deploy/dockerephemeral/docker/redis-node-3.conf @@ -1,7 +1,16 @@ -port 6375 +port 0 +tls-port 6375 +tls-cert-file /usr/local/etc/redis/cert.pem +tls-key-file /usr/local/etc/redis/key.pem +tls-ca-cert-file /usr/local/etc/redis/ca.pem +tls-auth-clients no +tls-cluster yes + cluster-enabled yes cluster-config-file nodes.conf cluster-node-timeout 5000 + appendonly yes + requirepass very-secure-redis-cluster-password masterauth very-secure-redis-cluster-password diff --git a/deploy/dockerephemeral/docker/redis-node-4-cert.pem b/deploy/dockerephemeral/docker/redis-node-4-cert.pem new file mode 100644 index 00000000000..30a51cf51fc --- /dev/null +++ b/deploy/dockerephemeral/docker/redis-node-4-cert.pem @@ -0,0 +1,20 @@ +-----BEGIN CERTIFICATE----- +MIIDSzCCAjOgAwIBAgIUAkSg4x2WvodAayAK7Zt6uLHvUJcwDQYJKoZIhvcNAQEL +BQAwHzEdMBsGA1UEAxMUcmVkaXMuY2EuZXhhbXBsZS5jb20wHhcNMjQwNDI5MTI0 +NjAwWhcNMjUwNDI5MTI0NjAwWjAAMIIBIjANBgkqhkiG9w0BAQEFAAOCAQ8AMIIB +CgKCAQEAyzoes8dqU5BusBBM0u/If98TW+0ynKLHynX7DAhd7kTzc35EMNAKDcRv +Z9gaLftyyV901PkkFJ3eLh6lYzadSwTfkxXZdcc08rLWNzeFRDTBRu0XMOZds57S +ETcn0g2KEp2m0uSY7gaXyc0OE1/S3WQtfu1HDLQfp3/Ls0GUQtprWfP2OEHCa7sl +oPUKfwAhhhjbcphxs9P/Pdl55+H12GFKlj0N5ir879nqn5QTAPDt3kCkT9WHyJMi +TLhLFhI+NtimXblXYEghRnpKWLa7IdbDliElug0PmaKaPtlPUdmOcEtVudvKQWtr +6oOlVMQ04I/PpF1E0vIcSZQDC4XqnwIDAQABo4GdMIGaMA4GA1UdDwEB/wQEAwIF +oDAdBgNVHSUEFjAUBggrBgEFBQcDAQYIKwYBBQUHAwIwDAYDVR0TAQH/BAIwADAd +BgNVHQ4EFgQUklfbcU7/m4zAPaap6+bo4kOHX0wwHwYDVR0jBBgwFoAUQ+YOUL0Z +8jFe38GPndOtL3381dowGwYDVR0RAQH/BBEwD4IHcmVkaXMtNIcErBQAIjANBgkq +hkiG9w0BAQsFAAOCAQEATdOKVE/9GqS1UrbmMys6aFS6DQLdpOcEKJYwqSgRjOBO +rVS7fMW6WIK9XKKuiKsd7jL1myMa1qdLocICwsikOW5YZUXKEymQtp7+Ex/2q5mO +cgOgA5z/L699e4U8FI564OLJdgs81ZTn8qbdFHXG1WPWm2Bki/eZ+6tDH2dEgK3E +5UC4CyfpG4De4XBgI+8FgYRkeip4i1REyzMJ/h2tvXo5vfI1ER/hPB120uJJPzNq +VhhvrJXHOsoldNoquXeQ/c/cdVnnthtABrT+X2YzeFj8vUZIU1VEJubobvLCpm+q +ZdSzH+NN3iWVTAXG0sSzJxg3iGr/ICY+ySR8z+87uQ== +-----END CERTIFICATE----- diff --git a/deploy/dockerephemeral/docker/redis-node-4-key.pem b/deploy/dockerephemeral/docker/redis-node-4-key.pem new file mode 100644 index 00000000000..88d64e27c4a --- /dev/null +++ b/deploy/dockerephemeral/docker/redis-node-4-key.pem @@ -0,0 +1,27 @@ +-----BEGIN RSA PRIVATE KEY----- +MIIEogIBAAKCAQEAyzoes8dqU5BusBBM0u/If98TW+0ynKLHynX7DAhd7kTzc35E +MNAKDcRvZ9gaLftyyV901PkkFJ3eLh6lYzadSwTfkxXZdcc08rLWNzeFRDTBRu0X +MOZds57SETcn0g2KEp2m0uSY7gaXyc0OE1/S3WQtfu1HDLQfp3/Ls0GUQtprWfP2 +OEHCa7sloPUKfwAhhhjbcphxs9P/Pdl55+H12GFKlj0N5ir879nqn5QTAPDt3kCk +T9WHyJMiTLhLFhI+NtimXblXYEghRnpKWLa7IdbDliElug0PmaKaPtlPUdmOcEtV +udvKQWtr6oOlVMQ04I/PpF1E0vIcSZQDC4XqnwIDAQABAoIBAG81m813Z5jY5alV +EiUv8AEBep+IWnTaowgIrdt0zKnxc2OVCg3IGmhUQT6LRDA7dCH8KXvN5k+d4BJO +1ORI46REw2/CuiA4ZaIV+SF4MWYUlFuSrGkm9smvNHcVPqY0oIT1Xm/zhjhixTc6 +DeTOQB7EjhzyDTpHazcGuNqcHVzDHeJSJHOaAfQ46eKvy2X29mczk4f63mclWYTS +nXuloohabZRkC7TmyfIbfQDJ0PieK4w05jc4JI256cxlgmLPacecE8DHUyXp34zd +YxQnZ3ysAYgUNX3N1+Bgvb50tLQTcmDK0u4Y1vJ+DMqsk3TNCeQrjt5z0ZC8bako +gOQX8oECgYEA6Ki2Ka5rsIvnQpR4qVwLe7TCxJ/+bKculkKSpyS6rdy0tn8/TfTR +9sxn5O4N/mUlmjpwGqbbpZtN7nUosbIXb0WOR2wX9WtZgcnxbNs2EUF57trzJUdQ +jeMs5h0jK3o2zghsJm4dS9RPrvORdv1fRzFwJ8U6OOQrL9rwBOz9s0ECgYEA352E +peLwpheDqouHLdXhkIJAYF1GKeWmyHRrXKhc1qCaspQkY3lSPI+5CkgJHMdfVnMf +CMq6/zWKTe4jGVPc6Lf8RooEjFBHziiLzntSbKTMHYFauA8P7UcgdvDjvPlkPt91 +OeWTW1/5VGI7T82M9HiZKcfyZi2Qu+xk+cDmhd8CgYArAyXKRui51uOGN5SnGtE0 +qZJob3vF8pJ2TRB3vh6VDfyK0LOPYfd/PQLoG+qSYXi2Lp+TDc4Fq9SYhShk0Zvr +glxvb9huEs6VZBQyH8S7I/O66NeSyMBnutwOHszluM5xALWd1TWtUy74FSeLbAQ1 +UTp+38OHyQcC7eL5xiaRAQKBgFwa03JIgXrIILF0ex+EAz60h7Opd6b2MrZKTZaC +uoqk6FM59asLY7YSNNNpTGeQL1K6ZEQIzPElqmvi9I4QHuO0NLMRUkJBJvJhfQR1 +g0PAtVpJ14YMnjDLpTGYkxVZW9MR04UfbIysgVQiie+a6L4hlmTBOLShfAYLnqPI +sqrdAoGAV1phwzzbtCrI6BupI+jsIIc+TgXg1yk+KYtUL9N3xU1mjjKFxOwS9QSK +79+33lXMUCgXchLxYD89BF9gprdvRm3w03T0npj1ZPvixNKWtkrFjCJJ4pdkq8Y5 +qROO3h8GI0rkHMe3ODPUIiJRe+7rPb5jjlzcA2jXR2RI4lXl6T4= +-----END RSA PRIVATE KEY----- diff --git a/deploy/dockerephemeral/docker/redis-node-4.conf b/deploy/dockerephemeral/docker/redis-node-4.conf index 50361d22810..d3c0c57d4ac 100644 --- a/deploy/dockerephemeral/docker/redis-node-4.conf +++ b/deploy/dockerephemeral/docker/redis-node-4.conf @@ -1,7 +1,16 @@ -port 6376 +port 0 +tls-port 6376 +tls-cert-file /usr/local/etc/redis/cert.pem +tls-key-file /usr/local/etc/redis/key.pem +tls-ca-cert-file /usr/local/etc/redis/ca.pem +tls-auth-clients no +tls-cluster yes + cluster-enabled yes cluster-config-file nodes.conf cluster-node-timeout 5000 + appendonly yes + requirepass very-secure-redis-cluster-password masterauth very-secure-redis-cluster-password diff --git a/deploy/dockerephemeral/docker/redis-node-5-cert.pem b/deploy/dockerephemeral/docker/redis-node-5-cert.pem new file mode 100644 index 00000000000..5196275ab92 --- /dev/null +++ b/deploy/dockerephemeral/docker/redis-node-5-cert.pem @@ -0,0 +1,20 @@ +-----BEGIN CERTIFICATE----- +MIIDSzCCAjOgAwIBAgIUNSrcSVi4+37eJ5x864GYsVzmIpkwDQYJKoZIhvcNAQEL +BQAwHzEdMBsGA1UEAxMUcmVkaXMuY2EuZXhhbXBsZS5jb20wHhcNMjQwNDI5MTI0 +NjAwWhcNMjUwNDI5MTI0NjAwWjAAMIIBIjANBgkqhkiG9w0BAQEFAAOCAQ8AMIIB +CgKCAQEAog895utST5jUQP2og9DIfTXIkwm0wy8QgMTTzoZfD447BMvnKCO0JIP7 +q/03I+WTKsX+b8uGxqdgoqD+3xYpA7doSjDjaQWtRpHpwyXDL/LGySB1u5OdvMln +EDv3aVNwx23FnZqhE38jAbMt+1yC2S5Y/erMAnBrMhCSHQeRUPcPwsMoMo5Kufns +0wo+1XZcj4mKI6adygFSYDD4vLXv82usl/w4/VEB+rJUr+Zy+ZxqQlCqSa4K/qnQ +KZXuYMF4+GaUnFhu1QCU6ePQYeDEPPdBWnJBu62hYa7i2e01wOp66dGzMp9aOBOJ +VdwRrDDC2/a0HP1i7jJ+Nwjfps4QLQIDAQABo4GdMIGaMA4GA1UdDwEB/wQEAwIF +oDAdBgNVHSUEFjAUBggrBgEFBQcDAQYIKwYBBQUHAwIwDAYDVR0TAQH/BAIwADAd +BgNVHQ4EFgQUqZm4VY5DqFEAT7QW05oRkEPUVy4wHwYDVR0jBBgwFoAUQ+YOUL0Z +8jFe38GPndOtL3381dowGwYDVR0RAQH/BBEwD4IHcmVkaXMtNYcErBQAIzANBgkq +hkiG9w0BAQsFAAOCAQEA4PD/ogU9UACl/iHCEsNf+YRHlkOmu5nGh2pWiMKCS4DF +B62EdjFLCVs95W+mfAG3s3z1JmkHy8/vSpqQ+LNZqWFwlSmvzeD/krTUa4ZrknHK +Uq3NBzY1HkW9HKZv7Tp/3S8kt6/rM1rcQRJe8TcfzmuyKafIzV9WAmx87pvckH7Y +jPkoCLFl9Sn4zQX5YWPxWrSHtmjopUWyE+OXdPd+9duAeWWFYgKqiFAhXaUSTfX2 +8G/bPk/szSoxIvFArbVuUHBoiNuGbVagTfQG1dXHMfWyupZLlMybenQ4g5uixSiY +XajQHvllsdcjcJ0U9dUey3o+Rkngz+z4mwux+iXjJw== +-----END CERTIFICATE----- diff --git a/deploy/dockerephemeral/docker/redis-node-5-key.pem b/deploy/dockerephemeral/docker/redis-node-5-key.pem new file mode 100644 index 00000000000..337d6e60584 --- /dev/null +++ b/deploy/dockerephemeral/docker/redis-node-5-key.pem @@ -0,0 +1,27 @@ +-----BEGIN RSA PRIVATE KEY----- +MIIEpAIBAAKCAQEAog895utST5jUQP2og9DIfTXIkwm0wy8QgMTTzoZfD447BMvn +KCO0JIP7q/03I+WTKsX+b8uGxqdgoqD+3xYpA7doSjDjaQWtRpHpwyXDL/LGySB1 +u5OdvMlnEDv3aVNwx23FnZqhE38jAbMt+1yC2S5Y/erMAnBrMhCSHQeRUPcPwsMo +Mo5Kufns0wo+1XZcj4mKI6adygFSYDD4vLXv82usl/w4/VEB+rJUr+Zy+ZxqQlCq +Sa4K/qnQKZXuYMF4+GaUnFhu1QCU6ePQYeDEPPdBWnJBu62hYa7i2e01wOp66dGz +Mp9aOBOJVdwRrDDC2/a0HP1i7jJ+Nwjfps4QLQIDAQABAoIBABosC/s3Fdv0+pJk +ZMqk9TwDa5kTgDXla+zf3LUFzmRcu/tSUsqQuY8MIaDtC/KoKNRHlYfIfsOmVFzv +UzoEAiuvexBARPm5CPrUpcP2XUdpFeF1dI4OkPLkM9jTVmmUKCqM99U0G79iUOz9 +Wve1QQyCB606NihOr4EuW+qERlukyPkDkhMcq2/ZmHHZRWOgVFKxMCG7xGB8HeKx +QnayjU2pAUeqoiTdG8TME2Ir2WjxCnAni42aK2R/4DTQxEVyLyLC6VDusXa4rSom +/zop33zLnFicL62331aJk0+2urYRYSoFVezNHWYviSIj36PPZ7nl3IlRtllSXlEY +hOh8SgECgYEA02lB6CVGBuoKfLfGrxiZT1Wl8fL2AaJ6lXK2iQrOrKC2Hzb9lYvz ++DLjabD2s4nXja7pkekGgo+orU2jJiTphKzt0RelOO9476GWGkfawVzD/UBPPqjZ +qW+BqGGZgNgZy/aTVgqKx2ZcTqOzksshdEAV0VFh1GTaW35fuqVFT90CgYEAxD1W +aX4feLjJgT6iAfpCD0gTIIlpcqSD3/rZtPgFvTkDwHJQo3R6PckqoeU4OTm5K36m +eTJFBH/ChZ+/F2sYR2FJpQvDNoolcoRhm8H0XOKkDHcyfCiCxRgUm/Zwer5W/Z9N +Ejh0TXds8SAja+x/1puMwF9KS4Mii4Org8vn5JECgYEAmRngDeN4bCdvwtRAQauZ +0zdefvKJr7Nf/PzfLi2ycJfObJqhWHzLCNKpmG/8qRbJEKU8J1vPSBwLdr4Dyerv +ZhLqAwORtsLOHRQzJQMma+PnV28MNH+JacgD6NINnZ5iSDBgkO3/hNofPSAWOtd6 +ebqzUiwSogMLkzjY0M1Bfc0CgYEAmB8ARGirltaQBet6hNPtr5DsmtVKc79KJy96 +4kk9kbCH0wAKuJrLQ+gUb0mUKvAvNaNJAzxPuiwbq5/o7wtq17J390RGAJpYawxp +6ecROYvLJYqlDRAORyDioQAJs2ynXJXHle9DYOXKAqUqMDg15TPRiTKVEjJGbiYU +p+dCDLECgYBpMUhl4/eTnHqpcbmSRo8GGp3nmO8910MvGaqyYdiDGTfnXUTk2X8T +0SjPiSGv5kc3SWnkBJV+ZMEtuELHwFxaOuYJxcFBKcCiKmaVTs4s7vTUXLGnNuD8 +++lQ8Iqol87XVCaz6YwPHjU0Fe+PP9TKpN5ztcR7x1HChfW8MEQNZg== +-----END RSA PRIVATE KEY----- diff --git a/deploy/dockerephemeral/docker/redis-node-5.conf b/deploy/dockerephemeral/docker/redis-node-5.conf index 68885b25b43..95ed92e53fd 100644 --- a/deploy/dockerephemeral/docker/redis-node-5.conf +++ b/deploy/dockerephemeral/docker/redis-node-5.conf @@ -1,7 +1,16 @@ -port 6377 +port 0 +tls-port 6377 +tls-cert-file /usr/local/etc/redis/cert.pem +tls-key-file /usr/local/etc/redis/key.pem +tls-ca-cert-file /usr/local/etc/redis/ca.pem +tls-auth-clients no +tls-cluster yes + cluster-enabled yes cluster-config-file nodes.conf cluster-node-timeout 5000 + appendonly yes + requirepass very-secure-redis-cluster-password masterauth very-secure-redis-cluster-password diff --git a/deploy/dockerephemeral/docker/redis-node-6-cert.pem b/deploy/dockerephemeral/docker/redis-node-6-cert.pem new file mode 100644 index 00000000000..66defdb9c21 --- /dev/null +++ b/deploy/dockerephemeral/docker/redis-node-6-cert.pem @@ -0,0 +1,20 @@ +-----BEGIN CERTIFICATE----- +MIIDSzCCAjOgAwIBAgIUY4v82n3xCyE0Li63Fti2N2Lv9zowDQYJKoZIhvcNAQEL +BQAwHzEdMBsGA1UEAxMUcmVkaXMuY2EuZXhhbXBsZS5jb20wHhcNMjQwNDI5MTI0 +NjAwWhcNMjUwNDI5MTI0NjAwWjAAMIIBIjANBgkqhkiG9w0BAQEFAAOCAQ8AMIIB +CgKCAQEArky8eJPNGRVXh8+lhWeN/4RKMPdW44fWVCvkWJDIkHMu1qH+3h8Qx9Ms +qbex+h9l71xT5bWe6PxY81v6LF3+FOXkO+FuIwYYSCAzUj6pfNMyQB9BIix96er8 +Sp6WzqC8jpUZFvcQ7dIfQqlliXogzbvRQQhHMeT2zzueAxwn+8S2+Y5axhYsATin +U+xBD3xZ2ParsdeWeMCkVfOfcewWca0K+oawAcVod4r+2rBmlipW8sYZS/6bvAVI +T4dVHFvPtiRqtyVR7oY8uOJ2R0Ko7ddOp+xUjgpzb9VgdV4unC/ysIAKZQl+Fd8G +64jFJXr11chRd3n4oGsuGv+4jFzkFQIDAQABo4GdMIGaMA4GA1UdDwEB/wQEAwIF +oDAdBgNVHSUEFjAUBggrBgEFBQcDAQYIKwYBBQUHAwIwDAYDVR0TAQH/BAIwADAd +BgNVHQ4EFgQUImh6q8TU3QsrteCJMNhCpl9rOFgwHwYDVR0jBBgwFoAUQ+YOUL0Z +8jFe38GPndOtL3381dowGwYDVR0RAQH/BBEwD4IHcmVkaXMtNocErBQAJDANBgkq +hkiG9w0BAQsFAAOCAQEAwRryg+yRLwa0pblMTSwd4MUcfucDOZ5liA0ZVtPqSwlB +SESq2NfyrqEAP+iafuAmIThb/i94ONOSfRIqpR05lcgdlobq2eq1DXrPjdtTPyeO +MjFYmOd5UqdUF3UNbO7PyL9BZ5eSlg18zBMuVWoPcP/0IMn6FojQZWdNaTEhcPnm +qdPrZLt5zc7Wn/f/hp226YJ4KpGLg6SkirzHkasGdEv6ZhXiJ3AGs9DZGcNOFyiw +RqrXbBx1T58qvzZ9Ha/ER00Jj+y4Kx7dOwbIh62QeHzyAIVlIhAkKAIG1hiONPdD +8lNSIx7CawFyf0u//a2SY2b7IRlDSyfmcLytuMs+DA== +-----END CERTIFICATE----- diff --git a/deploy/dockerephemeral/docker/redis-node-6-key.pem b/deploy/dockerephemeral/docker/redis-node-6-key.pem new file mode 100644 index 00000000000..44d74245715 --- /dev/null +++ b/deploy/dockerephemeral/docker/redis-node-6-key.pem @@ -0,0 +1,27 @@ +-----BEGIN RSA PRIVATE KEY----- +MIIEogIBAAKCAQEArky8eJPNGRVXh8+lhWeN/4RKMPdW44fWVCvkWJDIkHMu1qH+ +3h8Qx9Msqbex+h9l71xT5bWe6PxY81v6LF3+FOXkO+FuIwYYSCAzUj6pfNMyQB9B +Iix96er8Sp6WzqC8jpUZFvcQ7dIfQqlliXogzbvRQQhHMeT2zzueAxwn+8S2+Y5a +xhYsATinU+xBD3xZ2ParsdeWeMCkVfOfcewWca0K+oawAcVod4r+2rBmlipW8sYZ +S/6bvAVIT4dVHFvPtiRqtyVR7oY8uOJ2R0Ko7ddOp+xUjgpzb9VgdV4unC/ysIAK +ZQl+Fd8G64jFJXr11chRd3n4oGsuGv+4jFzkFQIDAQABAoIBACeZJWRbZ8ggEh+3 +rAoPybHYMybGuoW8sZOz2Q/J7NbsZCK88PMzqZNMRaRVKGkDwxvLJQBV78FMu0Sm +i8KSpAvJYr277FKmqtOQBTjVJZpHPO5Wa2zBIOYIzcKCHw7Yc54M/4M5JC5zg0iY +xYmjJlq3JcYZhFswgmX4TGC2f9rxqMZYxmccVqniSV4vpMU/u8KQcCa1QlW3lmUP +fvNUmqtnclbGDCVWNDuOw876Qh/JiEye63m4RuKN7uAecs8ZhmD2EtmguiTaPMrj +lWPyUSKswbRIgwnJm9fAJtuIlAu33MwZVGYzz/KPB7n94Qknuszxg1a571UDnvWm +SYskM+0CgYEA42TvDjRJ4oK087Oi7UKAfiSPp9PB0E0QrdE4HrKVRJZY59NPslSB +zNaSP5tuSkruOQX/SpW9QTE6TpB0KMj7HfI/W5gYKdOxUh4FBsrG2fdNpV16DjbO +Cco1gFMqFJyhpfwiMCURI3TAZ2LZxVSMMaBqGA6HsmIlmg1FZkAVLIcCgYEAxDnu +otVSqUt3dIz+o0XUwlasz189FCDSeB1u8DOGpzc6YqEYgez6io8xdqRFccOUssl9 +rh5VkDUMzbqmhq/6c4PSj8nUGBHz/e3AFKixtb1er+1NpW9h3gsjLMWxXcnplyM7 +D4q1WMiC4Dv0OLFnMXs4s8rB/i86WeYx3grpzYMCgYBIKbnrqhBgf9ZpGHL2FIqu +fW/RdNQnBK3sW18R7t6L+6KPP3IlR8hBdz7GTM89aHYdRpfz1X1P+Q1l7VXPs6ht +onkU2jmg3HuDcd9qfmOIvIC5n+aiKCZO2QsNhFbwX5y1DkTTPpAnzl9Y7/foNaKg +BSZmKAZMR/Vi5B9ICcIudQKBgA4HCi0vzMn3cCGv1qA7ZLtD0PS+HTKsKf+WMxEO +zeh0RUM5uvPGyh5PoDyX/7LjRWUGjGp/FqTJdhHa7v6f4+qQGORYjEXwOp4DegDA +EnwofnVbJHrYHInwB+Kyezx2K7G3PgidZNtk8h4viwTmgbcC1QndS8LtA2Hb1+LE +qvQbAoGASwIG310GGjFhRI7XwBL7zSmlrx5UncM17vEV6PKeYbr6tc4eS7ZFOXZP +HeQiyvbTUc+44k00AVfI8R64BdJnRAkriTU83P0bP9xbfv9+/Rp6aQDZl14zvXcr +We6StfbmHH68FblHFhERA+HtVSYpyC8ha4EIjipgFbl7zPbSmSg= +-----END RSA PRIVATE KEY----- diff --git a/deploy/dockerephemeral/docker/redis-node-6.conf b/deploy/dockerephemeral/docker/redis-node-6.conf index 07da6325790..e727dce17d9 100644 --- a/deploy/dockerephemeral/docker/redis-node-6.conf +++ b/deploy/dockerephemeral/docker/redis-node-6.conf @@ -1,7 +1,16 @@ -port 6378 +port 0 +tls-port 6378 +tls-cert-file /usr/local/etc/redis/cert.pem +tls-key-file /usr/local/etc/redis/key.pem +tls-ca-cert-file /usr/local/etc/redis/ca.pem +tls-auth-clients no +tls-cluster yes + cluster-enabled yes cluster-config-file nodes.conf cluster-node-timeout 5000 + appendonly yes + requirepass very-secure-redis-cluster-password -masterauth very-secure-redis-cluster-password +masterauth very-secure-redis-cluster-password \ No newline at end of file diff --git a/deploy/dockerephemeral/federation-v0/integration-ca.pem b/deploy/dockerephemeral/federation-v0/integration-ca.pem index 10a906c111b..df568861a0e 100644 --- a/deploy/dockerephemeral/federation-v0/integration-ca.pem +++ b/deploy/dockerephemeral/federation-v0/integration-ca.pem @@ -1,19 +1,19 @@ -----BEGIN CERTIFICATE----- -MIIDAjCCAeqgAwIBAgIUdsGG4S0KMPKYzS6UNoDuNpvkRFcwDQYJKoZIhvcNAQEL -BQAwGTEXMBUGA1UEAxMOY2EuZXhhbXBsZS5jb20wHhcNMjQwNDIyMTIwNDAwWhcN -MjkwNDIxMTIwNDAwWjAZMRcwFQYDVQQDEw5jYS5leGFtcGxlLmNvbTCCASIwDQYJ -KoZIhvcNAQEBBQADggEPADCCAQoCggEBAJatmwqb8Fabb7JQ916v7QI5ufMEBxhK -VUsnn5frxkAA99LpFRYqs4ycPWQk20tbaNpO2E7pGm0ALuKR5YR5OP69iR6+6JZl -H+c48iryVAXpBZe/PGV1vZRDsOce5YAS0mCNtLEh21FV+6QtnQdgEGbdebBhdQ5l -VN/f8hdkSCPdm56j2K/LUuwOibJYRy5zwJwjmhwuFSurTFN2Y4f6f7AYCgam2q1w -D5dk3JF8RRByvJdJQ8lNmuZbStGLgMTr+Il8Cu+huFUCcGxdDQjM4wKLwS3DgOwV -UXfMsFYxac0I4Z/oMsgE3WVDpTqTFyBGux5nOUzAeCo4iWMKHIypeukCAwEAAaNC -MEAwDgYDVR0PAQH/BAQDAgEGMA8GA1UdEwEB/wQFMAMBAf8wHQYDVR0OBBYEFDnH -CL3yIYkqK51ynDHRQcc6Xc/rMA0GCSqGSIb3DQEBCwUAA4IBAQCUzI4edToGsBTp -qnV2MtXwhoBFnmAa4O8RMsbRZqE+DCzBhPSIl9UMaeIEMoIvXL2KOO+rEw2M1uQc -D4r+dAdUhLbIFEyMNIA5EZfJfimEE0qaLGJqI5X1FFVeCvlvI1UDoSj0KQD9GEsg -VidDnhzg712cGdBY2K4U/BmpLMn8+WZ7+TSVIX8fGylzDCRtCQ36vrD5pkQzblqU -sjO8Apwej/t+BI/Y+T1MFvZhstbJ3mSQpHhnmARXLOrwjcOmLzWVlQa1IJxtxaf9 -gRxVchzH7fQxNlR6/zWtd2av07pFR9k2o9WUn/A5lpoUcVrokvCsOooqqG3UwALU -fZm6IO1I +MIIDAjCCAeqgAwIBAgIUBYyNbkD7QQIo+K40IXL+UuYmaEMwDQYJKoZIhvcNAQEL +BQAwGTEXMBUGA1UEAxMOY2EuZXhhbXBsZS5jb20wHhcNMjQwNDI5MTI0NjAwWhcN +MjkwNDI4MTI0NjAwWjAZMRcwFQYDVQQDEw5jYS5leGFtcGxlLmNvbTCCASIwDQYJ +KoZIhvcNAQEBBQADggEPADCCAQoCggEBAMXiU6bohYYGxQANCiN+0Xup4SnfFHLl +2d0ioAZcXo/pEbOoa8QP+ovCzN2IYUx7sOZ90fwyZT91c9g3++/z3QE2nSZsmsnu +dMKUaRn5EKkb0CESfKR3faMjvDuiXZm7YOIGE3XdpyHKs6HzNTz8Us1Ze9U+U16z +jjC+h12OZxYdI7GX4rqR4U9GZc+bu6onbc/gIb1t6CT44Y020SMbFb1Tu4ukZY67 +AbuiR+Ja2ILH9f5UEyUjS6lXHbeJVmO4RZi+J91O7MPE/MCjgk2+RK84d8Uv+PrM +V0sZxkTVnhgKH5QGt0a2XhN1EME6wcDKINMSfb/n/dDmSPqqWa4j2hcCAwEAAaNC +MEAwDgYDVR0PAQH/BAQDAgEGMA8GA1UdEwEB/wQFMAMBAf8wHQYDVR0OBBYEFAg4 +MuTnP5GWVyzC1y/L0dIti5y8MA0GCSqGSIb3DQEBCwUAA4IBAQBledBrBHZ10aUW +yxY/5Gj/pXiiZoyeTF3esxFUM6cGEyXpetk7SWAmIkVp2q+7uO9r94D8umXGZJhQ +nOPkNlWggrSeDy5U5akdhiOrLt+r4bZPKdNLLeiJKd94vqS9Opq51YBq4FC/8MxK +fRf6/zPjMMqZjKudlFniwxeg6CHghMqERzL66EZF29/hb1O8AFGC+J5WioA5+Cbj +se9k2mWbm+F7BjMUW4n4Fz2YR3SGtSZ4h8vzTsBmLSn4GsmLuoHZ1ccSDY/WoNDs +sSyEAr4dGN+e4pV5Uyu5h5bg/BZt86w8psbK5Z0dxTrmSC74E/hKF9JNwxK4iuV+ +4RaUWHE2 -----END CERTIFICATE----- diff --git a/deploy/dockerephemeral/federation-v0/integration-leaf-key.pem b/deploy/dockerephemeral/federation-v0/integration-leaf-key.pem index 1a45ba1ea46..a429e5651d5 100644 --- a/deploy/dockerephemeral/federation-v0/integration-leaf-key.pem +++ b/deploy/dockerephemeral/federation-v0/integration-leaf-key.pem @@ -1,27 +1,27 @@ -----BEGIN RSA PRIVATE KEY----- -MIIEowIBAAKCAQEAukRPdjUjKs7P2TgP4VDpb77Rb7KjMMBtcRP525qEnUQzFHPk -Va4cqh6xacgh2NJCyFyDEWDI9pQ03i0HISIldoBngDVvM6kwvbs+kjZ+/t/Jx3aH -zC9dmsLqmCqU+OmofpD1pt8hZWwOtYj58pfqdhrP+M6qQ92/tgmkk9njLFwsAjxY -gMXZCo0IiSIE9BE9NGvR9bp6hvEekCqREPdHi44iFca/5V4A8fSZwBlTHod5Z83r -MpHLnR1ReVVOQgzbIBGcLdmtH8IA9ZgUHy1/HOmf9e0MYOYOKbKvH3cry7WSscPL -47x+JQyFLimidfsJQCY+022rdPg9CdrCWFGxgQIDAQABAoIBAGjeBqK1fewe7XQN -FRu0cwh/tOge+bN70uHj7jrN/rWP7PYp3TbDxM2eZCH7E9s/XWvycbQ5+kqg3Dbt -wOLNl6vk1OCgtM+wBIn9PlgRKGSUV8Tdncy+KgP0kyFCcAbHfh5rvHHLk8DHGmzo -BlinYNBHfilFKST2VnXFbgvzkuuorS1BRAzlVpyJnaen04emBJ+KPIwNyguPQrlv -5duBIO1bzlEjFVufrLkI0IumWqBAPOvHcRy1geSz/MG7LssB9r25k5LA5OEDxqwx -ykSzuniaLL6BGMSCAMpTM3/hF1ijrkTd74cI4cp7k2ufcYT74ZU2lyDKEjBukG/p -H0/1Q8ECgYEAwL7VWIpySGtrJEPZH1FxtpJYg8SE0F4lUxIbIQcc6rzLJfLOLQO5 -ruTVONPTlue6PHrRO8pQTbW9AnjZvHMIiwxidY/RwUVKFuxzfrYZ9ZbKXyVOh48a -WXe5OnpuVodPEHQrKzkl93YWMgMCXNPri1h0jr0fMGXy9jZzoKK5f1kCgYEA92Uw -P4WyBL2hm/5BNUoxCiLyd1dDdQt1h6VByxYM7OXDhXq1iHnhX+NbjMT0QfOFyXBP -uQQCB9IQElmMmWsoEv6uEQCeuCvOxq+Evoz+3fP2te89HjZ1C5SXUMfG7qKfFzbt -WP6e/CqAeQPnnqI89ghw/IerQkeVMoVvHbSXZmkCgYBZPgJ6JGAVt+a7u85j+cm0 -xr3FBNCZyX1uoQt+l1SEOzW0NF/R58+pcrpmvW1SiahpKFSIYnwb/vGsm1f1MS3b -c7iCxjxQSEytoH05Rgdu9ops01Ew4slIc26H7Pf5iFzLOX5jXOp/UWWlck89u8Fr -m2EcVeSC/DEqXrvavH02wQKBgBzVKDhfBo5S44DgswzY5ro9tHCANRZxDXOPqQlY -Oo1pgc4OrRWIzuF0B/lyAt2k2hTOCBySAQKUUtcwpJhEytjb4cGNhvID+Qdi8V+b -4yBPDJPLnB3nTuDYooIBpoetYEk+V48lrbXJ5ks0T0xHsD8kYLatwSHqYdMPhhG6 -OGLxAoGBALZQSuO4fHew4ksMcBy891ZSOFUV9xAtR490EdEQdOiPrQj5vmnSpxEx -QsSVbn+49OYwzjBP+sHtpiTMF4ZlafHvjcNZ5dFIImqyuEugEdnD5UnFd92AQ9Gv -ufa7BMs99BRdkkolCXBZC+Dq4t4Z/+MDSMtjO5mh9V0boDakdJPb +MIIEowIBAAKCAQEAmSV2VmlVfsqBNCk/EoW9aN71BGRgVhF+zTojHf/DgPv94jH5 +/IjpNa5yfmT5M0invDwGJQOI3z3sz8kOdg7FvZtrhcyHACDl337gwRPy28hWELbj +IjmBOE73ck5B0dYAsqFnwxpDiepqfHlou+oL5osTerI93pN9IALjYpTZuhK+BPeZ +zlzNLk6VbVqQhd3aaVOJg7VVWPZkCdTRwP10ijPJQVgG42uM3X9BXhYmZk0yN+4M +MNKQ+P+jTL3PguqS9DKC3ObN6OvfOsuZGZaFjVtHnwW4NtiRB1E2nbcK3wgE7r9L +pgW4LSw86gQxhHcMQi1GxnWy1yUg9DJAcQkGwwIDAQABAoIBADc2HUqb4Pm78gan +FBkOZDHJp5W0xlJhLlC4s+5dxdLbhjUlBVX42fLDeH1+06ScffRLw39WneK1xYlH +l9ISE1H/FS2Ahe8S7Sy85jRVh8mamQSfmpU9HAv71BO+iNYoi8najLj24AB5pXhI +oOyWPUIZQ6WJWurCS2rd/7ILrc754gjEmPayiGXdvJhgOcjDzK65XhzTcaoocNRV +Z9/48udPFvhYKqIaHxQU/XIVwTxDQgmMnY08t7DNwRygknWFXsMxbHnIh6QztVM9 +KrFo4lXt2CgIp/vGe588iihD2QAoyhJGdc09n0dPBOY1F7djEnR4mwVg2wuGiiMJ +jTnD37ECgYEAxYaanwd6H62xlpuzktpd/cy8tJvRcSljkP//Ks53yI3jmWoyM+dx +DKarQIVRch0sIHYKV4oxvtoHAgHTTIMhldY5xTnqvvJXv66fCh3ZLcyXxfuPqK+k +7uZ+mYgvK6McB5AT3xiHTNcW6DD1706xt3ZdzqsjY3bydXjdNtEEHekCgYEAxnuV +JABIw8DXkJIr73RU8zgBu2402Ho52NOoHvaWU5908nzTQBnt5c/1lhaMN7Q07UGS +166ncRkjGrpWH+aS4t5TEMALT0LoZ0l9YMP8qmeks46Vg8BMI06ORcnC2CigeklZ +7sWPiHYvM+w1Rsm/X6hmmiPLvq4jl1KCUIEud8sCgYA4GhEUlhUTpkvIURTh4u/L +RDlcutzz3SOQbYVV7SqMZfB9BHKZ12R+iWAehT8qwCpmVeB+GJwkbtyKr2YKVzxU +yHHEGL0Z2s8dfEVjpDKpFXEOJHMbIDgiOok+pjVvmXY+l6dtOBRFuNmivTU88Qb8 +6rueFXGJsKEQyHFcPmWC8QKBgCY+odoyA9NUUTUWNUkKjWPgItVOwvgDdSoGfpqY +wRaT3yDqVHpBhMmHbLbi2VnSa3Bb9kOA79qnEVCRHw8+iocUd8T+fC9loQpl6ra+ +jOz404+VpdGhOAqFlHx2CAlGqsVlZOLRRnrw6t+CYDGnpix0cnC4/QVc4JbD20BP +4/hJAoGBAI7qa8SEcucrq28c8/mUmi+45AkCOZmmPtp31TtFoSlwkTBmAtp4+OSk +76mH5vb2kwJDWgzlmb6nPry8wPFfKQbG4NlBLbovQyc2lJtPGNOSrwboZSIcyClx +lcmE9AcCOuCBhqH18z0nE7nPQXy4IHjHBta7zEJCw+pGxCJh42ke -----END RSA PRIVATE KEY----- diff --git a/deploy/dockerephemeral/federation-v0/integration-leaf.pem b/deploy/dockerephemeral/federation-v0/integration-leaf.pem index 2247758aafd..cb0b495b92a 100644 --- a/deploy/dockerephemeral/federation-v0/integration-leaf.pem +++ b/deploy/dockerephemeral/federation-v0/integration-leaf.pem @@ -1,21 +1,21 @@ -----BEGIN CERTIFICATE----- -MIIDcjCCAlqgAwIBAgIUK9Dix5VZpBYOby63cdmjtfg6RpwwDQYJKoZIhvcNAQEL -BQAwGTEXMBUGA1UEAxMOY2EuZXhhbXBsZS5jb20wHhcNMjQwNDIyMTIwNDAwWhcN -MjUwNDIyMTIwNDAwWjAAMIIBIjANBgkqhkiG9w0BAQEFAAOCAQ8AMIIBCgKCAQEA -ukRPdjUjKs7P2TgP4VDpb77Rb7KjMMBtcRP525qEnUQzFHPkVa4cqh6xacgh2NJC -yFyDEWDI9pQ03i0HISIldoBngDVvM6kwvbs+kjZ+/t/Jx3aHzC9dmsLqmCqU+Omo -fpD1pt8hZWwOtYj58pfqdhrP+M6qQ92/tgmkk9njLFwsAjxYgMXZCo0IiSIE9BE9 -NGvR9bp6hvEekCqREPdHi44iFca/5V4A8fSZwBlTHod5Z83rMpHLnR1ReVVOQgzb -IBGcLdmtH8IA9ZgUHy1/HOmf9e0MYOYOKbKvH3cry7WSscPL47x+JQyFLimidfsJ -QCY+022rdPg9CdrCWFGxgQIDAQABo4HKMIHHMA4GA1UdDwEB/wQEAwIFoDAdBgNV +MIIDcjCCAlqgAwIBAgIUf1Euc5flsS90XTspZ7RXONZm8DgwDQYJKoZIhvcNAQEL +BQAwGTEXMBUGA1UEAxMOY2EuZXhhbXBsZS5jb20wHhcNMjQwNDI5MTI0NjAwWhcN +MjUwNDI5MTI0NjAwWjAAMIIBIjANBgkqhkiG9w0BAQEFAAOCAQ8AMIIBCgKCAQEA +mSV2VmlVfsqBNCk/EoW9aN71BGRgVhF+zTojHf/DgPv94jH5/IjpNa5yfmT5M0in +vDwGJQOI3z3sz8kOdg7FvZtrhcyHACDl337gwRPy28hWELbjIjmBOE73ck5B0dYA +sqFnwxpDiepqfHlou+oL5osTerI93pN9IALjYpTZuhK+BPeZzlzNLk6VbVqQhd3a +aVOJg7VVWPZkCdTRwP10ijPJQVgG42uM3X9BXhYmZk0yN+4MMNKQ+P+jTL3PguqS +9DKC3ObN6OvfOsuZGZaFjVtHnwW4NtiRB1E2nbcK3wgE7r9LpgW4LSw86gQxhHcM +Qi1GxnWy1yUg9DJAcQkGwwIDAQABo4HKMIHHMA4GA1UdDwEB/wQEAwIFoDAdBgNV HSUEFjAUBggrBgEFBQcDAQYIKwYBBQUHAwIwDAYDVR0TAQH/BAIwADAdBgNVHQ4E -FgQUaJdzHC5JsdIEKTYxqAWoSHvFCNgwHwYDVR0jBBgwFoAUOccIvfIhiSornXKc -MdFBxzpdz+swSAYDVR0RAQH/BD4wPIIZKi5pbnRlZ3JhdGlvbi5leGFtcGxlLmNv +FgQUv8i5VPBWRk+7SbQoK3bsYK4VwncwHwYDVR0jBBgwFoAUCDgy5Oc/kZZXLMLX +L8vR0i2LnLwwSAYDVR0RAQH/BD4wPIIZKi5pbnRlZ3JhdGlvbi5leGFtcGxlLmNv bYIUaG9zdC5kb2NrZXIuaW50ZXJuYWyCCWxvY2FsaG9zdDANBgkqhkiG9w0BAQsF -AAOCAQEAcoUcdwgoAiFJcoS/t1IU2axEJeWncctYyVHt/ZfoZ8y/23XDA+kIfgSt -DZEqteGyVDSBbI/B45IzrKQuJzdT8B+9iDcOzLrA2R1432ASlMhHC5l3STBru0jl -oL9M8fJU6BwciCqY0Y2wFcCfVthN1rC8vNNSpwSwF74q87MMLZ/65Mi3hAB4177s -uNL6MXGta9fBK9MQxM3S/Kr7fmxOTQBlQtcA2Ha3Yog2+dkMXosoapjoMwWj36DS -j9v25/dFmS3dnCfhRHBSh9iUSnbOVZ/M+5Bv5hBPYbeSw24DXD1w9soEYL941D+c -enXV719UPw5bpBxhXjl9Hu0TQ2uoIw== +AAOCAQEAamTOVMoIb6s+q2IT/zgR/UbkRFlTAsGo7mPIgfgC0D8FkJgLJwYA3uz1 +ZEQ0XRbnmsFFeTdPYya4TOz1E0ZsA4tgK0DOJgPTRfP+DOiplFMDPCrgHPkHQGOd +LDSzQv+GrlSuYUuFxLFXXYZwWzxg5Tv0UgcL+i1wkVBSkwsUvtUkKqqOAjG1cZpI +Mc4VtMAYh5NaBb7KfCo47srRMQfg1SKiGmG65LRUJHGHoVc5PNohz/sbfef/WC0W +haih/68v9qVF/8Xmvy+XKUk5t4mHwpxu1foPCBdMDAU1Udk39VZmYNBbycp+2dt6 +BOe3K9zXlCS8KnJOVLoe9nxsWOAsgA== -----END CERTIFICATE----- diff --git a/docs/src/developer/reference/config-options.md b/docs/src/developer/reference/config-options.md index fc137633541..92075af274c 100644 --- a/docs/src/developer/reference/config-options.md +++ b/docs/src/developer/reference/config-options.md @@ -1028,3 +1028,65 @@ gundeck: **NOTE**: `redisAddtiionalWriteUsername` follows same restrictions as `redisUsername` when using legacy auth. + + +## Configure TLS for Redis + +If the redis instance requires TLS, it can be configured like this: + +```yaml +gundeck: + config: + redis: + enableTls: true +``` + +In case a custom CA certificate is required it can be provided like this: + +```yaml +gundeck: + config: + redis: + tlsCa: +``` + +There is another way to provide this, in case there already exists a kubernetes +secret containing the CA certificate(s): + +```yaml +gundeck: + config: + redis: + tlsCaSecretRef: + name: + key: +``` + +For configuring `redisAdditionalWrite` in gundeck (this is required during a +migration from one redis instance to another), the settings need to be like +this: + +```yaml +gundeck: + config: + redisAdditionalWrite: + enableTls: true + # One or none of these: + # tlsCa: + # tlsCaSecretRef: +``` + + +**WARNING:** Please do this only if you know what you're doing. + +In case it is not possible to verify TLS certificate of the elasticsearch +server, it can be turned off without tuning off TLS like this: + +```yaml +gundeck: + config: + redis: + insecureSkipVerifyTls: true + redisAdditionalWrite: + insecureSkipVerifyTls: true +``` diff --git a/hack/bin/selfsigned.sh b/hack/bin/selfsigned.sh index 73e507358fc..644eb1a02e1 100755 --- a/hack/bin/selfsigned.sh +++ b/hack/bin/selfsigned.sh @@ -18,6 +18,10 @@ FEDERATION_CA="$TEMP/integration-ca" FEDERATION_LEAF_CERT="$TEMP/integration-leaf" ELASTICSEARCH_CA="$TEMP/elasticsearch-ca" ELASTICSEARCH_LEAF_CERT="$TEMP/elasticsearch-leaf" +CSR_REDIS_CA="$TEMP/csr-redis-ca.json" +CSR_REDIS="$TEMP/csr-redis.json" +REDIS_CA="$TEMP/redis-ca" +REDIS_LEAF_CERT="$TEMP/redis-leaf" command -v cfssl >/dev/null 2>&1 || { echo >&2 "cfssl is not installed, aborting. See https://github.com/cloudflare/cfssl"; exit 1; } command -v cfssljson >/dev/null 2>&1 || { echo >&2 "cfssljson is not installed, aborting. See https://github.com/cloudflare/cfssl"; exit 1; } @@ -90,4 +94,40 @@ cp "$ELASTICSEARCH_LEAF_CERT-key.pem" "$ROOT_DIR/deploy/dockerephemeral/docker/e cp "$ELASTICSEARCH_CA.pem" "$ROOT_DIR/hack/helm_vars/elasticsearch-certs/elasticsearch-ca.pem" cp "$ELASTICSEARCH_CA-key.pem" "$ROOT_DIR/hack/helm_vars/elasticsearch-certs/elasticsearch-ca-key.pem" +echo '{ + "CN": "redis.ca.example.com", + "key": { + "algo": "rsa", + "size": 2048 + } +}' > "$CSR_REDIS_CA" + +# generate CA key and cert +cfssl gencert -initca "$CSR_REDIS_CA" | cfssljson -bare "$REDIS_CA" + +echo '{ + "key": { + "algo": "rsa", + "size": 2048 + } +}' > "$CSR_REDIS" + + +cp "$REDIS_CA.pem" "$ROOT_DIR/deploy/dockerephemeral/docker/redis-ca.pem" + +for redis_node in $(seq 1 6); do + # generate cert and key based on CA given comma-separated hostnames as SANs + # TODO: Its not good to depend on nip.io for running integration tests locally + cfssl gencert \ + -ca "$REDIS_CA.pem" \ + -ca-key "$REDIS_CA-key.pem" \ + -hostname="redis-${redis_node},172.20.0.3${redis_node}" \ + "$CSR_REDIS" \ + | cfssljson -bare "$REDIS_LEAF_CERT-${redis_node}" + + cp "${REDIS_LEAF_CERT}-${redis_node}.pem" "$ROOT_DIR/deploy/dockerephemeral/docker/redis-node-${redis_node}-cert.pem" + cp "${REDIS_LEAF_CERT}-${redis_node}-key.pem" "$ROOT_DIR/deploy/dockerephemeral/docker/redis-node-${redis_node}-key.pem" + chmod 0644 "$ROOT_DIR/deploy/dockerephemeral/docker/redis-node-${redis_node}-key.pem" +done + rm -rf "$TEMP" diff --git a/hack/helm_vars/certs/elasticsearch-ca-key.pem b/hack/helm_vars/certs/elasticsearch-ca-key.pem new file mode 100644 index 00000000000..f6dc9c0c2e1 --- /dev/null +++ b/hack/helm_vars/certs/elasticsearch-ca-key.pem @@ -0,0 +1,27 @@ +-----BEGIN RSA PRIVATE KEY----- +MIIEowIBAAKCAQEAzDrMEXnLq5Ly9zjWdoOty9lFYHfFR1GDACJm3Gc/Hvz9DcY0 +e/Untv5L1a+ewN4npuFY6o4ezl3+gHmzYekEBsgTtEoAhjnCspj4WrbnAzdorExi +qTBddJlGREQl+SVgtp1Bu5aQWiqWeZfCFsmaYYdDuCaTDvRVG5zz1oO73VX8DOPt +tLeIwdCxRdtW/MMcviWehvDovSPA8FJZqYCDXJrLtTysfNoDUOhMuTNQlDzg4NwZ +uZx+/ZtikI6llyUr1sC6i/GVK9ue6QsD4FpGLsJXqHXCnZklWs9xaUdvMVGqRUT/ +vxuIv0TH97KAM0FYp26t6iyRjpHVcH0/Ykwj4wIDAQABAoIBAGAIkebxz6zJN8i6 +iFZISxQdAbt/9ls34BLTGm0ve4X1zoSInCthtyAcacp8f3kPvbOCKY5579B4cHE3 +SPuUV5lcwa84URDM3lmfBsGZWf2wM185t/b40ClA3cLCDN0gD18viTZNcWmEtydM +Di8q85ZCxbw1H1eb2t1WK27GmTNVIN6VlgyeWJVGdRqhCazS2OJLLy1AaW1hTwFe +7GQoYjO4JG8NhEq73OfubpbFrWKizLRyFfCZK4RuR+s/6/QNItT/jzOz8ZbGzPwT +7NNAoQp0UEDEiyUaFaVeouLvIVWovkYt2yT+ry1SdyUn4PJJEF80p9Hw8TtrzA7h +ToMhjfkCgYEA9I808jib+IR/L/lli+enHzfJkJTaLBbI4N3w4zmdsBsEmKC0+Hbw +LKw2snnum2K3a7GaCFlp+MqUO1HcB796elb+/g1/FVnnVf1dw/GcmU6mcb1fSMyZ +ukfVp1RejJS0tvNmkopDLT5hEBvUEmdPoupS6v0o7MJya5ITHnGcUjUCgYEA1cic +HJY/MOCLWCLhxDjRNlPgcv1ZLgbivjkXp/A7jwdzZDkwk1DiPY2uJpgNcHdXStdc +w4Hyvcb0RtL49739IC6I9KGTqKkBWplhCGosIeWa90vNAA/nz8LAb10GBje/YkuH +ijdQU8LeFQSSzvjHDCe/GpGyO5F5bOMQQlkD4LcCgYBfE/nqnbWNpb1o4lXnUXV4 +vpCfpC856tXIDqEjRfgXSjm8OOaCnoL7ayyMsLjiMjvLI64VxuVbMy7z7PxVCs1M +GNxj2s1oeJ5moO0+S4WtWJV/LLeJrvmpIVpgBn4Hu5yScAiVuikpwtGrmJYXXZDp +bp4z+55YhbREO/Mw58x1bQKBgDdXH/pSdncrmUaueOz3nEjI+7Aonx5IEAgX9WS2 +zmQfFKLcHxPzey1d8Lfy4n+7lPA9wbimefTgfLmcwXA4UT80bKWO8g9V+JDAZZrt +CRGZQz1C9QVQGLzyeCgb14Rih/tk++gum2+jYSPltC85vSULYO/6yT2cUed6++mA +630PAoGBAM0pG5Ncu3eddlOYV34lMoSIiy+4pUcZbECMWPmYV+N9iX3GYTgRbSkf +11YImU2TOEs1gK9iFPcH826HTnunOSzyEgdXX8d7+J1tRf0gofMKu8VqW8sUDPgo +Y4KH/48LJ+k00bt1Dl5g8FTmaKRQF0JrAtlmanTPh5W9aubJpp68 +-----END RSA PRIVATE KEY----- diff --git a/hack/helm_vars/certs/elasticsearch-ca.pem b/hack/helm_vars/certs/elasticsearch-ca.pem new file mode 100644 index 00000000000..f56c3396fcf --- /dev/null +++ b/hack/helm_vars/certs/elasticsearch-ca.pem @@ -0,0 +1,19 @@ +-----BEGIN CERTIFICATE----- +MIIDHjCCAgagAwIBAgIUSYROJq4Fwdnd/Jfaeyg2Fk6cCKEwDQYJKoZIhvcNAQEL +BQAwJzElMCMGA1UEAxMcZWxhc3RpY3NlYXJjaC5jYS5leGFtcGxlLmNvbTAeFw0y +NDA0MjkxMjQ2MDBaFw0yOTA0MjgxMjQ2MDBaMCcxJTAjBgNVBAMTHGVsYXN0aWNz +ZWFyY2guY2EuZXhhbXBsZS5jb20wggEiMA0GCSqGSIb3DQEBAQUAA4IBDwAwggEK +AoIBAQDMOswRecurkvL3ONZ2g63L2UVgd8VHUYMAImbcZz8e/P0NxjR79Se2/kvV +r57A3iem4Vjqjh7OXf6AebNh6QQGyBO0SgCGOcKymPhatucDN2isTGKpMF10mUZE +RCX5JWC2nUG7lpBaKpZ5l8IWyZphh0O4JpMO9FUbnPPWg7vdVfwM4+20t4jB0LFF +21b8wxy+JZ6G8Oi9I8DwUlmpgINcmsu1PKx82gNQ6Ey5M1CUPODg3Bm5nH79m2KQ +jqWXJSvWwLqL8ZUr257pCwPgWkYuwleodcKdmSVaz3FpR28xUapFRP+/G4i/RMf3 +soAzQVinbq3qLJGOkdVwfT9iTCPjAgMBAAGjQjBAMA4GA1UdDwEB/wQEAwIBBjAP +BgNVHRMBAf8EBTADAQH/MB0GA1UdDgQWBBTMfBqgo5cmKmYOfq79rwuw4oKRfDAN +BgkqhkiG9w0BAQsFAAOCAQEAPi4E/Q23DbSFLtRMxNIWl+aX8Ps50KJzIhrv9T1d +q0t73lXe6agQjKUVBqaf662JZ/r5ihBNiiaU7x5ieaz+3OaA8QsHuGd67p/eDu1L +zoX+EfagpIuT1r3aJeo0551pGhYDw+xhtaib/kc5sxfUBL5EoCyVi0RpwAH7cFwr +FOsVaOVetqbfTUqDYdnXufrV+IX9ZtXnz6yvdKdizdDrz6P+yBxGKQeYMkCGiUvY +nFvb1F5WH0lCM1klJilW8WHvGDsEmhgCRoRfJvlUk/I217KumCXPHh6pwiT5VwWL +ANPKWH9AyHvyXsP44zF4OMtEqQJVzxzPdnmPwWWH10iptA== +-----END CERTIFICATE----- diff --git a/hack/helm_vars/certs/values.yaml.gotmpl b/hack/helm_vars/certs/values.yaml.gotmpl new file mode 100644 index 00000000000..875a4a17124 --- /dev/null +++ b/hack/helm_vars/certs/values.yaml.gotmpl @@ -0,0 +1,68 @@ +resources: + - apiVersion: v1 + kind: Secret + metadata: + name: elasticsearch-ca + namespace: '{{ .Release.Namespace }}' + data: + tls.crt: {{ readFile "./elasticsearch-ca.pem" | b64enc | quote }} + tls.key: {{ readFile "./elasticsearch-ca-key.pem" | b64enc | quote }} + - apiVersion: cert-manager.io/v1 + kind: Issuer + metadata: + name: elasticsearch + namespace: '{{ .Release.Namespace }}' + spec: + ca: + secretName: elasticsearch-ca + - apiVersion: cert-manager.io/v1 + kind: Issuer + metadata: + name: redis-ca-issuer + namespace: '{{ .Release.Namespace }}' + spec: + selfSigned: {} + - apiVersion: cert-manager.io/v1 + kind: Certificate + metadata: + name: redis-ca + namespace: '{{ .Release.Namespace }}' + spec: + secretName: redis-ca-certificate + isCA: true + duration: 2160h # 90d + renewBefore: 360h # 15d + commonName: redis.example.com + privateKey: + algorithm: RSA + encoding: PKCS1 + size: 2048 + issuerRef: + name: redis-ca-issuer + kind: Issuer + - apiVersion: cert-manager.io/v1 + kind: Issuer + metadata: + name: redis-issuer + namespace: '{{ .Release.Namespace }}' + spec: + ca: + secretName: redis-ca-certificate + - apiVersion: cert-manager.io/v1 + kind: Certificate + metadata: + name: redis + namespace: '{{ .Release.Namespace }}' + spec: + secretName: redis-certificate + isCA: false + duration: 2160h # 90d + renewBefore: 360h # 15d + commonName: redis-ephemeral-master + privateKey: + algorithm: RSA + encoding: PKCS1 + size: 2048 + issuerRef: + name: redis-issuer + kind: Issuer diff --git a/hack/helm_vars/elasticsearch-certs/elasticsearch-ca-key.pem b/hack/helm_vars/elasticsearch-certs/elasticsearch-ca-key.pem deleted file mode 100644 index 0b9246b7ecb..00000000000 --- a/hack/helm_vars/elasticsearch-certs/elasticsearch-ca-key.pem +++ /dev/null @@ -1,27 +0,0 @@ ------BEGIN RSA PRIVATE KEY----- -MIIEpAIBAAKCAQEAtEfj7ZOOh3fEq0fkv3TO5xr4WANhK1lBYaclA1ou1aVKU4LZ -ck85jYMQJYfUFp/Brqr8KghQZ24iy/jlehLE9f3yrf94mFb/psoOYAUzx7f0DWh2 -eRO8DHcA0R0bgCkCPZAnWWWe/6a1T00A8dBNdssTFmxPjYL2HzZpCV0ht2OUuYoR -PETviWWHnAFn3N4sBGXg+3fVp1bG9LDPoicDDjk5cSkiPAsPrpHF3U4faZsckDWV -XdbUhl/zR9vNRCq6CDy6iAMYMtXdnFKogiiH+KRhG4o2/JvzpKBXs/u745g+ewPL -krsMl8+/sRNrkSRQIrLoOc3W/ClgCQZRJIIFmwIDAQABAoIBAQCtn7L/IqYZB5rs -ToAad5ewcYQN16tkgUB7mOsHsHn8noTXquRat7w48qnBS3BSHaf93YSfwoQVKLfw -c5QmHh98vgdT1f/Bz7/FVUHE7h2xUhOEOkAnWX85Df9GZd8Pbe9PdR7AdSNNGbPy -XLn1KWUBbJDEfqmbIy6AXvmH4B7Rq0K/8nRdTJsZiGBwR3TZINWkVv43b4LMlqdn -QavTm2cO7wylN6QWtWbutFs2YrbG7LCdn1qOyMQgNAwzHbzatQjWl8M7K9xoNaec -pjIS7/Oobs4OVlMxLn/QWF2wCWt+r3i+USqoAw7qgPXMQ1b6h4vaKHJw8UCTeI42 -Xi5vvfC5AoGBAOIfQ8kNHFI+7/5aPa7SQC0tqwBT+HkAZY4DZsFeCe7aKIrvqwCj -/6ioGrfLhtjQTUnxN5D9DyJnbNAKSGwbuylVcJiARPv5NxXS9ES3QmgK/mqz+Ds3 -8SVM48tI4jAfeSuDW/qztVOXpzZYJmnjVO1Qu0pNnmTMAB3WE2vqZlRvAoGBAMwa -AxkI4O2CUeaOug+eG/+ztlpX79lU+DDLYtM8CH8MVBfqQtLg5UxUGE7eVkSZyOYN -STz6eKIh5tvPc91l9xSrL5wwGmSl48f3xxycJVF2UfD7LmlcvRHthLCQPWHcCAne -6RWinCiS4ATPU6p9DzR6XYyALB0vODr84qTb9a+VAoGASPP9UqhAMujLVSyYKgb7 -XZgWS4zL5X4TRbYjOM+2NLF90xVv/kzq9ucFd7baUqkhxnFklAqRD3B+0r/+jaKE -x9kg8pKvrvvAofHljSXy7s5dNt/JfpGV44rjE3r4Pr5owXkn+8JvBgEvmYDnI9KM -W+RoCJjyOWL3xqiCq5Z8XVECgYB3vD7a/fFuhIhlmI+gv+GvFY/B2lrUBdwATCDy -yQI2/lWLHhwLuHHsYF1OT3MOlaVdCKhRhKMmgnr7su1HEh1sW6z3lOS27Pb/BeYi -a5wc+SvDEqg8mXI1xUCVkFjiQwHYQJQ+5AF2cAvJ5pMvrmQwJiUhWsQGbwAu4tJX -Ys70LQKBgQC3jOZpW5MrBdyGRJwkGYrJ3oGvgM5HGqD/9088b42i7EoDroh43e1r -rX+6mkocXd1LU2+zRaCqxA58dNuqXvU1dESW0gLgUoe3ubIlfoaD9MBwlE0trBDw -iO3tSUQ3zzYh+Uu7xBywvDEGnRhJTBs1AuwdxsdSte2WrQ7KLHwncQ== ------END RSA PRIVATE KEY----- diff --git a/hack/helm_vars/elasticsearch-certs/elasticsearch-ca.pem b/hack/helm_vars/elasticsearch-certs/elasticsearch-ca.pem deleted file mode 100644 index d4ef94d4d2a..00000000000 --- a/hack/helm_vars/elasticsearch-certs/elasticsearch-ca.pem +++ /dev/null @@ -1,19 +0,0 @@ ------BEGIN CERTIFICATE----- -MIIDHjCCAgagAwIBAgIUXd/KjPrGXSmRyZ4Q/9O3LPGB70owDQYJKoZIhvcNAQEL -BQAwJzElMCMGA1UEAxMcZWxhc3RpY3NlYXJjaC5jYS5leGFtcGxlLmNvbTAeFw0y -NDA0MjIxMjA0MDBaFw0yOTA0MjExMjA0MDBaMCcxJTAjBgNVBAMTHGVsYXN0aWNz -ZWFyY2guY2EuZXhhbXBsZS5jb20wggEiMA0GCSqGSIb3DQEBAQUAA4IBDwAwggEK -AoIBAQC0R+Ptk46Hd8SrR+S/dM7nGvhYA2ErWUFhpyUDWi7VpUpTgtlyTzmNgxAl -h9QWn8GuqvwqCFBnbiLL+OV6EsT1/fKt/3iYVv+myg5gBTPHt/QNaHZ5E7wMdwDR -HRuAKQI9kCdZZZ7/prVPTQDx0E12yxMWbE+NgvYfNmkJXSG3Y5S5ihE8RO+JZYec -AWfc3iwEZeD7d9WnVsb0sM+iJwMOOTlxKSI8Cw+ukcXdTh9pmxyQNZVd1tSGX/NH -281EKroIPLqIAxgy1d2cUqiCKIf4pGEbijb8m/OkoFez+7vjmD57A8uSuwyXz7+x -E2uRJFAisug5zdb8KWAJBlEkggWbAgMBAAGjQjBAMA4GA1UdDwEB/wQEAwIBBjAP -BgNVHRMBAf8EBTADAQH/MB0GA1UdDgQWBBQ1/LWQ/Ckxpc7HdBp6mNBfZNQssDAN -BgkqhkiG9w0BAQsFAAOCAQEAfGo1ONgSfTwRtT/ZsZgAnseqZSQCuvUQ4nrg2dDe -cFZtC05EczfmPx7G7Q2VeF9ZU56m/Ep57gE4W2wwVIwoG3Zam0kG4HirkgLNPagf -j3RkDrCvrjeESYFj7qwdnmgFNxotlC0KjHkGrfdT7gTDSWoNE3tobxyFaT1YQyBB -L6oRVlKa6O0ivgADUw/VMIARqFgCni/PhaHd4UlR9bgLVQ4MEVb463MMpGAdK4ZZ -l1bYVRf0pTeYnEiUG2HXt/1JFzSowFoZD8wVOXa0kcxy9SK/UCX8PVzMx06G4Ion -NNkzz9uSme9hAQlVsW6gxzl0NhwOtClpPIlvEqHwgF54KQ== ------END CERTIFICATE----- diff --git a/hack/helm_vars/elasticsearch-certs/es-cert-issuer.yaml.gotmpl b/hack/helm_vars/elasticsearch-certs/es-cert-issuer.yaml.gotmpl deleted file mode 100644 index a9ef90fd0e8..00000000000 --- a/hack/helm_vars/elasticsearch-certs/es-cert-issuer.yaml.gotmpl +++ /dev/null @@ -1,17 +0,0 @@ -resources: - - apiVersion: v1 - kind: Secret - metadata: - name: elasticsearch-ca - namespace: '{{ .Release.Namespace }}' - data: - tls.crt: {{ readFile "./elasticsearch-ca.pem" | b64enc | quote }} - tls.key: {{ readFile "./elasticsearch-ca-key.pem" | b64enc | quote }} - - apiVersion: cert-manager.io/v1 - kind: Issuer - metadata: - name: elasticsearch - namespace: '{{ .Release.Namespace }}' - spec: - ca: - secretName: elasticsearch-ca diff --git a/hack/helm_vars/redis-cluster/values.yaml.gotmpl b/hack/helm_vars/redis-cluster/values.yaml.gotmpl index 9d81712a59d..d43a704323b 100644 --- a/hack/helm_vars/redis-cluster/values.yaml.gotmpl +++ b/hack/helm_vars/redis-cluster/values.yaml.gotmpl @@ -7,3 +7,6 @@ redis-cluster: volumePermissions: enabled: true password: very-secure-redis-cluster-password + tls: + enabled: true + existingSecret: redis-certificate diff --git a/hack/helm_vars/wire-server/values.yaml.gotmpl b/hack/helm_vars/wire-server/values.yaml.gotmpl index 11cf79753cd..66a7e300915 100644 --- a/hack/helm_vars/wire-server/values.yaml.gotmpl +++ b/hack/helm_vars/wire-server/values.yaml.gotmpl @@ -330,6 +330,10 @@ gundeck: redis: host: redis-ephemeral-master connectionMode: master + enableTls: true + tlsCaSecretRef: + name: "redis-certificate" + key: "ca.crt" aws: account: "123456789012" region: eu-west-1 @@ -489,6 +493,10 @@ integration: tlsCaSecretRef: name: "elasticsearch-ephemeral-certificate" key: "ca.crt" + redis: + tlsCaSecretRef: + name: "redis-certificate" + key: "ca.crt" {{- if .Values.uploadXml }} uploadXml: baseUrl: {{ .Values.uploadXml.baseUrl }} diff --git a/hack/helmfile.yaml b/hack/helmfile.yaml index c8a9824ec8b..a7ed6861883 100644 --- a/hack/helmfile.yaml +++ b/hack/helmfile.yaml @@ -71,11 +71,11 @@ releases: values: - './helm_vars/fake-aws/values.yaml' - - name: 'elasticsearch-certs' + - name: 'certs' namespace: '{{ .Values.namespace1 }}' chart: bedag/raw values: - - './helm_vars/elasticsearch-certs/es-cert-issuer.yaml.gotmpl' + - './helm_vars/certs/values.yaml.gotmpl' - name: 'databases-ephemeral' namespace: '{{ .Values.namespace1 }}' @@ -85,6 +85,13 @@ releases: redis-ephemeral: usePassword: true password: very-secure-redis-master-password + tls: + enabled: true + certificatesSecret: redis-certificate + certFilename: "tls.crt" + certKeyFilename: "tls.key" + certCAFilename: "ca.crt" + authClients: false elasticsearch-ephemeral: tls: enabled: true @@ -92,7 +99,7 @@ releases: name: elasticsearch kind: Issuer needs: - - elasticsearch-certs + - certs # Required for testing redis migration - name: 'redis-ephemeral-2' @@ -104,11 +111,11 @@ releases: usePassword: true password: very-secure-redis-master-password-2 - - name: 'elasticsearch-certs' + - name: 'certs' namespace: '{{ .Values.namespace2 }}' chart: bedag/raw values: - - './helm_vars/elasticsearch-certs/es-cert-issuer.yaml.gotmpl' + - './helm_vars/certs/values.yaml.gotmpl' - name: 'databases-ephemeral' namespace: '{{ .Values.namespace2 }}' @@ -118,6 +125,13 @@ releases: redis-ephemeral: usePassword: true password: very-secure-redis-master-password + tls: + enabled: true + certificatesSecret: redis-certificate + certFilename: "tls.crt" + certKeyFilename: "tls.key" + certCAFilename: "ca.crt" + authClients: false elasticsearch-ephemeral: tls: enabled: true @@ -125,7 +139,7 @@ releases: name: elasticsearch kind: Issuer needs: - - elasticsearch-certs + - certs - name: k8ssandra-test-cluster chart: '../.local/charts/k8ssandra-test-cluster' diff --git a/nix/haskell-pins.nix b/nix/haskell-pins.nix index 1b3c0b97ae5..bdd47bae029 100644 --- a/nix/haskell-pins.nix +++ b/nix/haskell-pins.nix @@ -99,6 +99,18 @@ let }; }; + # PR: https://github.com/kazu-yamamoto/crypton-certificate/pull/8 + crypton-certificates = { + src = fetchgit { + url = "https://github.com/akshaymankar/hs-certificate"; + rev = "9e293695d8ca5efc513ee0082ae955ff9b32eb6b"; + sha256 = "sha256-mD5Dvuzol3K9CNNSfa2L9ir9AbrQ8HJc0QNmkK3qBWk="; + }; + packages = { + "crypton-x509-validation" = "x509-validation"; + }; + }; + # PR: https://github.com/dpwright/HaskellNet-SSL/pull/33 HaskellNet-SSL = { src = fetchgit { @@ -117,11 +129,12 @@ let }; # PR: https://github.com/informatikr/hedis/pull/224 + # PR: https://github.com/informatikr/hedis/pull/226 hedis = { src = fetchgit { url = "https://github.com/wireapp/hedis"; - rev = "81cdd8a2350b96168a06662c2601a41141a19f2d"; - sha256 = "sha256-0g6x9UOUq7s5ClnxMXvjYR2AsWNA6ymv1tYlQC44hGs="; + rev = "c45975e4b5f42b9d0c853e2d59ed55582f6b1482"; + sha256 = "sha256-oB7Z7ErYFguLiWPaFzCsD3Q+7UPfAkvdkc8aKSePmbQ="; }; }; diff --git a/services/gundeck/default.nix b/services/gundeck/default.nix index 3614f31e11b..4fe37c9149d 100644 --- a/services/gundeck/default.nix +++ b/services/gundeck/default.nix @@ -21,6 +21,7 @@ , conduit , containers , criterion +, crypton-x509-store , errors , exceptions , extended @@ -104,6 +105,7 @@ mkDerivation { bytestring-conversion cassandra-util containers + crypton-x509-store errors exceptions extended diff --git a/services/gundeck/gundeck.cabal b/services/gundeck/gundeck.cabal index 52532c525ad..28d8753c5e1 100644 --- a/services/gundeck/gundeck.cabal +++ b/services/gundeck/gundeck.cabal @@ -125,6 +125,7 @@ library , bytestring-conversion >=0.2 , cassandra-util >=0.16.2 , containers >=0.5 + , crypton-x509-store , errors >=2.0 , exceptions >=0.4 , extended diff --git a/services/gundeck/gundeck.integration.yaml b/services/gundeck/gundeck.integration.yaml index 85ce51ef88c..6c4c2ca748a 100644 --- a/services/gundeck/gundeck.integration.yaml +++ b/services/gundeck/gundeck.integration.yaml @@ -14,9 +14,12 @@ cassandra: # filterNodesByDatacentre: datacenter1 redis: - host: 127.0.0.1 - port: 6377 + host: 172.20.0.31 + port: 6373 connectionMode: cluster # master | cluster + enableTls: true + tlsCa: ../../deploy/dockerephemeral/docker/redis-ca.pem + insecureSkipVerifyTls: false # redisAdditionalWrite: # host: 127.0.0.1 diff --git a/services/gundeck/src/Gundeck/Env.hs b/services/gundeck/src/Gundeck/Env.hs index c9e8a4d286b..b9d5f5c073d 100644 --- a/services/gundeck/src/Gundeck/Env.hs +++ b/services/gundeck/src/Gundeck/Env.hs @@ -29,9 +29,10 @@ import Control.Retry (capDelay, exponentialBackoff) import Data.ByteString.Char8 qualified as BSChar8 import Data.Metrics.Middleware (Metrics) import Data.Misc (Milliseconds (..)) -import Data.Text (unpack) +import Data.Text qualified as Text import Data.Time.Clock import Data.Time.Clock.POSIX +import Data.X509.CertificateStore as CertStore import Database.Redis qualified as Redis import Gundeck.Aws qualified as Aws import Gundeck.Options as Opt hiding (host, port) @@ -42,6 +43,8 @@ import Gundeck.ThreadBudget import Imports import Network.HTTP.Client (responseTimeoutMicro) import Network.HTTP.Client.TLS (tlsManagerSettings) +import Network.TLS as TLS +import Network.TLS.Extra qualified as TLS import System.Logger qualified as Log import System.Logger.Extended qualified as Logger @@ -110,14 +113,36 @@ reqIdMsg = ("request" Logger..=) . unRequestId createRedisPool :: Logger.Logger -> RedisEndpoint -> Maybe ByteString -> Maybe ByteString -> ByteString -> IO (Async (), Redis.RobustConnection) createRedisPool l ep username password identifier = do + customCertStore <- case ep._tlsCa of + Nothing -> pure Nothing + Just caPath -> CertStore.readCertificateStore caPath + let defClientParams = defaultParamsClient (Text.unpack ep._host) "" + tlsParams = + guard ep._enableTls + $> defClientParams + { clientHooks = + if ep._insecureSkipVerifyTls + then defClientParams.clientHooks {onServerCertificate = \_ _ _ _ -> pure []} + else defClientParams.clientHooks, + clientShared = + case customCertStore of + Nothing -> defClientParams.clientShared + Just sharedCAStore -> defClientParams.clientShared {sharedCAStore}, + clientSupported = + defClientParams.clientSupported + { supportedVersions = [TLS.TLS13, TLS.TLS12], + supportedCiphers = TLS.ciphersuite_strong + } + } let redisConnInfo = Redis.defaultConnectInfo - { Redis.connectHost = unpack $ ep ^. O.host, + { Redis.connectHost = Text.unpack $ ep ^. O.host, Redis.connectPort = Redis.PortNumber (fromIntegral $ ep ^. O.port), Redis.connectUsername = username, Redis.connectAuth = password, Redis.connectTimeout = Just (secondsToNominalDiffTime 5), - Redis.connectMaxConnections = 100 + Redis.connectMaxConnections = 100, + Redis.connectTLSParams = tlsParams } Log.info l $ diff --git a/services/gundeck/src/Gundeck/Options.hs b/services/gundeck/src/Gundeck/Options.hs index 2be1f5d2cca..f5882a2a708 100644 --- a/services/gundeck/src/Gundeck/Options.hs +++ b/services/gundeck/src/Gundeck/Options.hs @@ -110,7 +110,13 @@ deriveJSON defaultOptions {constructorTagModifier = map toLower} ''RedisConnecti data RedisEndpoint = RedisEndpoint { _host :: !Text, _port :: !Word16, - _connectionMode :: !RedisConnectionMode + _connectionMode :: !RedisConnectionMode, + _enableTls :: !Bool, + -- | When not specified, use system CA bundle + _tlsCa :: !(Maybe FilePath), + -- | When 'True', uses TLS but does not verify hostname or CA or validity of + -- the cert. Not recommended to set to 'True'. + _insecureSkipVerifyTls :: !Bool } deriving (Show, Generic) diff --git a/services/gundeck/test/integration/API.hs b/services/gundeck/test/integration/API.hs index a91a075ac00..ffc11bd7b80 100644 --- a/services/gundeck/test/integration/API.hs +++ b/services/gundeck/test/integration/API.hs @@ -410,12 +410,18 @@ storeNotificationsEvenWhenRedisIsDown = do origRedisEndpoint <- view $ tsOpts . redis let proxyPort = 10112 redisProxyServer <- liftIO . async $ runRedisProxy (origRedisEndpoint ^. O.host) (origRedisEndpoint ^. O.port) proxyPort - withSettingsOverrides (redis .~ RedisEndpoint "localhost" proxyPort (origRedisEndpoint ^. connectionMode)) $ do - let pload = textPayload "hello" - push = buildPush ally [(ally, RecipientClientsAll)] pload - gu <- view tsGundeck - liftIO $ Async.cancel redisProxyServer - post (runGundeckR gu . path "i/push/v2" . json [push]) !!! const 200 === statusCode + withSettingsOverrides + ( \gundeckSettings -> + gundeckSettings + & redis . Gundeck.Options.host .~ "localhost" + & redis . Gundeck.Options.port .~ proxyPort + ) + $ do + let pload = textPayload "hello" + push = buildPush ally [(ally, RecipientClientsAll)] pload + gu <- view tsGundeck + liftIO $ Async.cancel redisProxyServer + post (runGundeckR gu . path "i/push/v2" . json [push]) !!! const 200 === statusCode ns <- listNotifications ally Nothing liftIO $ assertEqual ("Expected 1 notification, got: " <> show ns) 1 (length ns) diff --git a/services/integration.yaml b/services/integration.yaml index dbfc516bf87..70b0fe24e3d 100644 --- a/services/integration.yaml +++ b/services/integration.yaml @@ -122,6 +122,8 @@ redis2: host: 127.0.0.1 port: 6379 connectionMode: master + enableTls: false + insecureSkipVerifyTls: false dynamicBackends: dynamic-backend-1: diff --git a/services/nginz/integration-test/conf/nginz/integration-ca-key.pem b/services/nginz/integration-test/conf/nginz/integration-ca-key.pem index 0bd38214cc7..9dd119c5214 100644 --- a/services/nginz/integration-test/conf/nginz/integration-ca-key.pem +++ b/services/nginz/integration-test/conf/nginz/integration-ca-key.pem @@ -1,27 +1,27 @@ -----BEGIN RSA PRIVATE KEY----- -MIIEogIBAAKCAQEAlq2bCpvwVptvslD3Xq/tAjm58wQHGEpVSyefl+vGQAD30ukV -FiqzjJw9ZCTbS1to2k7YTukabQAu4pHlhHk4/r2JHr7olmUf5zjyKvJUBekFl788 -ZXW9lEOw5x7lgBLSYI20sSHbUVX7pC2dB2AQZt15sGF1DmVU39/yF2RII92bnqPY -r8tS7A6JslhHLnPAnCOaHC4VK6tMU3Zjh/p/sBgKBqbarXAPl2TckXxFEHK8l0lD -yU2a5ltK0YuAxOv4iXwK76G4VQJwbF0NCMzjAovBLcOA7BVRd8ywVjFpzQjhn+gy -yATdZUOlOpMXIEa7Hmc5TMB4KjiJYwocjKl66QIDAQABAoIBAFYPolZU6tkMvqdi -h2eVpBF5VzPuQP8mtcDPSOBE0l8MLoBQkLKwgQz20Dm6s2Y/N4w5LGMl0OohCKZw -Hl+jvWICb6cX81CzQZ2XcPoGnuchSQh7OcvZjAZ7Azd+9iZImdB8H5Bsfg/exHPp -eZ8Ux0l5hl+vymQGjIuyJVwm8u1IbZbW3+yTJ/oFqa/j91Yw7Llsa7VaLs+NiJkY -Ng7AtAd/zz6BN4x93AMCbs6KgLQcKK1WyIkCqoUsZG5orzIKlpmBnmv4EeQwvem9 -/rt3LlKFzHXBPG47BECQsyPYli1Z3Gnp/XTNMteeqDicj4CI9icU1QRxTyUmIMFB -Wd81qAECgYEAxClEt4tteo1kPuiiajHSR1PApPG40Zlc9GovQl/JQnr+MSaexD/M -gMtZlhQYrdThmGYcdzmpWaS5YCKesB82ca3QwaJK3+q3/MclvNt7hoIQoWm53eAK -J4CabtUiyzmG1iaYulEkqFtlg8nK0SwFNr8UEGHyerSHFtTiUXw47mECgYEAxKRy -1Z16pcesupUXzdET6ZdwN70oJT+3D+s98ZBtn2pBW7RQKEe9pvlbTrClTkFxUhXu -jPyNama8KvON57ekgb3nanlyp2sX8AtydEb+BZtRDp3PMF+J6nl828Mt2LHtivul -iacBM4dCM3IsEXMvlJElxm0ILgAUb9LqKl6giYkCgYAbqNoIq39XbYJ6IGFuafIF -nrimSXNPErn5uNNLH6iIWEFpetGeSIS0kHfkYpcMQ90/mP5gjV/kxQZimN8ZZH1P -0DuEYjb+leE1onsewzAKymI/8GGF+KZV5ZthD2qlj0oE/lJAy1pI5wJMb/LKRdPC -YXUZzkXbqYL25DO5W7PHYQKBgFz/9XuHziCnjc50gtyJPGSmhaEm6dysBJUXyaT8 -jIvvgdewMJTMUSquFfviWVvoYYLT8o1lSDCBRA8APyXO2ZOuz8qwg4QghyK1Fz1c -8fiO20gRZJLZLG3jZSS+a2lnxRONLl4qyMuo9atFHQhntKIL/5SXrl2rFf9I/gxp -0n0ZAoGAf3Om0O1td3EfemGzJs3YJOKiwltDZNtwF5G4VG9c9YjlevaLJoNhgBw9 -u16e/mQNU/yr/qqRp+aE6HGcXXBp0ckJcKqKFQ2pUVhMb/T8OfPpT2n7RF1k0Xss -5vrEUSfif9VPCEnjMI7AtZcXQT1yqMQuTW+IhP15dGuofWdDsHQ= +MIIEpQIBAAKCAQEAxeJTpuiFhgbFAA0KI37Re6nhKd8UcuXZ3SKgBlxej+kRs6hr +xA/6i8LM3YhhTHuw5n3R/DJlP3Vz2Df77/PdATadJmyaye50wpRpGfkQqRvQIRJ8 +pHd9oyO8O6Jdmbtg4gYTdd2nIcqzofM1PPxSzVl71T5TXrOOML6HXY5nFh0jsZfi +upHhT0Zlz5u7qidtz+AhvW3oJPjhjTbRIxsVvVO7i6RljrsBu6JH4lrYgsf1/lQT +JSNLqVcdt4lWY7hFmL4n3U7sw8T8wKOCTb5Erzh3xS/4+sxXSxnGRNWeGAoflAa3 +RrZeE3UQwTrBwMog0xJ9v+f90OZI+qpZriPaFwIDAQABAoIBAQC+aTgBRYEmJGFv +2RxGZ4N/sUm+lrAAl3f6N5UwSbWcWLL14zw/XvjBf2LOUKr/g44HXE6wlHWkiIo+ +JjDBBjFFN54kGSEg6dlkWpZ/rZAAiYjOKhHR2EEGuB4qa+QRR6LEGwCiy/REqd4M +GhDCbDHo8xAbc2uZlsFd2hg7SAmd1h8AIstvhPiq7KBB4mVMT1l0LikXNetT9H2z +teYpbd8OEYO5i6+77SrMZE7WNudtdaFzUbR90Y5qLLdSH3M2Tj/2tJW883RGWwGW +RJE65HkPSsKlyI9+KO+k+z7hAxMbBUQ4/5q1eBAd2Q49NUcGpNGWCZzO2t8yYzlQ +m+FsYD3BAoGBAOXg8GW470g0NBly6BSmxGRu0PG2zsvvegV4Ts4GbY87r4WbYR+4 +oH3cv/Jz6Ta0UIN2/l2KCZ1r2nu1J8iLNVNilfTADvNh8krb3mpbi/rm/we2ECQ2 +F0jU4kyU/IQrPx8xhQq31+a6SK1ZiVtFxFbgXUkXHKR2OuK1jWEAjbYHAoGBANxe +rj67gGqVlwfqu5iZYfUwaXD45XWGyrFHCu62MyNClDNs6oTVS8+KnNJv/M8unZQf +BoBSpW6Sdrlpt2xbG5LykG30WYUHk0DZA1HN4aJiusPzT9d4FikTgJqLHi9wnpwj +dIOsse9pkaoOMwLP5jJpZQC6dmqBJt/WGv1/7TdxAoGAUojChyMw9jGYCxMQdGmz +1YNcDYzfDqV6oAAj+yCfsW9yg3vYETWOmeHqILixIOz4g1rz1M28ygJxPT07fWtN +yBR7VpamR4gBIBN09abMyVaqdjBN91JcZc/ZODm9uA526VI0PDbpk3OKqIKfKGAS +MEb590YPCJVSaxdYHV2/g30CgYEAhhE4EsRB4RY290MQdEtEdEXKsEdMWg7yO54M +AaRpQhdcUFj/6GZXo+EhfUlSVb13csjZTLJ7IOUMQ8sUI2DeSq01vx88Yxlzta0R +PvBxSDimhVX+igjt+nl58QuYBqaOaFGNrhofepcQXpQa5qgS1TKXlzTZm/wM6Xq5 +muX8LJECgYEA0R74AEICRa6l1QJkN5S1bG7vKkHQuUxSVJFbnS7z/4iVvCpYe+Eb +iapDLWzKPW7zDfuxXWo/9XXCRIWk3Xl8xEhps9ON+/9Zrq4L43KuIZgntfJiLUhZ +qhzT7GJxopDHe/FB932JGaF2ZKPg+vXO1t4x6VXdi1GAETFPqlSI+QQ= -----END RSA PRIVATE KEY----- diff --git a/services/nginz/integration-test/conf/nginz/integration-ca.pem b/services/nginz/integration-test/conf/nginz/integration-ca.pem index 10a906c111b..df568861a0e 100644 --- a/services/nginz/integration-test/conf/nginz/integration-ca.pem +++ b/services/nginz/integration-test/conf/nginz/integration-ca.pem @@ -1,19 +1,19 @@ -----BEGIN CERTIFICATE----- -MIIDAjCCAeqgAwIBAgIUdsGG4S0KMPKYzS6UNoDuNpvkRFcwDQYJKoZIhvcNAQEL -BQAwGTEXMBUGA1UEAxMOY2EuZXhhbXBsZS5jb20wHhcNMjQwNDIyMTIwNDAwWhcN -MjkwNDIxMTIwNDAwWjAZMRcwFQYDVQQDEw5jYS5leGFtcGxlLmNvbTCCASIwDQYJ -KoZIhvcNAQEBBQADggEPADCCAQoCggEBAJatmwqb8Fabb7JQ916v7QI5ufMEBxhK -VUsnn5frxkAA99LpFRYqs4ycPWQk20tbaNpO2E7pGm0ALuKR5YR5OP69iR6+6JZl -H+c48iryVAXpBZe/PGV1vZRDsOce5YAS0mCNtLEh21FV+6QtnQdgEGbdebBhdQ5l -VN/f8hdkSCPdm56j2K/LUuwOibJYRy5zwJwjmhwuFSurTFN2Y4f6f7AYCgam2q1w -D5dk3JF8RRByvJdJQ8lNmuZbStGLgMTr+Il8Cu+huFUCcGxdDQjM4wKLwS3DgOwV -UXfMsFYxac0I4Z/oMsgE3WVDpTqTFyBGux5nOUzAeCo4iWMKHIypeukCAwEAAaNC -MEAwDgYDVR0PAQH/BAQDAgEGMA8GA1UdEwEB/wQFMAMBAf8wHQYDVR0OBBYEFDnH -CL3yIYkqK51ynDHRQcc6Xc/rMA0GCSqGSIb3DQEBCwUAA4IBAQCUzI4edToGsBTp -qnV2MtXwhoBFnmAa4O8RMsbRZqE+DCzBhPSIl9UMaeIEMoIvXL2KOO+rEw2M1uQc -D4r+dAdUhLbIFEyMNIA5EZfJfimEE0qaLGJqI5X1FFVeCvlvI1UDoSj0KQD9GEsg -VidDnhzg712cGdBY2K4U/BmpLMn8+WZ7+TSVIX8fGylzDCRtCQ36vrD5pkQzblqU -sjO8Apwej/t+BI/Y+T1MFvZhstbJ3mSQpHhnmARXLOrwjcOmLzWVlQa1IJxtxaf9 -gRxVchzH7fQxNlR6/zWtd2av07pFR9k2o9WUn/A5lpoUcVrokvCsOooqqG3UwALU -fZm6IO1I +MIIDAjCCAeqgAwIBAgIUBYyNbkD7QQIo+K40IXL+UuYmaEMwDQYJKoZIhvcNAQEL +BQAwGTEXMBUGA1UEAxMOY2EuZXhhbXBsZS5jb20wHhcNMjQwNDI5MTI0NjAwWhcN +MjkwNDI4MTI0NjAwWjAZMRcwFQYDVQQDEw5jYS5leGFtcGxlLmNvbTCCASIwDQYJ +KoZIhvcNAQEBBQADggEPADCCAQoCggEBAMXiU6bohYYGxQANCiN+0Xup4SnfFHLl +2d0ioAZcXo/pEbOoa8QP+ovCzN2IYUx7sOZ90fwyZT91c9g3++/z3QE2nSZsmsnu +dMKUaRn5EKkb0CESfKR3faMjvDuiXZm7YOIGE3XdpyHKs6HzNTz8Us1Ze9U+U16z +jjC+h12OZxYdI7GX4rqR4U9GZc+bu6onbc/gIb1t6CT44Y020SMbFb1Tu4ukZY67 +AbuiR+Ja2ILH9f5UEyUjS6lXHbeJVmO4RZi+J91O7MPE/MCjgk2+RK84d8Uv+PrM +V0sZxkTVnhgKH5QGt0a2XhN1EME6wcDKINMSfb/n/dDmSPqqWa4j2hcCAwEAAaNC +MEAwDgYDVR0PAQH/BAQDAgEGMA8GA1UdEwEB/wQFMAMBAf8wHQYDVR0OBBYEFAg4 +MuTnP5GWVyzC1y/L0dIti5y8MA0GCSqGSIb3DQEBCwUAA4IBAQBledBrBHZ10aUW +yxY/5Gj/pXiiZoyeTF3esxFUM6cGEyXpetk7SWAmIkVp2q+7uO9r94D8umXGZJhQ +nOPkNlWggrSeDy5U5akdhiOrLt+r4bZPKdNLLeiJKd94vqS9Opq51YBq4FC/8MxK +fRf6/zPjMMqZjKudlFniwxeg6CHghMqERzL66EZF29/hb1O8AFGC+J5WioA5+Cbj +se9k2mWbm+F7BjMUW4n4Fz2YR3SGtSZ4h8vzTsBmLSn4GsmLuoHZ1ccSDY/WoNDs +sSyEAr4dGN+e4pV5Uyu5h5bg/BZt86w8psbK5Z0dxTrmSC74E/hKF9JNwxK4iuV+ +4RaUWHE2 -----END CERTIFICATE----- diff --git a/services/nginz/integration-test/conf/nginz/integration-leaf-key.pem b/services/nginz/integration-test/conf/nginz/integration-leaf-key.pem index 1a45ba1ea46..a429e5651d5 100644 --- a/services/nginz/integration-test/conf/nginz/integration-leaf-key.pem +++ b/services/nginz/integration-test/conf/nginz/integration-leaf-key.pem @@ -1,27 +1,27 @@ -----BEGIN RSA PRIVATE KEY----- -MIIEowIBAAKCAQEAukRPdjUjKs7P2TgP4VDpb77Rb7KjMMBtcRP525qEnUQzFHPk -Va4cqh6xacgh2NJCyFyDEWDI9pQ03i0HISIldoBngDVvM6kwvbs+kjZ+/t/Jx3aH -zC9dmsLqmCqU+OmofpD1pt8hZWwOtYj58pfqdhrP+M6qQ92/tgmkk9njLFwsAjxY -gMXZCo0IiSIE9BE9NGvR9bp6hvEekCqREPdHi44iFca/5V4A8fSZwBlTHod5Z83r -MpHLnR1ReVVOQgzbIBGcLdmtH8IA9ZgUHy1/HOmf9e0MYOYOKbKvH3cry7WSscPL -47x+JQyFLimidfsJQCY+022rdPg9CdrCWFGxgQIDAQABAoIBAGjeBqK1fewe7XQN -FRu0cwh/tOge+bN70uHj7jrN/rWP7PYp3TbDxM2eZCH7E9s/XWvycbQ5+kqg3Dbt -wOLNl6vk1OCgtM+wBIn9PlgRKGSUV8Tdncy+KgP0kyFCcAbHfh5rvHHLk8DHGmzo -BlinYNBHfilFKST2VnXFbgvzkuuorS1BRAzlVpyJnaen04emBJ+KPIwNyguPQrlv -5duBIO1bzlEjFVufrLkI0IumWqBAPOvHcRy1geSz/MG7LssB9r25k5LA5OEDxqwx -ykSzuniaLL6BGMSCAMpTM3/hF1ijrkTd74cI4cp7k2ufcYT74ZU2lyDKEjBukG/p -H0/1Q8ECgYEAwL7VWIpySGtrJEPZH1FxtpJYg8SE0F4lUxIbIQcc6rzLJfLOLQO5 -ruTVONPTlue6PHrRO8pQTbW9AnjZvHMIiwxidY/RwUVKFuxzfrYZ9ZbKXyVOh48a -WXe5OnpuVodPEHQrKzkl93YWMgMCXNPri1h0jr0fMGXy9jZzoKK5f1kCgYEA92Uw -P4WyBL2hm/5BNUoxCiLyd1dDdQt1h6VByxYM7OXDhXq1iHnhX+NbjMT0QfOFyXBP -uQQCB9IQElmMmWsoEv6uEQCeuCvOxq+Evoz+3fP2te89HjZ1C5SXUMfG7qKfFzbt -WP6e/CqAeQPnnqI89ghw/IerQkeVMoVvHbSXZmkCgYBZPgJ6JGAVt+a7u85j+cm0 -xr3FBNCZyX1uoQt+l1SEOzW0NF/R58+pcrpmvW1SiahpKFSIYnwb/vGsm1f1MS3b -c7iCxjxQSEytoH05Rgdu9ops01Ew4slIc26H7Pf5iFzLOX5jXOp/UWWlck89u8Fr -m2EcVeSC/DEqXrvavH02wQKBgBzVKDhfBo5S44DgswzY5ro9tHCANRZxDXOPqQlY -Oo1pgc4OrRWIzuF0B/lyAt2k2hTOCBySAQKUUtcwpJhEytjb4cGNhvID+Qdi8V+b -4yBPDJPLnB3nTuDYooIBpoetYEk+V48lrbXJ5ks0T0xHsD8kYLatwSHqYdMPhhG6 -OGLxAoGBALZQSuO4fHew4ksMcBy891ZSOFUV9xAtR490EdEQdOiPrQj5vmnSpxEx -QsSVbn+49OYwzjBP+sHtpiTMF4ZlafHvjcNZ5dFIImqyuEugEdnD5UnFd92AQ9Gv -ufa7BMs99BRdkkolCXBZC+Dq4t4Z/+MDSMtjO5mh9V0boDakdJPb +MIIEowIBAAKCAQEAmSV2VmlVfsqBNCk/EoW9aN71BGRgVhF+zTojHf/DgPv94jH5 +/IjpNa5yfmT5M0invDwGJQOI3z3sz8kOdg7FvZtrhcyHACDl337gwRPy28hWELbj +IjmBOE73ck5B0dYAsqFnwxpDiepqfHlou+oL5osTerI93pN9IALjYpTZuhK+BPeZ +zlzNLk6VbVqQhd3aaVOJg7VVWPZkCdTRwP10ijPJQVgG42uM3X9BXhYmZk0yN+4M +MNKQ+P+jTL3PguqS9DKC3ObN6OvfOsuZGZaFjVtHnwW4NtiRB1E2nbcK3wgE7r9L +pgW4LSw86gQxhHcMQi1GxnWy1yUg9DJAcQkGwwIDAQABAoIBADc2HUqb4Pm78gan +FBkOZDHJp5W0xlJhLlC4s+5dxdLbhjUlBVX42fLDeH1+06ScffRLw39WneK1xYlH +l9ISE1H/FS2Ahe8S7Sy85jRVh8mamQSfmpU9HAv71BO+iNYoi8najLj24AB5pXhI +oOyWPUIZQ6WJWurCS2rd/7ILrc754gjEmPayiGXdvJhgOcjDzK65XhzTcaoocNRV +Z9/48udPFvhYKqIaHxQU/XIVwTxDQgmMnY08t7DNwRygknWFXsMxbHnIh6QztVM9 +KrFo4lXt2CgIp/vGe588iihD2QAoyhJGdc09n0dPBOY1F7djEnR4mwVg2wuGiiMJ +jTnD37ECgYEAxYaanwd6H62xlpuzktpd/cy8tJvRcSljkP//Ks53yI3jmWoyM+dx +DKarQIVRch0sIHYKV4oxvtoHAgHTTIMhldY5xTnqvvJXv66fCh3ZLcyXxfuPqK+k +7uZ+mYgvK6McB5AT3xiHTNcW6DD1706xt3ZdzqsjY3bydXjdNtEEHekCgYEAxnuV +JABIw8DXkJIr73RU8zgBu2402Ho52NOoHvaWU5908nzTQBnt5c/1lhaMN7Q07UGS +166ncRkjGrpWH+aS4t5TEMALT0LoZ0l9YMP8qmeks46Vg8BMI06ORcnC2CigeklZ +7sWPiHYvM+w1Rsm/X6hmmiPLvq4jl1KCUIEud8sCgYA4GhEUlhUTpkvIURTh4u/L +RDlcutzz3SOQbYVV7SqMZfB9BHKZ12R+iWAehT8qwCpmVeB+GJwkbtyKr2YKVzxU +yHHEGL0Z2s8dfEVjpDKpFXEOJHMbIDgiOok+pjVvmXY+l6dtOBRFuNmivTU88Qb8 +6rueFXGJsKEQyHFcPmWC8QKBgCY+odoyA9NUUTUWNUkKjWPgItVOwvgDdSoGfpqY +wRaT3yDqVHpBhMmHbLbi2VnSa3Bb9kOA79qnEVCRHw8+iocUd8T+fC9loQpl6ra+ +jOz404+VpdGhOAqFlHx2CAlGqsVlZOLRRnrw6t+CYDGnpix0cnC4/QVc4JbD20BP +4/hJAoGBAI7qa8SEcucrq28c8/mUmi+45AkCOZmmPtp31TtFoSlwkTBmAtp4+OSk +76mH5vb2kwJDWgzlmb6nPry8wPFfKQbG4NlBLbovQyc2lJtPGNOSrwboZSIcyClx +lcmE9AcCOuCBhqH18z0nE7nPQXy4IHjHBta7zEJCw+pGxCJh42ke -----END RSA PRIVATE KEY----- diff --git a/services/nginz/integration-test/conf/nginz/integration-leaf.pem b/services/nginz/integration-test/conf/nginz/integration-leaf.pem index 2247758aafd..cb0b495b92a 100644 --- a/services/nginz/integration-test/conf/nginz/integration-leaf.pem +++ b/services/nginz/integration-test/conf/nginz/integration-leaf.pem @@ -1,21 +1,21 @@ -----BEGIN CERTIFICATE----- -MIIDcjCCAlqgAwIBAgIUK9Dix5VZpBYOby63cdmjtfg6RpwwDQYJKoZIhvcNAQEL -BQAwGTEXMBUGA1UEAxMOY2EuZXhhbXBsZS5jb20wHhcNMjQwNDIyMTIwNDAwWhcN -MjUwNDIyMTIwNDAwWjAAMIIBIjANBgkqhkiG9w0BAQEFAAOCAQ8AMIIBCgKCAQEA -ukRPdjUjKs7P2TgP4VDpb77Rb7KjMMBtcRP525qEnUQzFHPkVa4cqh6xacgh2NJC -yFyDEWDI9pQ03i0HISIldoBngDVvM6kwvbs+kjZ+/t/Jx3aHzC9dmsLqmCqU+Omo -fpD1pt8hZWwOtYj58pfqdhrP+M6qQ92/tgmkk9njLFwsAjxYgMXZCo0IiSIE9BE9 -NGvR9bp6hvEekCqREPdHi44iFca/5V4A8fSZwBlTHod5Z83rMpHLnR1ReVVOQgzb -IBGcLdmtH8IA9ZgUHy1/HOmf9e0MYOYOKbKvH3cry7WSscPL47x+JQyFLimidfsJ -QCY+022rdPg9CdrCWFGxgQIDAQABo4HKMIHHMA4GA1UdDwEB/wQEAwIFoDAdBgNV +MIIDcjCCAlqgAwIBAgIUf1Euc5flsS90XTspZ7RXONZm8DgwDQYJKoZIhvcNAQEL +BQAwGTEXMBUGA1UEAxMOY2EuZXhhbXBsZS5jb20wHhcNMjQwNDI5MTI0NjAwWhcN +MjUwNDI5MTI0NjAwWjAAMIIBIjANBgkqhkiG9w0BAQEFAAOCAQ8AMIIBCgKCAQEA +mSV2VmlVfsqBNCk/EoW9aN71BGRgVhF+zTojHf/DgPv94jH5/IjpNa5yfmT5M0in +vDwGJQOI3z3sz8kOdg7FvZtrhcyHACDl337gwRPy28hWELbjIjmBOE73ck5B0dYA +sqFnwxpDiepqfHlou+oL5osTerI93pN9IALjYpTZuhK+BPeZzlzNLk6VbVqQhd3a +aVOJg7VVWPZkCdTRwP10ijPJQVgG42uM3X9BXhYmZk0yN+4MMNKQ+P+jTL3PguqS +9DKC3ObN6OvfOsuZGZaFjVtHnwW4NtiRB1E2nbcK3wgE7r9LpgW4LSw86gQxhHcM +Qi1GxnWy1yUg9DJAcQkGwwIDAQABo4HKMIHHMA4GA1UdDwEB/wQEAwIFoDAdBgNV HSUEFjAUBggrBgEFBQcDAQYIKwYBBQUHAwIwDAYDVR0TAQH/BAIwADAdBgNVHQ4E -FgQUaJdzHC5JsdIEKTYxqAWoSHvFCNgwHwYDVR0jBBgwFoAUOccIvfIhiSornXKc -MdFBxzpdz+swSAYDVR0RAQH/BD4wPIIZKi5pbnRlZ3JhdGlvbi5leGFtcGxlLmNv +FgQUv8i5VPBWRk+7SbQoK3bsYK4VwncwHwYDVR0jBBgwFoAUCDgy5Oc/kZZXLMLX +L8vR0i2LnLwwSAYDVR0RAQH/BD4wPIIZKi5pbnRlZ3JhdGlvbi5leGFtcGxlLmNv bYIUaG9zdC5kb2NrZXIuaW50ZXJuYWyCCWxvY2FsaG9zdDANBgkqhkiG9w0BAQsF -AAOCAQEAcoUcdwgoAiFJcoS/t1IU2axEJeWncctYyVHt/ZfoZ8y/23XDA+kIfgSt -DZEqteGyVDSBbI/B45IzrKQuJzdT8B+9iDcOzLrA2R1432ASlMhHC5l3STBru0jl -oL9M8fJU6BwciCqY0Y2wFcCfVthN1rC8vNNSpwSwF74q87MMLZ/65Mi3hAB4177s -uNL6MXGta9fBK9MQxM3S/Kr7fmxOTQBlQtcA2Ha3Yog2+dkMXosoapjoMwWj36DS -j9v25/dFmS3dnCfhRHBSh9iUSnbOVZ/M+5Bv5hBPYbeSw24DXD1w9soEYL941D+c -enXV719UPw5bpBxhXjl9Hu0TQ2uoIw== +AAOCAQEAamTOVMoIb6s+q2IT/zgR/UbkRFlTAsGo7mPIgfgC0D8FkJgLJwYA3uz1 +ZEQ0XRbnmsFFeTdPYya4TOz1E0ZsA4tgK0DOJgPTRfP+DOiplFMDPCrgHPkHQGOd +LDSzQv+GrlSuYUuFxLFXXYZwWzxg5Tv0UgcL+i1wkVBSkwsUvtUkKqqOAjG1cZpI +Mc4VtMAYh5NaBb7KfCo47srRMQfg1SKiGmG65LRUJHGHoVc5PNohz/sbfef/WC0W +haih/68v9qVF/8Xmvy+XKUk5t4mHwpxu1foPCBdMDAU1Udk39VZmYNBbycp+2dt6 +BOe3K9zXlCS8KnJOVLoe9nxsWOAsgA== -----END CERTIFICATE----- From 478d218b1e15e494d77e8d89989cf03f6b3ac9fb Mon Sep 17 00:00:00 2001 From: Mango The Fourth <40720523+MangoIV@users.noreply.github.com> Date: Tue, 28 May 2024 12:02:37 +0200 Subject: [PATCH 08/64] [fix] fix sbom generation as deptrack now does validation (#4066) --- hack/bin/Sbom.hs | 51 ++++++++++++++++++++++++++++------------------ hack/bin/bombon.hs | 2 +- 2 files changed, 32 insertions(+), 21 deletions(-) diff --git a/hack/bin/Sbom.hs b/hack/bin/Sbom.hs index 74a1783a3a4..5f8ae69abf6 100644 --- a/hack/bin/Sbom.hs +++ b/hack/bin/Sbom.hs @@ -51,6 +51,7 @@ how this relates to bombon: module Sbom where +import Control.Applicative ((<|>)) import Control.Arrow ((&&&)) import Data.Aeson import Data.Aeson.Key qualified as KM @@ -73,6 +74,7 @@ import Data.Text (Text) import Data.Text qualified as T import Data.Text.IO qualified as T import Data.Time.Clock.POSIX +import Data.Time.Format.ISO8601 (iso8601Show) import Data.Traversable (for) import Data.Tree import Data.UUID qualified as UUID @@ -206,13 +208,21 @@ serializeSBom settings bom = do curTime <- getCurrentTime -- FUTUREWORK(mangoiv): "tools" (the tools used in the creation of the bom) let mkDependencies :: SBomMeta Identity -> Array - mkDependencies meta = do - let d = - object - [ "ref" .= meta.outPath, - "dependsOn" .= runIdentity meta.directDeps - ] - [d] + mkDependencies meta = + [ object + [ "ref" .= meta.outPath, + "dependsOn" .= runIdentity meta.directDeps + ] + ] + + serializeLicense :: Maybe License -> Maybe Value + serializeLicense ml = do + l <- ml + idOrName <- + (\i -> ["id" .= i]) <$> l.id + <|> (\n -> ["name" .= n]) <$> l.name + pure (object idOrName) + mkComponents :: SBomMeta Identity -> Array mkComponents meta = do let c :: Value @@ -220,17 +230,18 @@ serializeSBom settings bom = do -- FUTUREWORK(mangoiv): swid? https://www.iso.org/standard/65666.html -- FUTUREWORK(mangoiv): CPE? -- FUTUREWORK(mangoiv): more information in the supplier section - object - [ "type" .= meta.typ, - "bom-ref" .= String (runIdentity meta.outPath), - "supplier" .= object ["url" .= nubOrd (maybeToList meta.homepage <> catMaybes meta.urls)], - "name" .= String (fromMaybe (st'name $ splitStorePath $ runIdentity meta.outPath) meta.name), - "version" .= meta.version, - "description" .= meta.description, - "scope" .= String "required", - "licenses" .= ((\ln -> object ["license" .= ln]) <$> filter (isJust . (>>= (.id))) meta.licenseSpdxId), - "purl" .= mkPurl meta - ] + Object $ + mconcat + [ "type" .= String (fromMaybe "library" meta.typ), + "bom-ref" .= String (runIdentity meta.outPath), + "supplier" .= object ["url" .= nubOrd (maybeToList meta.homepage <> catMaybes meta.urls)], + "name" .= String (fromMaybe (st'name $ splitStorePath $ runIdentity meta.outPath) meta.name), + "version" .?= meta.version, + "description" .?= meta.description, + "scope" .= String "required", + "licenses" .= ((\ln -> object ["license" .= ln]) <$> mapMaybe serializeLicense meta.licenseSpdxId), + "purl" .= mkPurl meta + ] [c] (dependencies, components) = foldMap (mkDependencies &&& mkComponents) bom @@ -243,7 +254,7 @@ serializeSBom settings bom = do "version" .= Number (fromIntegral settings.sbom'version), "metadata" .= object - [ "timestamp" .= String (T.pack (show curTime)), + [ "timestamp" .= String (T.pack (iso8601Show curTime)), "component" .= object [ "name" .= String settings.sbom'component, @@ -253,7 +264,7 @@ serializeSBom settings bom = do -- FUTUREWORK(mangoiv): "manufacture" can also have url "manufacture" .= object ["name" .= String settings.sbom'manufacture], "supplier" .= object ["name" .= String (fromMaybe settings.sbom'manufacture settings.sbom'supplier)], - "licenses" .= Array (fromList $ object . (\n -> ["id" .= n]) . String <$> settings.sbom'licenses) + "licenses" .= Array (fromList $ (\n -> object ["license" .= object ["id" .= String n]]) <$> settings.sbom'licenses) ], "components" .= Array components, -- FUTUREWORK(mangoiv): services: allow to tell the program the name of the services like brig, galley, ... diff --git a/hack/bin/bombon.hs b/hack/bin/bombon.hs index d4bc7fdec0b..ec716202539 100755 --- a/hack/bin/bombon.hs +++ b/hack/bin/bombon.hs @@ -1,4 +1,4 @@ -#!/usr/bin/env -S nix -Lv run github:wireapp/ghc-flakr/6311bb166bf835d4a587fe1661b86c9a1426f212 +#!/usr/bin/env -S nix -Lv run github:wireapp/ghc-flakr/74d6dd639d1da35a8d361e8cd2274b1cfbe8381c {-# LANGUAGE DataKinds #-} {-# LANGUAGE LambdaCase #-} {-# OPTIONS_GHC -Wall #-} From 39a35d311775f6e50815bad37ea3b8acea324631 Mon Sep 17 00:00:00 2001 From: Marco Date: Tue, 28 May 2024 17:46:21 +0200 Subject: [PATCH 09/64] [docs] clarify the behaviour of search by exact handle (#4068) * [docs] clarify the behaviour of search by exact handle * Update docs/src/understand/searchability.md Co-authored-by: Igor Ranieri Elland <54423+elland@users.noreply.github.com> --------- Co-authored-by: Igor Ranieri Elland <54423+elland@users.noreply.github.com> --- docs/src/understand/searchability.md | 10 ++++++---- 1 file changed, 6 insertions(+), 4 deletions(-) diff --git a/docs/src/understand/searchability.md b/docs/src/understand/searchability.md index b1608e0d6a1..b1727b3324a 100644 --- a/docs/src/understand/searchability.md +++ b/docs/src/understand/searchability.md @@ -25,22 +25,24 @@ Search visibility is controlled by three parameters on the backend: - A team out-bound configuration flag, `TeamSearchVisibility` with possible values `SearchVisibilityStandard`, `SearchVisibilityNoNameOutsideTeam` - `SearchVisibilityStandard` means that the user can find other people outside of the team, if the searched-person inbound search allows it - - `SearchVisibilityNoNameOutsideTeam` means that the user can not find any user outside the team by full text search (but exact handle search still works) + - `SearchVisibilityNoNameOutsideTeam` means that the user can’t find any user outside the team by full text search (but exact username search still works) - A team inbound configuration flag, `SearchVisibilityInbound` with possible values `SearchableByOwnTeam`, `SearchableByAllTeams` - - `SearchableByOwnTeam` means that the user can be found only by users in their own team. - - `SearchableByAllTeams` means that the user can be found by users in any/all teams. + - `SearchableByOwnTeam` means that the user can be found with full text search only by users in their own team + - `SearchableByAllTeams` means that the user can be found with full text search by all users in any/all teams. - A server configuration flag `searchSameTeamOnly` with possible values true, false. - `Note`: For the same backend, this affects inbound and out-bound searches (simply because all teams will be subject to this behavior) - - Setting this to `true` means that the all teams on that backend can only find users that belong to their team + - Setting this to `true` means that all teams on that backend can only find users that belong to their team These flag are set on the backend and the clients do not need to be aware of them. The flags will influence the behavior of the search API endpoint; clients will only need to parse the results, that are already filtered for them by the backend. +Some configuration values supersede others. The table below clarifies how the various values interact with each other, highlighting the outcome of each search for the various combinations of values. + ### Table of possible outcomes ```{eval-rst} From 971947053db46b8bebe3951890b4a4353fbcb14d Mon Sep 17 00:00:00 2001 From: Mango The Fourth <40720523+MangoIV@users.noreply.github.com> Date: Wed, 29 May 2024 10:57:23 +0200 Subject: [PATCH 10/64] [feat] add more metadata in nix to own code (#4069) * [feat] add more metadata in nix to own code --- changelog.d/5-internal/more-metadata-in-meta | 1 + nix/wire-server.nix | 22 ++++++++++++++++---- 2 files changed, 19 insertions(+), 4 deletions(-) create mode 100644 changelog.d/5-internal/more-metadata-in-meta diff --git a/changelog.d/5-internal/more-metadata-in-meta b/changelog.d/5-internal/more-metadata-in-meta new file mode 100644 index 00000000000..b6085a69987 --- /dev/null +++ b/changelog.d/5-internal/more-metadata-in-meta @@ -0,0 +1 @@ +add more metadata into the meta attribute of all nix derivations produced locally diff --git a/nix/wire-server.nix b/nix/wire-server.nix index eca106680b7..2f1dd00c854 100644 --- a/nix/wire-server.nix +++ b/nix/wire-server.nix @@ -101,9 +101,7 @@ let # on. let defaultPkgs = import ./local-haskell-packages.nix - { - inherit gitignoreSource; - } + { inherit gitignoreSource; } hsuper hself; @@ -130,16 +128,32 @@ let bench = _: drv: hlib.doBenchmark drv; + maintainer = _: drv: + drv.overrideAttrs (old: { + + meta = old.meta or { } // { + homepage = "https://github.com/wireapp"; + maintainers = [{ + name = "wireapp"; + email = "backend@wire.com"; + github = "wireapp"; + githubId = 16047324; + }]; + }; + }); + overrideAll = fn: overrides: - attrsets.mapAttrs fn (overrides); + attrsets.mapAttrs fn overrides; in lib.lists.foldr overrideAll defaultPkgs [ + maintainer werror opt docs tests bench ]; + manualOverrides = import ./manual-overrides.nix (with pkgs; { inherit hlib libsodium protobuf mls-test-cli fetchpatch pkgs; }); From cde14a919e8fbf5708d07d3e082a1a453b8ca43d Mon Sep 17 00:00:00 2001 From: Leif Battermann Date: Wed, 29 May 2024 14:09:08 +0200 Subject: [PATCH 11/64] WPB-8824 MLS E2EID CRL proxy flag (#4051) --- cassandra-schema.cql | 2 + changelog.d/2-features/WPB-8824 | 1 + .../src/developer/reference/config-options.md | 6 +++ docs/src/understand/team-feature-settings.md | 6 +++ integration/test/API/GalleyInternal.hs | 8 +++ integration/test/Test/FeatureFlags.hs | 54 +++++++++++++++++++ libs/wire-api/src/Wire/API/Error/Galley.hs | 4 ++ libs/wire-api/src/Wire/API/Routes/Named.hs | 2 + .../Wire/API/Routes/Public/Galley/Feature.hs | 3 +- libs/wire-api/src/Wire/API/Team/Feature.hs | 10 +++- .../golden/Test/Wire/API/Golden/Generated.hs | 3 +- .../API/Golden/Generated/WithStatus_team.hs | 19 +++++++ .../golden/testObject_WithStatus_team_18.json | 2 + .../golden/testObject_WithStatus_team_19.json | 10 ++++ services/galley/galley.cabal | 1 + .../galley/src/Galley/API/Public/Feature.hs | 3 +- .../galley/src/Galley/API/Teams/Features.hs | 13 +++++ .../Cassandra/GetAllTeamFeatureConfigs.hs | 8 ++- .../src/Galley/Cassandra/TeamFeatures.hs | 18 ++++--- services/galley/src/Galley/Schema/Run.hs | 4 +- .../src/Galley/Schema/V92_MlsE2EIdConfig.hs | 31 +++++++++++ 21 files changed, 193 insertions(+), 15 deletions(-) create mode 100644 changelog.d/2-features/WPB-8824 create mode 100644 libs/wire-api/test/golden/testObject_WithStatus_team_19.json create mode 100644 services/galley/src/Galley/Schema/V92_MlsE2EIdConfig.hs diff --git a/cassandra-schema.cql b/cassandra-schema.cql index 06052e52b77..bbeefe5b6e3 100644 --- a/cassandra-schema.cql +++ b/cassandra-schema.cql @@ -1205,9 +1205,11 @@ CREATE TABLE galley_test.team_features ( mls_default_ciphersuite int, mls_default_protocol int, mls_e2eid_acme_discovery_url blob, + mls_e2eid_crl_proxy blob, mls_e2eid_grace_period int, mls_e2eid_lock_status int, mls_e2eid_status int, + mls_e2eid_use_proxy_on_mobile boolean, mls_e2eid_ver_exp timestamp, mls_lock_status int, mls_migration_finalise_regardless_after timestamp, diff --git a/changelog.d/2-features/WPB-8824 b/changelog.d/2-features/WPB-8824 new file mode 100644 index 00000000000..e93a613602f --- /dev/null +++ b/changelog.d/2-features/WPB-8824 @@ -0,0 +1 @@ +Updated the `mlsE2EId` feature config with two additional fields `crlProxy` and `useProxyOnMobile` diff --git a/docs/src/developer/reference/config-options.md b/docs/src/developer/reference/config-options.md index 92075af274c..a46ad32fe5a 100644 --- a/docs/src/developer/reference/config-options.md +++ b/docs/src/developer/reference/config-options.md @@ -315,6 +315,10 @@ When a client first tries to fetch or renew a certificate, they may need to logi The client enrolls using the Automatic Certificate Management Environment (ACME) protocol [RFC 8555](https://www.rfc-editor.org/rfc/rfc8555.html). The `acmeDiscoveryUrl` parameter must be set to the HTTPS URL of the ACME server discovery endpoint for this team. It is of the form "https://acme.{backendDomain}/acme/{provisionerName}/discovery". For example: `https://acme.example.com/acme/provisioner1/discovery`. +`useProxyOnMobile` is an optional field. If `true`, mobile clients should use the CRL proxy. If missing, null or false, mobile clients should not use the CRL proxy. + +`crlProxy` contains the URL to the CRL proxy. (Not that this field is optional in the server config, but mandatory when the team feature is updated via the team feature API.) + ```yaml # galley.yaml mlsE2EId: @@ -323,6 +327,8 @@ mlsE2EId: config: verificationExpiration: 86400 acmeDiscoveryUrl: null + useProxyOnMobile: true + crlProxy: https://example.com lockStatus: unlocked ``` diff --git a/docs/src/understand/team-feature-settings.md b/docs/src/understand/team-feature-settings.md index 0b92daa829a..35e57eb2dcb 100644 --- a/docs/src/understand/team-feature-settings.md +++ b/docs/src/understand/team-feature-settings.md @@ -94,6 +94,10 @@ When a client first tries to fetch or renew a certificate, they may need to logi The client enrolls using the Automatic Certificate Management Environment (ACME) protocol [RFC 8555](https://www.rfc-editor.org/rfc/rfc8555.html). The `acmeDiscoveryUrl` parameter must be set to the HTTPS URL of the ACME server discovery endpoint for this team. It is of the form "https://acme.{backendDomain}/acme/{provisionerName}/discovery". For example: `https://acme.example.com/acme/provisioner1/discovery`. +`useProxyOnMobile` is an optional field. If `true`, mobile clients should use the CRL proxy. If missing, null or false, mobile clients should not use the CRL proxy. + +`crlProxy` contains the URL to the CRL proxy. (Not that this field is optional in the server config, but mandatory when the team feature is updated via the team feature API.) + ```yaml galley: # ... @@ -109,6 +113,8 @@ galley: config: verificationExpiration: 86400 acmeDiscoveryUrl: null + useProxyOnMobile: true + crlProxy: https://example.com lockStatus: unlocked ``` diff --git a/integration/test/API/GalleyInternal.hs b/integration/test/API/GalleyInternal.hs index 281c86e6a18..5da28bbf554 100644 --- a/integration/test/API/GalleyInternal.hs +++ b/integration/test/API/GalleyInternal.hs @@ -101,3 +101,11 @@ generateVerificationCode' domain email = do req <- baseRequest domain Brig Versioned "/verification-code/send" emailStr <- asString email submit "POST" $ req & addJSONObject ["email" .= emailStr, "action" .= "login"] + +setTeamFeatureConfig :: (HasCallStack, MakesValue domain, MakesValue team, MakesValue featureName, MakesValue payload) => Versioned -> domain -> team -> featureName -> payload -> App Response +setTeamFeatureConfig versioned domain team featureName payload = do + tid <- asString team + fn <- asString featureName + p <- make payload + req <- baseRequest domain Galley versioned $ joinHttpPath ["teams", tid, "features", fn] + submit "PUT" $ req & addJSON p diff --git a/integration/test/Test/FeatureFlags.hs b/integration/test/Test/FeatureFlags.hs index 6d68d58845d..4903392f213 100644 --- a/integration/test/Test/FeatureFlags.hs +++ b/integration/test/Test/FeatureFlags.hs @@ -21,6 +21,7 @@ import qualified API.Galley as Public import qualified API.GalleyInternal as Internal import Control.Monad.Codensity (Codensity (runCodensity)) import Control.Monad.Reader +import qualified Data.Aeson as A import SetupHelpers import Testlib.Prelude import Testlib.ResourcePool (acquireResources) @@ -181,3 +182,56 @@ checkFeature feature user tid expected = do bindResponse (Public.getFeatureConfigs user) $ \resp -> do resp.status `shouldMatchInt` 200 resp.json %. feature `shouldMatch` expected + +testMlsE2EConfigCrlProxyRequired :: HasCallStack => App () +testMlsE2EConfigCrlProxyRequired = do + (owner, tid, _) <- createTeam OwnDomain 1 + let configWithoutCrlProxy = + object + [ "config" + .= object + [ "useProxyOnMobile" .= False, + "verificationExpiration" .= A.Number 86400 + ], + "status" .= "enabled" + ] + + -- From API version 6 onwards, the CRL proxy is required, so the request should fail when it's not provided + bindResponse (Internal.setTeamFeatureConfig Versioned owner tid "mlsE2EId" configWithoutCrlProxy) $ \resp -> do + resp.status `shouldMatchInt` 400 + resp.json %. "label" `shouldMatch` "mls-e2eid-missing-crl-proxy" + + configWithCrlProxy <- + configWithoutCrlProxy + & setField "config.useProxyOnMobile" True + & setField "config.crlProxy" "https://crl-proxy.example.com" + & setField "status" "enabled" + + -- The request should succeed when the CRL proxy is provided + bindResponse (Internal.setTeamFeatureConfig Versioned owner tid "mlsE2EId" configWithCrlProxy) $ \resp -> do + resp.status `shouldMatchInt` 200 + + -- Assert that the feature config got updated correctly + expectedResponse <- configWithCrlProxy & setField "lockStatus" "unlocked" & setField "ttl" "unlimited" + checkFeature "mlsE2EId" owner tid expectedResponse + +testMlsE2EConfigCrlProxyNotRequiredInV5 :: HasCallStack => App () +testMlsE2EConfigCrlProxyNotRequiredInV5 = do + (owner, tid, _) <- createTeam OwnDomain 1 + let configWithoutCrlProxy = + object + [ "config" + .= object + [ "useProxyOnMobile" .= False, + "verificationExpiration" .= A.Number 86400 + ], + "status" .= "enabled" + ] + + -- In API version 5, the CRL proxy is not required, so the request should succeed + bindResponse (Internal.setTeamFeatureConfig (ExplicitVersion 5) owner tid "mlsE2EId" configWithoutCrlProxy) $ \resp -> do + resp.status `shouldMatchInt` 200 + + -- Assert that the feature config got updated correctly + expectedResponse <- configWithoutCrlProxy & setField "lockStatus" "unlocked" & setField "ttl" "unlimited" + checkFeature "mlsE2EId" owner tid expectedResponse diff --git a/libs/wire-api/src/Wire/API/Error/Galley.hs b/libs/wire-api/src/Wire/API/Error/Galley.hs index cf48534dff7..44722937b45 100644 --- a/libs/wire-api/src/Wire/API/Error/Galley.hs +++ b/libs/wire-api/src/Wire/API/Error/Galley.hs @@ -366,6 +366,7 @@ data TeamFeatureError | DisableSsoNotImplemented | FeatureLocked | MLSProtocolMismatch + | MLSE2EIDMissingCrlProxy instance IsSwaggerError TeamFeatureError where -- Do not display in Swagger @@ -397,6 +398,8 @@ type instance MapError 'FeatureLocked = 'StaticError 409 "feature-locked" "Featu type instance MapError 'MLSProtocolMismatch = 'StaticError 400 "mls-protocol-mismatch" "The default protocol needs to be part of the supported protocols" +type instance MapError 'MLSE2EIDMissingCrlProxy = 'StaticError 400 "mls-e2eid-missing-crl-proxy" "The field 'crlProxy' is missing in the request payload" + type instance ErrorEffect TeamFeatureError = Error TeamFeatureError instance Member (Error DynError) r => ServerEffect (Error TeamFeatureError) r where @@ -407,6 +410,7 @@ instance Member (Error DynError) r => ServerEffect (Error TeamFeatureError) r wh DisableSsoNotImplemented -> dynError @(MapError 'DisableSsoNotImplemented) FeatureLocked -> dynError @(MapError 'FeatureLocked) MLSProtocolMismatch -> dynError @(MapError 'MLSProtocolMismatch) + MLSE2EIDMissingCrlProxy -> dynError @(MapError 'MLSE2EIDMissingCrlProxy) -------------------------------------------------------------------------------- -- Proposal failure diff --git a/libs/wire-api/src/Wire/API/Routes/Named.hs b/libs/wire-api/src/Wire/API/Routes/Named.hs index 5e8220818b5..71e0ec307cb 100644 --- a/libs/wire-api/src/Wire/API/Routes/Named.hs +++ b/libs/wire-api/src/Wire/API/Routes/Named.hs @@ -142,6 +142,8 @@ namedClient = clientIn (Proxy @endpoint) (Proxy @m) type family x ::> api +infixr 4 ::> + type instance x ::> (Named name api) = Named name (x :> api) diff --git a/libs/wire-api/src/Wire/API/Routes/Public/Galley/Feature.hs b/libs/wire-api/src/Wire/API/Routes/Public/Galley/Feature.hs index 3dab419273e..654f79657a2 100644 --- a/libs/wire-api/src/Wire/API/Routes/Public/Galley/Feature.hs +++ b/libs/wire-api/src/Wire/API/Routes/Public/Galley/Feature.hs @@ -88,7 +88,8 @@ type FeatureAPI = :<|> FeatureStatusGet OutlookCalIntegrationConfig :<|> FeatureStatusPut '[] '() OutlookCalIntegrationConfig :<|> From 'V5 ::> FeatureStatusGet MlsE2EIdConfig - :<|> From 'V5 ::> FeatureStatusPut '[] '() MlsE2EIdConfig + :<|> From 'V5 ::> Until 'V6 ::> Named "put-MlsE2EIdConfig@v5" (ZUser :> FeatureStatusBasePutPublic '() MlsE2EIdConfig) + :<|> From 'V6 ::> FeatureStatusPut '[] '() MlsE2EIdConfig :<|> From 'V5 ::> FeatureStatusGet MlsMigrationConfig :<|> From 'V5 ::> FeatureStatusPut '[] '() MlsMigrationConfig :<|> From 'V5 diff --git a/libs/wire-api/src/Wire/API/Team/Feature.hs b/libs/wire-api/src/Wire/API/Team/Feature.hs index 55319e388d4..290170ee0a1 100644 --- a/libs/wire-api/src/Wire/API/Team/Feature.hs +++ b/libs/wire-api/src/Wire/API/Team/Feature.hs @@ -1009,7 +1009,9 @@ instance FeatureTrivialConfig OutlookCalIntegrationConfig where data MlsE2EIdConfig = MlsE2EIdConfig { verificationExpiration :: NominalDiffTime, - acmeDiscoveryUrl :: Maybe HttpsUrl + acmeDiscoveryUrl :: Maybe HttpsUrl, + crlProxy :: Maybe HttpsUrl, + useProxyOnMobile :: Bool } deriving stock (Eq, Show, Generic) @@ -1021,6 +1023,8 @@ instance Arbitrary MlsE2EIdConfig where MlsE2EIdConfig <$> (fromIntegral <$> (arbitrary @Word32)) <*> arbitrary + <*> fmap Just arbitrary + <*> arbitrary instance ToSchema MlsE2EIdConfig where schema :: ValueSchema NamedSwaggerDoc MlsE2EIdConfig @@ -1029,6 +1033,8 @@ instance ToSchema MlsE2EIdConfig where MlsE2EIdConfig <$> (toSeconds . verificationExpiration) .= fieldWithDocModifier "verificationExpiration" veDesc (fromSeconds <$> schema) <*> acmeDiscoveryUrl .= maybe_ (optField "acmeDiscoveryUrl" schema) + <*> crlProxy .= maybe_ (optField "crlProxy" schema) + <*> useProxyOnMobile .= (fromMaybe False <$> optField "useProxyOnMobile" schema) where fromSeconds :: Int -> NominalDiffTime fromSeconds = fromIntegral @@ -1055,7 +1061,7 @@ instance IsFeatureConfig MlsE2EIdConfig where type FeatureSymbol MlsE2EIdConfig = "mlsE2EId" defFeatureStatus = withStatus FeatureStatusDisabled LockStatusUnlocked defValue FeatureTTLUnlimited where - defValue = MlsE2EIdConfig (fromIntegral @Int (60 * 60 * 24)) Nothing + defValue = MlsE2EIdConfig (fromIntegral @Int (60 * 60 * 24)) Nothing Nothing False featureSingleton = FeatureSingletonMlsE2EIdConfig objectSchema = field "config" schema diff --git a/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated.hs b/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated.hs index 9778eec5ec5..db14e78b856 100644 --- a/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated.hs +++ b/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated.hs @@ -1295,7 +1295,8 @@ tests = ], testGroup "Golden: WithStatus_team 12" $ testObjects - [ (Test.Wire.API.Golden.Generated.WithStatus_team.testObject_WithStatus_team_18, "testObject_WithStatus_team_18.json") + [ (Test.Wire.API.Golden.Generated.WithStatus_team.testObject_WithStatus_team_18, "testObject_WithStatus_team_18.json"), + (Test.Wire.API.Golden.Generated.WithStatus_team.testObject_WithStatus_team_19, "testObject_WithStatus_team_19.json") ], testGroup "Golden: InvitationRequest_team" $ testObjects [(Test.Wire.API.Golden.Generated.InvitationRequest_team.testObject_InvitationRequest_team_1, "testObject_InvitationRequest_team_1.json"), (Test.Wire.API.Golden.Generated.InvitationRequest_team.testObject_InvitationRequest_team_2, "testObject_InvitationRequest_team_2.json"), (Test.Wire.API.Golden.Generated.InvitationRequest_team.testObject_InvitationRequest_team_3, "testObject_InvitationRequest_team_3.json"), (Test.Wire.API.Golden.Generated.InvitationRequest_team.testObject_InvitationRequest_team_4, "testObject_InvitationRequest_team_4.json"), (Test.Wire.API.Golden.Generated.InvitationRequest_team.testObject_InvitationRequest_team_5, "testObject_InvitationRequest_team_5.json"), (Test.Wire.API.Golden.Generated.InvitationRequest_team.testObject_InvitationRequest_team_6, "testObject_InvitationRequest_team_6.json"), (Test.Wire.API.Golden.Generated.InvitationRequest_team.testObject_InvitationRequest_team_7, "testObject_InvitationRequest_team_7.json"), (Test.Wire.API.Golden.Generated.InvitationRequest_team.testObject_InvitationRequest_team_8, "testObject_InvitationRequest_team_8.json"), (Test.Wire.API.Golden.Generated.InvitationRequest_team.testObject_InvitationRequest_team_9, "testObject_InvitationRequest_team_9.json"), (Test.Wire.API.Golden.Generated.InvitationRequest_team.testObject_InvitationRequest_team_10, "testObject_InvitationRequest_team_10.json"), (Test.Wire.API.Golden.Generated.InvitationRequest_team.testObject_InvitationRequest_team_11, "testObject_InvitationRequest_team_11.json"), (Test.Wire.API.Golden.Generated.InvitationRequest_team.testObject_InvitationRequest_team_12, "testObject_InvitationRequest_team_12.json"), (Test.Wire.API.Golden.Generated.InvitationRequest_team.testObject_InvitationRequest_team_13, "testObject_InvitationRequest_team_13.json"), (Test.Wire.API.Golden.Generated.InvitationRequest_team.testObject_InvitationRequest_team_14, "testObject_InvitationRequest_team_14.json"), (Test.Wire.API.Golden.Generated.InvitationRequest_team.testObject_InvitationRequest_team_15, "testObject_InvitationRequest_team_15.json"), (Test.Wire.API.Golden.Generated.InvitationRequest_team.testObject_InvitationRequest_team_16, "testObject_InvitationRequest_team_16.json"), (Test.Wire.API.Golden.Generated.InvitationRequest_team.testObject_InvitationRequest_team_17, "testObject_InvitationRequest_team_17.json"), (Test.Wire.API.Golden.Generated.InvitationRequest_team.testObject_InvitationRequest_team_18, "testObject_InvitationRequest_team_18.json"), (Test.Wire.API.Golden.Generated.InvitationRequest_team.testObject_InvitationRequest_team_19, "testObject_InvitationRequest_team_19.json"), (Test.Wire.API.Golden.Generated.InvitationRequest_team.testObject_InvitationRequest_team_20, "testObject_InvitationRequest_team_20.json")], diff --git a/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated/WithStatus_team.hs b/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated/WithStatus_team.hs index 22ea58eba03..78523389109 100644 --- a/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated/WithStatus_team.hs +++ b/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated/WithStatus_team.hs @@ -19,7 +19,9 @@ module Test.Wire.API.Golden.Generated.WithStatus_team where +import Data.ByteString.Conversion (parser, runParser) import Data.Domain +import Data.Misc import Imports import Wire.API.Team.Feature hiding (withStatus) import Wire.API.Team.Feature qualified as F @@ -83,6 +85,23 @@ testObject_WithStatus_team_18 = ( MlsE2EIdConfig (fromIntegral @Int (60 * 60 * 24)) Nothing + (either (\e -> error (show e)) Just $ parseHttpsUrl "https://example.com") + False + ) + +parseHttpsUrl :: ByteString -> Either String HttpsUrl +parseHttpsUrl url = runParser parser url + +testObject_WithStatus_team_19 :: WithStatus MlsE2EIdConfig +testObject_WithStatus_team_19 = + withStatus + FeatureStatusEnabled + LockStatusLocked + ( MlsE2EIdConfig + (fromIntegral @Int (60 * 60 * 24)) + (either (\e -> error (show e)) Just $ parseHttpsUrl "https://example.com") + Nothing + True ) withStatus :: FeatureStatus -> LockStatus -> cfg -> WithStatus cfg diff --git a/libs/wire-api/test/golden/testObject_WithStatus_team_18.json b/libs/wire-api/test/golden/testObject_WithStatus_team_18.json index 43f81b018eb..d634f8d2c09 100644 --- a/libs/wire-api/test/golden/testObject_WithStatus_team_18.json +++ b/libs/wire-api/test/golden/testObject_WithStatus_team_18.json @@ -1,5 +1,7 @@ { "config": { + "crlProxy": "https://example.com", + "useProxyOnMobile": false, "verificationExpiration": 86400 }, "lockStatus": "locked", diff --git a/libs/wire-api/test/golden/testObject_WithStatus_team_19.json b/libs/wire-api/test/golden/testObject_WithStatus_team_19.json new file mode 100644 index 00000000000..c73bd3a33d4 --- /dev/null +++ b/libs/wire-api/test/golden/testObject_WithStatus_team_19.json @@ -0,0 +1,10 @@ +{ + "config": { + "acmeDiscoveryUrl": "https://example.com", + "useProxyOnMobile": true, + "verificationExpiration": 86400 + }, + "lockStatus": "locked", + "status": "enabled", + "ttl": "unlimited" +} diff --git a/services/galley/galley.cabal b/services/galley/galley.cabal index 2c51515dbdb..25e88c7ae18 100644 --- a/services/galley/galley.cabal +++ b/services/galley/galley.cabal @@ -271,6 +271,7 @@ library Galley.Schema.V89_MlsLockStatus Galley.Schema.V90_EnforceFileDownloadLocationConfig Galley.Schema.V91_TeamMemberDeletedLimitedEventFanout + Galley.Schema.V92_MlsE2EIdConfig Galley.Types.Clients Galley.Types.ToUserRole Galley.Types.UserList diff --git a/services/galley/src/Galley/API/Public/Feature.hs b/services/galley/src/Galley/API/Public/Feature.hs index 61fc38c87b8..3e9d3f68a54 100644 --- a/services/galley/src/Galley/API/Public/Feature.hs +++ b/services/galley/src/Galley/API/Public/Feature.hs @@ -62,7 +62,8 @@ featureAPI = <@> mkNamedAPI @'("get", OutlookCalIntegrationConfig) (getFeatureStatus . DoAuth) <@> mkNamedAPI @'("put", OutlookCalIntegrationConfig) (setFeatureStatus . DoAuth) <@> mkNamedAPI @'("get", MlsE2EIdConfig) (getFeatureStatus . DoAuth) - <@> mkNamedAPI @'("put", MlsE2EIdConfig) (setFeatureStatus . DoAuth) + <@> mkNamedAPI @"put-MlsE2EIdConfig@v5" (setFeatureStatus . DoAuth) + <@> mkNamedAPI @'("put", MlsE2EIdConfig) (guardMlsE2EIdConfig (setFeatureStatus . DoAuth)) <@> mkNamedAPI @'("get", MlsMigrationConfig) (getFeatureStatus . DoAuth) <@> mkNamedAPI @'("put", MlsMigrationConfig) (setFeatureStatus . DoAuth) <@> mkNamedAPI @'("get", EnforceFileDownloadLocationConfig) (getFeatureStatus . DoAuth) diff --git a/services/galley/src/Galley/API/Teams/Features.hs b/services/galley/src/Galley/API/Teams/Features.hs index 6425dd772a9..1542b701b12 100644 --- a/services/galley/src/Galley/API/Teams/Features.hs +++ b/services/galley/src/Galley/API/Teams/Features.hs @@ -32,6 +32,7 @@ module Galley.API.Teams.Features guardSecondFactorDisabled, DoAuth (..), featureEnabledForTeam, + guardMlsE2EIdConfig, ) where @@ -385,6 +386,18 @@ instance SetFeatureConfig OutlookCalIntegrationConfig instance SetFeatureConfig MlsE2EIdConfig +guardMlsE2EIdConfig :: + forall r a. + (Member (Error TeamFeatureError) r) => + (UserId -> TeamId -> WithStatusNoLock MlsE2EIdConfig -> Sem r a) -> + UserId -> + TeamId -> + WithStatusNoLock MlsE2EIdConfig -> + Sem r a +guardMlsE2EIdConfig handler uid tid conf = do + when (isNothing . crlProxy . wssConfig $ conf) $ throw MLSE2EIDMissingCrlProxy + handler uid tid conf + instance SetFeatureConfig MlsMigrationConfig where type SetConfigForTeamConstraints MlsMigrationConfig (r :: EffectRow) = (Member (Error TeamFeatureError) r) setConfigForTeam tid wsnl = do diff --git a/services/galley/src/Galley/Cassandra/GetAllTeamFeatureConfigs.hs b/services/galley/src/Galley/Cassandra/GetAllTeamFeatureConfigs.hs index d6b070c7f91..7e35b485851 100644 --- a/services/galley/src/Galley/Cassandra/GetAllTeamFeatureConfigs.hs +++ b/services/galley/src/Galley/Cassandra/GetAllTeamFeatureConfigs.hs @@ -58,6 +58,8 @@ data AllTeamFeatureConfigsRow = AllTeamFeatureConfigsRow mlsE2eid :: Maybe FeatureStatus, mlsE2eidGracePeriod :: Maybe Int32, mlsE2eidAcmeDiscoverUrl :: Maybe HttpsUrl, + mlsE2eidMaybeCrlProxy :: Maybe HttpsUrl, + mlsE2eidMaybeUseProxyOnMobile :: Maybe Bool, mlsE2eidLock :: Maybe LockStatus, -- mls migration mlsMigration :: Maybe FeatureStatus, @@ -112,6 +114,8 @@ emptyRow = mlsE2eid = Nothing, mlsE2eidGracePeriod = Nothing, mlsE2eidAcmeDiscoverUrl = Nothing, + mlsE2eidMaybeCrlProxy = Nothing, + mlsE2eidMaybeUseProxyOnMobile = Nothing, mlsE2eidLock = Nothing, mlsMigration = Nothing, mlsMigrationStartTime = Nothing, @@ -295,6 +299,8 @@ allFeatureConfigsFromRow ourteam allowListForExposeInvitationURLs featureLH hasT MlsE2EIdConfig (toGracePeriodOrDefault row.mlsE2eidGracePeriod) row.mlsE2eidAcmeDiscoverUrl + row.mlsE2eidMaybeCrlProxy + (fromMaybe (useProxyOnMobile . wsConfig $ defFeatureStatus) row.mlsE2eidMaybeUseProxyOnMobile) where toGracePeriodOrDefault :: Maybe Int32 -> NominalDiffTime toGracePeriodOrDefault = maybe (verificationExpiration $ wsConfig defFeatureStatus) fromIntegral @@ -368,7 +374,7 @@ getAllFeatureConfigs allowListForExposeInvitationURLs featureLH hasTeamImplicitL \mls_status, mls_default_protocol, mls_protocol_toggle_users, mls_allowed_ciphersuites, \ \mls_default_ciphersuite, mls_supported_protocols, mls_lock_status, \ \\ - \mls_e2eid_status, mls_e2eid_grace_period, mls_e2eid_acme_discovery_url, mls_e2eid_lock_status, \ + \mls_e2eid_status, mls_e2eid_grace_period, mls_e2eid_acme_discovery_url, mls_e2eid_crl_proxy, mls_e2eid_use_proxy_on_mobile, mls_e2eid_lock_status, \ \\ \mls_migration_status, mls_migration_start_time, mls_migration_finalise_regardless_after, \ \mls_migration_lock_status, \ diff --git a/services/galley/src/Galley/Cassandra/TeamFeatures.hs b/services/galley/src/Galley/Cassandra/TeamFeatures.hs index dc8e82fe6ce..6df455cf557 100644 --- a/services/galley/src/Galley/Cassandra/TeamFeatures.hs +++ b/services/galley/src/Galley/Cassandra/TeamFeatures.hs @@ -170,24 +170,24 @@ getFeatureConfig FeatureSingletonMlsE2EIdConfig tid = do let q = query1 select (params LocalQuorum (Identity tid)) retry x1 q <&> \case Nothing -> Nothing - Just (Nothing, _, _) -> Nothing - Just (Just fs, mGracePeriod, mUrl) -> + Just (Nothing, _, _, _, _) -> Nothing + Just (Just fs, mGracePeriod, mUrl, mCrlProxy, mUseProxyOnMobile) -> Just $ WithStatusNoLock fs ( -- FUTUREWORK: this block is duplicated in -- "Galley.Cassandra.GetAllTeamFeatureConfigs"; make sure the two don't diverge! - MlsE2EIdConfig (toGracePeriodOrDefault mGracePeriod) mUrl + MlsE2EIdConfig (toGracePeriodOrDefault mGracePeriod) mUrl mCrlProxy (fromMaybe (useProxyOnMobile . wsConfig $ defFeatureStatus @MlsE2EIdConfig) mUseProxyOnMobile) ) FeatureTTLUnlimited where toGracePeriodOrDefault :: Maybe Int32 -> NominalDiffTime toGracePeriodOrDefault = maybe (verificationExpiration $ wsConfig defFeatureStatus) fromIntegral - select :: PrepQuery R (Identity TeamId) (Maybe FeatureStatus, Maybe Int32, Maybe HttpsUrl) + select :: PrepQuery R (Identity TeamId) (Maybe FeatureStatus, Maybe Int32, Maybe HttpsUrl, Maybe HttpsUrl, Maybe Bool) select = fromString $ - "select mls_e2eid_status, mls_e2eid_grace_period, mls_e2eid_acme_discovery_url from team_features where team_id = ?" + "select mls_e2eid_status, mls_e2eid_grace_period, mls_e2eid_acme_discovery_url, mls_e2eid_crl_proxy, mls_e2eid_use_proxy_on_mobile from team_features where team_id = ?" getFeatureConfig FeatureSingletonMlsMigration tid = do let q = query1 select (params LocalQuorum (Identity tid)) retry x1 q <&> \case @@ -292,11 +292,13 @@ setFeatureConfig FeatureSingletonMlsE2EIdConfig tid status = do let statusValue = wssStatus status vex = verificationExpiration . wssConfig $ status mUrl = acmeDiscoveryUrl . wssConfig $ status - retry x5 $ write insert (params LocalQuorum (tid, statusValue, truncate vex, mUrl)) + mCrlProxy = crlProxy . wssConfig $ status + useProxy = useProxyOnMobile . wssConfig $ status + retry x5 $ write insert (params LocalQuorum (tid, statusValue, truncate vex, mUrl, mCrlProxy, useProxy)) where - insert :: PrepQuery W (TeamId, FeatureStatus, Int32, Maybe HttpsUrl) () + insert :: PrepQuery W (TeamId, FeatureStatus, Int32, Maybe HttpsUrl, Maybe HttpsUrl, Bool) () insert = - "insert into team_features (team_id, mls_e2eid_status, mls_e2eid_grace_period, mls_e2eid_acme_discovery_url) values (?, ?, ?, ?)" + "insert into team_features (team_id, mls_e2eid_status, mls_e2eid_grace_period, mls_e2eid_acme_discovery_url, mls_e2eid_crl_proxy, mls_e2eid_use_proxy_on_mobile) values (?, ?, ?, ?, ?, ?)" setFeatureConfig FeatureSingletonMlsMigration tid status = do let statusValue = wssStatus status config = wssConfig status diff --git a/services/galley/src/Galley/Schema/Run.hs b/services/galley/src/Galley/Schema/Run.hs index 51e29417032..5039676a3fa 100644 --- a/services/galley/src/Galley/Schema/Run.hs +++ b/services/galley/src/Galley/Schema/Run.hs @@ -92,6 +92,7 @@ import Galley.Schema.V88_RemoveMemberClientAndTruncateMLSGroupMemberClient quali import Galley.Schema.V89_MlsLockStatus qualified as V89_MlsLockStatus import Galley.Schema.V90_EnforceFileDownloadLocationConfig qualified as V90_EnforceFileDownloadLocationConfig import Galley.Schema.V91_TeamMemberDeletedLimitedEventFanout qualified as V91_TeamMemberDeletedLimitedEventFanout +import Galley.Schema.V92_MlsE2EIdConfig qualified as V92_MlsE2EIdConfig import Imports import Options.Applicative import System.Logger.Extended qualified as Log @@ -184,7 +185,8 @@ migrations = V88_RemoveMemberClientAndTruncateMLSGroupMemberClient.migration, V89_MlsLockStatus.migration, V90_EnforceFileDownloadLocationConfig.migration, - V91_TeamMemberDeletedLimitedEventFanout.migration + V91_TeamMemberDeletedLimitedEventFanout.migration, + V92_MlsE2EIdConfig.migration -- FUTUREWORK: once #1726 has made its way to master/production, -- the 'message' field in connections table can be dropped. -- See also https://github.com/wireapp/wire-server/pull/1747/files diff --git a/services/galley/src/Galley/Schema/V92_MlsE2EIdConfig.hs b/services/galley/src/Galley/Schema/V92_MlsE2EIdConfig.hs new file mode 100644 index 00000000000..0c11ebf6cd6 --- /dev/null +++ b/services/galley/src/Galley/Schema/V92_MlsE2EIdConfig.hs @@ -0,0 +1,31 @@ +-- This file is part of the Wire Server implementation. +-- +-- Copyright (C) 2023 Wire Swiss GmbH +-- +-- This program is free software: you can redistribute it and/or modify it under +-- the terms of the GNU Affero General Public License as published by the Free +-- Software Foundation, either version 3 of the License, or (at your option) any +-- later version. +-- +-- This program is distributed in the hope that it will be useful, but WITHOUT +-- ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS +-- FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for more +-- details. +-- +-- You should have received a copy of the GNU Affero General Public License along +-- with this program. If not, see . +module Galley.Schema.V92_MlsE2EIdConfig where + +import Cassandra.Schema +import Imports +import Text.RawString.QQ + +migration :: Migration +migration = + Migration 92 "Add mls_e2eid_crl_proxy and mls_e2eid_use_proxy_on_mobile to team_features" $ + schema' + [r| ALTER TABLE team_features ADD ( + mls_e2eid_crl_proxy blob, + mls_e2eid_use_proxy_on_mobile boolean + ) + |] From 1bfc10576b745815b854802ff1c05e638ae0f3df Mon Sep 17 00:00:00 2001 From: Leif Battermann Date: Wed, 29 May 2024 16:27:05 +0200 Subject: [PATCH 12/64] WPB-6442 migrate all team feature tests to integration package part 1 (#4063) --- changelog.d/5-internal/WPB-6442 | 1 + integration/integration.cabal | 1 + integration/test/API/Galley.hs | 11 + integration/test/API/GalleyInternal.hs | 28 +- integration/test/Notifications.hs | 4 + integration/test/Test/Conversation.hs | 2 +- integration/test/Test/FeatureFlags.hs | 1062 ++++++++++++- integration/test/Test/FeatureFlags/Util.hs | 86 + integration/test/Test/Login.hs | 12 +- integration/test/Test/Search.hs | 4 +- integration/test/Test/User.hs | 4 +- integration/test/Testlib/Cannon.hs | 12 + services/galley/default.nix | 2 - services/galley/galley.cabal | 2 - services/galley/test/integration/API.hs | 2 - .../test/integration/API/Teams/Feature.hs | 1401 ----------------- 16 files changed, 1154 insertions(+), 1480 deletions(-) create mode 100644 changelog.d/5-internal/WPB-6442 create mode 100644 integration/test/Test/FeatureFlags/Util.hs delete mode 100644 services/galley/test/integration/API/Teams/Feature.hs diff --git a/changelog.d/5-internal/WPB-6442 b/changelog.d/5-internal/WPB-6442 new file mode 100644 index 00000000000..efb05804505 --- /dev/null +++ b/changelog.d/5-internal/WPB-6442 @@ -0,0 +1 @@ +Port team feature tests to the `integration` package diff --git a/integration/integration.cabal b/integration/integration.cabal index 15fd4c7a8d6..3c3d9f63e6c 100644 --- a/integration/integration.cabal +++ b/integration/integration.cabal @@ -122,6 +122,7 @@ library Test.Errors Test.ExternalPartner Test.FeatureFlags + Test.FeatureFlags.Util Test.Federation Test.Federator Test.LegalHold diff --git a/integration/test/API/Galley.hs b/integration/test/API/Galley.hs index f169e341cb7..c744ad12258 100644 --- a/integration/test/API/Galley.hs +++ b/integration/test/API/Galley.hs @@ -701,3 +701,14 @@ getTeamFeature user tid featureName = do tidStr <- asString tid req <- baseRequest user Galley Versioned (joinHttpPath ["teams", tidStr, "features", featureName]) submit "GET" req + +setTeamFeatureConfig :: (HasCallStack, MakesValue user, MakesValue team, MakesValue featureName, MakesValue payload) => user -> team -> featureName -> payload -> App Response +setTeamFeatureConfig = setTeamFeatureConfigVersioned Versioned + +setTeamFeatureConfigVersioned :: (HasCallStack, MakesValue user, MakesValue team, MakesValue featureName, MakesValue payload) => Versioned -> user -> team -> featureName -> payload -> App Response +setTeamFeatureConfigVersioned versioned user team featureName payload = do + tid <- asString team + fn <- asString featureName + p <- make payload + req <- baseRequest user Galley versioned $ joinHttpPath ["teams", tid, "features", fn] + submit "PUT" $ req & addJSON p diff --git a/integration/test/API/GalleyInternal.hs b/integration/test/API/GalleyInternal.hs index 5da28bbf554..59a0880411f 100644 --- a/integration/test/API/GalleyInternal.hs +++ b/integration/test/API/GalleyInternal.hs @@ -37,16 +37,11 @@ getTeamFeature domain_ tid featureName = do req <- baseRequest domain_ Galley Unversioned $ joinHttpPath ["i", "teams", tid, "features", featureName] submit "GET" $ req -setTeamFeatureStatus :: (HasCallStack, MakesValue domain, MakesValue team) => domain -> team -> String -> String -> App () +setTeamFeatureStatus :: (HasCallStack, MakesValue domain, MakesValue team) => domain -> team -> String -> String -> App Response setTeamFeatureStatus domain team featureName status = do - setTeamFeatureStatusExpectHttpStatus domain team featureName status 200 - -setTeamFeatureStatusExpectHttpStatus :: (HasCallStack, MakesValue domain, MakesValue team) => domain -> team -> String -> String -> Int -> App () -setTeamFeatureStatusExpectHttpStatus domain team featureName status httpStatus = do tid <- asString team req <- baseRequest domain Galley Unversioned $ joinHttpPath ["i", "teams", tid, "features", featureName] - bindResponse (submit "PATCH" $ req & addJSONObject ["status" .= status]) $ \res -> do - res.status `shouldMatchInt` httpStatus + submit "PATCH" $ req & addJSONObject ["status" .= status] setTeamFeatureLockStatus :: (HasCallStack, MakesValue domain, MakesValue team) => domain -> team -> String -> String -> App () setTeamFeatureLockStatus domain team featureName status = do @@ -102,10 +97,23 @@ generateVerificationCode' domain email = do emailStr <- asString email submit "POST" $ req & addJSONObject ["email" .= emailStr, "action" .= "login"] -setTeamFeatureConfig :: (HasCallStack, MakesValue domain, MakesValue team, MakesValue featureName, MakesValue payload) => Versioned -> domain -> team -> featureName -> payload -> App Response -setTeamFeatureConfig versioned domain team featureName payload = do +setTeamFeatureConfig :: (HasCallStack, MakesValue domain, MakesValue team, MakesValue featureName, MakesValue payload) => domain -> team -> featureName -> payload -> App Response +setTeamFeatureConfig domain team featureName payload = do tid <- asString team fn <- asString featureName p <- make payload - req <- baseRequest domain Galley versioned $ joinHttpPath ["teams", tid, "features", fn] + req <- baseRequest domain Galley Unversioned $ joinHttpPath ["i", "teams", tid, "features", fn] submit "PUT" $ req & addJSON p + +-- https://staging-nginz-https.zinfra.io/api-internal/swagger-ui/galley/#/galley/post_i_features_multi_teams_searchVisibilityInbound +getFeatureStatusMulti :: (HasCallStack, MakesValue domain, MakesValue featureName) => domain -> featureName -> [String] -> App Response +getFeatureStatusMulti domain featureName tids = do + fn <- asString featureName + req <- baseRequest domain Galley Unversioned $ joinHttpPath ["i", "features-multi-teams", fn] + submit "POST" $ req & addJSONObject ["teams" .= tids] + +patchTeamFeature :: (HasCallStack, MakesValue domain, MakesValue team) => domain -> team -> String -> Value -> App Response +patchTeamFeature domain team featureName payload = do + tid <- asString team + req <- baseRequest domain Galley Unversioned $ joinHttpPath ["i", "teams", tid, "features", featureName] + submit "PATCH" $ req & addJSON payload diff --git a/integration/test/Notifications.hs b/integration/test/Notifications.hs index 9186f325f07..3278a94c35e 100644 --- a/integration/test/Notifications.hs +++ b/integration/test/Notifications.hs @@ -100,6 +100,10 @@ isDeleteUserNotif :: MakesValue a => a -> App Bool isDeleteUserNotif n = nPayload n %. "type" `isEqual` "user.delete" +isFeatureConfigUpdateNotif :: MakesValue a => a -> App Bool +isFeatureConfigUpdateNotif n = + nPayload n %. "type" `isEqual` "feature-config.update" + isNewMessageNotif :: MakesValue a => a -> App Bool isNewMessageNotif n = fieldEquals n "payload.0.type" "conversation.otr-message-add" diff --git a/integration/test/Test/Conversation.hs b/integration/test/Test/Conversation.hs index 81a15c7e16f..9426f1a41c1 100644 --- a/integration/test/Test/Conversation.hs +++ b/integration/test/Test/Conversation.hs @@ -681,7 +681,7 @@ testDeleteTeamMemberLimitedEventFanout = do -- Only the team admins will get the team-level event about Alex being removed -- from the team - setTeamFeatureStatus OwnDomain team "limitedEventFanout" "enabled" + assertSuccess =<< setTeamFeatureStatus OwnDomain team "limitedEventFanout" "enabled" withWebSockets [alice, amy, bob, alison, ana] $ \[wsAlice, wsAmy, wsBob, wsAlison, wsAna] -> do diff --git a/integration/test/Test/FeatureFlags.hs b/integration/test/Test/FeatureFlags.hs index 4903392f213..32a22526da7 100644 --- a/integration/test/Test/FeatureFlags.hs +++ b/integration/test/Test/FeatureFlags.hs @@ -19,10 +19,17 @@ module Test.FeatureFlags where import qualified API.Galley as Public import qualified API.GalleyInternal as Internal +import Control.Concurrent (threadDelay) import Control.Monad.Codensity (Codensity (runCodensity)) import Control.Monad.Reader import qualified Data.Aeson as A +import qualified Data.Aeson.Key as A +import qualified Data.Aeson.KeyMap as KM +import qualified Data.Set as Set +import Data.String.Conversions (cs) +import Notifications import SetupHelpers +import Test.FeatureFlags.Util import Testlib.Prelude import Testlib.ResourcePool (acquireResources) @@ -34,19 +41,29 @@ testLimitedEventFanout = do bindResponse (Internal.getTeamFeature OwnDomain team featureName) $ \resp -> do resp.status `shouldMatchInt` 200 resp.json %. "status" `shouldMatch` "disabled" - Internal.setTeamFeatureStatus OwnDomain team featureName "enabled" + assertSuccess =<< Internal.setTeamFeatureStatus OwnDomain team featureName "enabled" bindResponse (Internal.getTeamFeature OwnDomain team featureName) $ \resp -> do resp.status `shouldMatchInt` 200 resp.json %. "status" `shouldMatch` "enabled" -disabled :: Value -disabled = object ["lockStatus" .= "unlocked", "status" .= "disabled", "ttl" .= "unlimited"] - -disabledLocked :: Value -disabledLocked = object ["lockStatus" .= "locked", "status" .= "disabled", "ttl" .= "unlimited"] - -enabled :: Value -enabled = object ["lockStatus" .= "unlocked", "status" .= "enabled", "ttl" .= "unlimited"] +testLegalholdDisabledByDefault :: HasCallStack => App () +testLegalholdDisabledByDefault = do + let put uid tid st = Internal.setTeamFeatureConfig uid tid "legalhold" (object ["status" .= st]) >>= assertSuccess + let patch uid tid st = Internal.setTeamFeatureStatus uid tid "legalhold" st >>= assertSuccess + forM_ [put, patch] $ \setFeatureStatus -> do + withModifiedBackend + def {galleyCfg = setField "settings.featureFlags.legalhold" "disabled-by-default"} + $ \domain -> do + (owner, tid, m : _) <- createTeam domain 2 + nonMember <- randomUser domain def + assertForbidden =<< Public.getTeamFeature nonMember tid "legalhold" + -- Test default + checkFeature "legalhold" m tid disabled + -- Test override + setFeatureStatus owner tid "enabled" + checkFeature "legalhold" owner tid enabled + setFeatureStatus owner tid "disabled" + checkFeature "legalhold" owner tid disabled -- always disabled testLegalholdDisabledPermanently :: HasCallStack => App () @@ -67,33 +84,21 @@ testLegalholdDisabledPermanently = do runCodensity (startDynamicBackend testBackend cfgLhDisabledPermanently) $ \_ -> do (owner, tid, _) <- createTeam domain 1 checkFeature "legalhold" owner tid disabled - Internal.setTeamFeatureStatusExpectHttpStatus domain tid "legalhold" "enabled" 403 + assertStatus 403 =<< Internal.setTeamFeatureStatus domain tid "legalhold" "enabled" + assertStatus 403 =<< Internal.setTeamFeatureConfig domain tid "legalhold" (object ["status" .= "enabled"]) - -- Inteteresting case: The team had LH enabled before backend config was + -- Interesting case: The team had LH enabled before backend config was -- changed to disabled-permanently (owner, tid) <- runCodensity (startDynamicBackend testBackend cfgLhDisabledByDefault) $ \_ -> do (owner, tid, _) <- createTeam domain 1 checkFeature "legalhold" owner tid disabled - Internal.setTeamFeatureStatusExpectHttpStatus domain tid "legalhold" "enabled" 200 + assertSuccess =<< Internal.setTeamFeatureStatus domain tid "legalhold" "enabled" checkFeature "legalhold" owner tid enabled pure (owner, tid) runCodensity (startDynamicBackend testBackend cfgLhDisabledPermanently) $ \_ -> do checkFeature "legalhold" owner tid disabled --- can be enabled for a team, disabled if unset -testLegalholdDisabledByDefault :: HasCallStack => App () -testLegalholdDisabledByDefault = do - withModifiedBackend - (def {galleyCfg = setField "settings.featureFlags.legalhold" "disabled-by-default"}) - $ \domain -> do - (owner, tid, _) <- createTeam domain 1 - checkFeature "legalhold" owner tid disabled - Internal.setTeamFeatureStatus domain tid "legalhold" "enabled" - checkFeature "legalhold" owner tid enabled - Internal.setTeamFeatureStatus domain tid "legalhold" "disabled" - checkFeature "legalhold" owner tid disabled - -- enabled if team is allow listed, disabled in any other case testLegalholdWhitelistTeamsAndImplicitConsent :: HasCallStack => App () testLegalholdWhitelistTeamsAndImplicitConsent = do @@ -117,7 +122,8 @@ testLegalholdWhitelistTeamsAndImplicitConsent = do checkFeature "legalhold" owner tid enabled -- Disabling it doesn't work - Internal.setTeamFeatureStatusExpectHttpStatus domain tid "legalhold" "disabled" 403 + assertStatus 403 =<< Internal.setTeamFeatureStatus domain tid "legalhold" "disabled" + assertStatus 403 =<< Internal.setTeamFeatureConfig domain tid "legalhold" (object ["status" .= "disabled"]) checkFeature "legalhold" owner tid enabled pure (owner, tid) @@ -126,7 +132,7 @@ testLegalholdWhitelistTeamsAndImplicitConsent = do -- enabled when the config gets changed. runCodensity (startDynamicBackend testBackend cfgLhDisabledByDefault) $ \_ -> do checkFeature "legalhold" owner tid disabled - Internal.setTeamFeatureStatusExpectHttpStatus domain tid "legalhold" "disabled" 200 + assertSuccess =<< Internal.setTeamFeatureStatus domain tid "legalhold" "disabled" checkFeature "legalhold" owner tid disabled runCodensity (startDynamicBackend testBackend cfgLhWhitelistTeamsAndImplicitConsent) $ \_ -> do @@ -146,8 +152,13 @@ testExposeInvitationURLsToTeamAdminConfig = do (owner, tid, _) <- createTeam domain 1 checkFeature "exposeInvitationURLsToTeamAdmin" owner tid disabledLocked -- here we get a response with HTTP status 200 and feature status unchanged (disabled), which we find weird, but we're just testing the current behavior - Internal.setTeamFeatureStatusExpectHttpStatus domain tid "exposeInvitationURLsToTeamAdmin" "enabled" 200 - Internal.setTeamFeatureStatusExpectHttpStatus domain tid "exposeInvitationURLsToTeamAdmin" "disabled" 200 + -- a team that is not in the allow list cannot enable the feature, it will always be disabled and locked + -- even though the internal API request to enable it succeeds + assertSuccess =<< Internal.setTeamFeatureStatus domain tid "exposeInvitationURLsToTeamAdmin" "enabled" + checkFeature "exposeInvitationURLsToTeamAdmin" owner tid disabledLocked + -- however, a request to the public API will fail + assertStatus 409 =<< Public.setTeamFeatureConfig owner tid "exposeInvitationURLsToTeamAdmin" (object ["status" .= "enabled"]) + assertSuccess =<< Internal.setTeamFeatureStatus domain tid "exposeInvitationURLsToTeamAdmin" "disabled" pure (owner, tid) -- Happy case: DB has no config for the team @@ -155,34 +166,18 @@ testExposeInvitationURLsToTeamAdminConfig = do -- Interesting case: The team is in the allow list runCodensity (startDynamicBackend testBackend $ cfgExposeInvitationURLsTeamAllowlist [tid]) $ \_ -> do + -- when the team is in the allow list the lock status is implicitly unlocked checkFeature "exposeInvitationURLsToTeamAdmin" owner tid disabled - Internal.setTeamFeatureStatusExpectHttpStatus domain tid "exposeInvitationURLsToTeamAdmin" "enabled" 200 + assertSuccess =<< Internal.setTeamFeatureStatus domain tid "exposeInvitationURLsToTeamAdmin" "enabled" checkFeature "exposeInvitationURLsToTeamAdmin" owner tid enabled - Internal.setTeamFeatureStatusExpectHttpStatus domain tid "exposeInvitationURLsToTeamAdmin" "disabled" 200 + assertSuccess =<< Internal.setTeamFeatureStatus domain tid "exposeInvitationURLsToTeamAdmin" "disabled" checkFeature "exposeInvitationURLsToTeamAdmin" owner tid disabled - Internal.setTeamFeatureStatusExpectHttpStatus domain tid "exposeInvitationURLsToTeamAdmin" "enabled" 200 + assertSuccess =<< Internal.setTeamFeatureStatus domain tid "exposeInvitationURLsToTeamAdmin" "enabled" checkFeature "exposeInvitationURLsToTeamAdmin" owner tid enabled -- Interesting case: The team had the feature enabled but is not in allow list void testNoAllowlistEntry -checkFeature :: (HasCallStack, MakesValue user, MakesValue tid) => String -> user -> tid -> Value -> App () -checkFeature feature user tid expected = do - tidStr <- asString tid - domain <- objDomain user - bindResponse (Internal.getTeamFeature domain tidStr feature) $ \resp -> do - resp.status `shouldMatchInt` 200 - resp.json `shouldMatch` expected - bindResponse (Public.getTeamFeatures user tid) $ \resp -> do - resp.status `shouldMatchInt` 200 - resp.json %. feature `shouldMatch` expected - bindResponse (Public.getTeamFeature user tid feature) $ \resp -> do - resp.status `shouldMatchInt` 200 - resp.json `shouldMatch` expected - bindResponse (Public.getFeatureConfigs user) $ \resp -> do - resp.status `shouldMatchInt` 200 - resp.json %. feature `shouldMatch` expected - testMlsE2EConfigCrlProxyRequired :: HasCallStack => App () testMlsE2EConfigCrlProxyRequired = do (owner, tid, _) <- createTeam OwnDomain 1 @@ -197,7 +192,7 @@ testMlsE2EConfigCrlProxyRequired = do ] -- From API version 6 onwards, the CRL proxy is required, so the request should fail when it's not provided - bindResponse (Internal.setTeamFeatureConfig Versioned owner tid "mlsE2EId" configWithoutCrlProxy) $ \resp -> do + bindResponse (Public.setTeamFeatureConfig owner tid "mlsE2EId" configWithoutCrlProxy) $ \resp -> do resp.status `shouldMatchInt` 400 resp.json %. "label" `shouldMatch` "mls-e2eid-missing-crl-proxy" @@ -208,7 +203,7 @@ testMlsE2EConfigCrlProxyRequired = do & setField "status" "enabled" -- The request should succeed when the CRL proxy is provided - bindResponse (Internal.setTeamFeatureConfig Versioned owner tid "mlsE2EId" configWithCrlProxy) $ \resp -> do + bindResponse (Public.setTeamFeatureConfig owner tid "mlsE2EId" configWithCrlProxy) $ \resp -> do resp.status `shouldMatchInt` 200 -- Assert that the feature config got updated correctly @@ -229,9 +224,972 @@ testMlsE2EConfigCrlProxyNotRequiredInV5 = do ] -- In API version 5, the CRL proxy is not required, so the request should succeed - bindResponse (Internal.setTeamFeatureConfig (ExplicitVersion 5) owner tid "mlsE2EId" configWithoutCrlProxy) $ \resp -> do + bindResponse (Public.setTeamFeatureConfigVersioned (ExplicitVersion 5) owner tid "mlsE2EId" configWithoutCrlProxy) $ \resp -> do resp.status `shouldMatchInt` 200 -- Assert that the feature config got updated correctly expectedResponse <- configWithoutCrlProxy & setField "lockStatus" "unlocked" & setField "ttl" "unlimited" checkFeature "mlsE2EId" owner tid expectedResponse + +testSSODisabledByDefault :: HasCallStack => App () +testSSODisabledByDefault = do + let put uid tid = Internal.setTeamFeatureConfig uid tid "sso" (object ["status" .= "enabled"]) >>= assertSuccess + let patch uid tid = Internal.setTeamFeatureStatus uid tid "sso" "enabled" >>= assertSuccess + forM_ [put, patch] $ \enableFeature -> do + withModifiedBackend + def {galleyCfg = setField "settings.featureFlags.sso" "disabled-by-default"} + $ \domain -> do + (owner, tid, m : _) <- createTeam domain 2 + nonMember <- randomUser domain def + assertForbidden =<< Public.getTeamFeature nonMember tid "sso" + -- Test default + checkFeature "sso" m tid disabled + -- Test override + enableFeature owner tid + checkFeature "sso" owner tid enabled + +testSSOEnabledByDefault :: HasCallStack => App () +testSSOEnabledByDefault = do + withModifiedBackend + def {galleyCfg = setField "settings.featureFlags.sso" "enabled-by-default"} + $ \domain -> do + (owner, tid, _m : _) <- createTeam domain 2 + nonMember <- randomUser domain def + assertForbidden =<< Public.getTeamFeature nonMember tid "sso" + checkFeature "sso" owner tid enabled + -- check that the feature cannot be disabled + assertLabel 403 "not-implemented" =<< Internal.setTeamFeatureConfig owner tid "sso" (object ["status" .= "disabled"]) + +testSearchVisibilityDisabledByDefault :: HasCallStack => App () +testSearchVisibilityDisabledByDefault = do + withModifiedBackend def {galleyCfg = setField "settings.featureFlags.teamSearchVisibility" "disabled-by-default"} $ \domain -> do + (owner, tid, m : _) <- createTeam domain 2 + nonMember <- randomUser domain def + assertForbidden =<< Public.getTeamFeature nonMember tid "searchVisibility" + -- Test default + checkFeature "searchVisibility" m tid disabled + assertSuccess =<< Internal.setTeamFeatureStatus owner tid "searchVisibility" "enabled" + checkFeature "searchVisibility" owner tid enabled + assertSuccess =<< Internal.setTeamFeatureStatus owner tid "searchVisibility" "disabled" + checkFeature "searchVisibility" owner tid disabled + +testSearchVisibilityEnabledByDefault :: HasCallStack => App () +testSearchVisibilityEnabledByDefault = do + withModifiedBackend def {galleyCfg = setField "settings.featureFlags.teamSearchVisibility" "enabled-by-default"} $ \domain -> do + (owner, tid, m : _) <- createTeam domain 2 + nonMember <- randomUser domain def + assertForbidden =<< Public.getTeamFeature nonMember tid "searchVisibility" + -- Test default + checkFeature "searchVisibility" m tid enabled + assertSuccess =<< Internal.setTeamFeatureStatus owner tid "searchVisibility" "disabled" + checkFeature "searchVisibility" owner tid disabled + assertSuccess =<< Internal.setTeamFeatureStatus owner tid "searchVisibility" "enabled" + checkFeature "searchVisibility" owner tid enabled + +testSearchVisibilityInbound :: HasCallStack => App () +testSearchVisibilityInbound = _testSimpleFlag "searchVisibilityInbound" Public.setTeamFeatureConfig False + +testDigitalSignaturesInternal :: HasCallStack => App () +testDigitalSignaturesInternal = _testSimpleFlag "digitalSignatures" Internal.setTeamFeatureConfig False + +testValidateSAMLEmailsInternal :: HasCallStack => App () +testValidateSAMLEmailsInternal = _testSimpleFlag "validateSAMLemails" Internal.setTeamFeatureConfig True + +testConferenceCallingInternal :: HasCallStack => App () +testConferenceCallingInternal = _testSimpleFlag "conferenceCalling" Internal.setTeamFeatureConfig True + +testSearchVisibilityInboundInternal :: HasCallStack => App () +testSearchVisibilityInboundInternal = _testSimpleFlag "searchVisibilityInbound" Internal.setTeamFeatureConfig False + +_testSimpleFlag :: HasCallStack => String -> (Value -> String -> String -> Value -> App Response) -> Bool -> App () +_testSimpleFlag featureName setFeatureConfig featureEnabledByDefault = do + let defaultStatus = if featureEnabledByDefault then "enabled" else "disabled" + let defaultValue = if featureEnabledByDefault then enabled else disabled + let otherStatus = if featureEnabledByDefault then "disabled" else "enabled" + let otherValue = if featureEnabledByDefault then disabled else enabled + + (owner, tid, m : _) <- createTeam OwnDomain 2 + nonTeamMember <- randomUser OwnDomain def + assertForbidden =<< Public.getTeamFeature nonTeamMember tid featureName + checkFeature featureName m tid defaultValue + -- should receive an event + void $ withWebSockets [m] $ \wss -> do + assertSuccess =<< setFeatureConfig owner tid featureName (object ["status" .= otherStatus]) + for_ wss $ \ws -> do + notif <- awaitMatch isFeatureConfigUpdateNotif ws + notif %. "payload.0.name" `shouldMatch` featureName + notif %. "payload.0.data" `shouldMatch` otherValue + + checkFeature featureName m tid otherValue + assertSuccess =<< setFeatureConfig owner tid featureName (object ["status" .= defaultStatus]) + for_ wss $ \ws -> do + notif <- awaitMatch isFeatureConfigUpdateNotif ws + notif %. "payload.0.name" `shouldMatch` featureName + notif %. "payload.0.data" `shouldMatch` defaultValue + checkFeature featureName m tid defaultValue + +testConversationGuestLinks :: HasCallStack => App () +testConversationGuestLinks = _testSimpleFlagWithLockStatus "conversationGuestLinks" Public.setTeamFeatureConfig True True + +testFileSharing :: HasCallStack => App () +testFileSharing = _testSimpleFlagWithLockStatus "fileSharing" Public.setTeamFeatureConfig True True + +testSndFactorPasswordChallenge :: HasCallStack => App () +testSndFactorPasswordChallenge = _testSimpleFlagWithLockStatus "sndFactorPasswordChallenge" Public.setTeamFeatureConfig False False + +testOutlookCalIntegration :: HasCallStack => App () +testOutlookCalIntegration = _testSimpleFlagWithLockStatus "outlookCalIntegration" Public.setTeamFeatureConfig False False + +testConversationGuestLinksInternal :: HasCallStack => App () +testConversationGuestLinksInternal = _testSimpleFlagWithLockStatus "conversationGuestLinks" Internal.setTeamFeatureConfig True True + +testFileSharingInternal :: HasCallStack => App () +testFileSharingInternal = _testSimpleFlagWithLockStatus "fileSharing" Internal.setTeamFeatureConfig True True + +testSndFactorPasswordChallengeInternal :: HasCallStack => App () +testSndFactorPasswordChallengeInternal = _testSimpleFlagWithLockStatus "sndFactorPasswordChallenge" Internal.setTeamFeatureConfig False False + +testOutlookCalIntegrationInternal :: HasCallStack => App () +testOutlookCalIntegrationInternal = _testSimpleFlagWithLockStatus "outlookCalIntegration" Internal.setTeamFeatureConfig False False + +_testSimpleFlagWithLockStatus :: + HasCallStack => + String -> + (Value -> String -> String -> Value -> App Response) -> + Bool -> + Bool -> + App () +_testSimpleFlagWithLockStatus featureName setFeatureConfig featureEnabledByDefault featureUnlockedByDefault = do + -- let defaultStatus = if featureEnabledByDefault then "enabled" else "disabled" + defaultValue <- (if featureEnabledByDefault then enabled else disabled) & setField "lockStatus" (if featureUnlockedByDefault then "unlocked" else "locked") + let thisStatus = if featureEnabledByDefault then "enabled" else "disabled" + let otherStatus = if featureEnabledByDefault then "disabled" else "enabled" + + (owner, tid, m : _) <- createTeam OwnDomain 2 + nonTeamMember <- randomUser OwnDomain def + assertForbidden =<< Public.getTeamFeature nonTeamMember tid featureName + + checkFeature featureName m tid defaultValue + + -- unlock feature if it is locked + unless featureUnlockedByDefault $ Internal.setTeamFeatureLockStatus OwnDomain tid featureName "unlocked" + + -- change the status + let otherValue = if featureEnabledByDefault then disabled else enabled + void $ withWebSockets [m] $ \wss -> do + assertSuccess =<< setFeatureConfig owner tid featureName (object ["status" .= otherStatus]) + for_ wss $ \ws -> do + notif <- awaitMatch isFeatureConfigUpdateNotif ws + notif %. "payload.0.name" `shouldMatch` featureName + notif %. "payload.0.data" `shouldMatch` otherValue + + checkFeature featureName m tid otherValue + + bindResponse (setFeatureConfig owner tid featureName (object ["status" .= thisStatus])) $ \resp -> do + resp.status `shouldMatchInt` 200 + checkFeature featureName m tid (object ["status" .= thisStatus, "lockStatus" .= "unlocked", "ttl" .= "unlimited"]) + + bindResponse (setFeatureConfig owner tid featureName (object ["status" .= otherStatus])) $ \resp -> do + resp.status `shouldMatchInt` 200 + checkFeature featureName m tid (object ["status" .= otherStatus, "lockStatus" .= "unlocked", "ttl" .= "unlimited"]) + + -- lock feature + Internal.setTeamFeatureLockStatus OwnDomain tid featureName "locked" + + -- feature status should be the default again + checkFeature featureName m tid =<< setField "lockStatus" "locked" defaultValue + assertStatus 409 =<< setFeatureConfig owner tid featureName (object ["status" .= otherStatus]) + + -- unlock again + Internal.setTeamFeatureLockStatus OwnDomain tid featureName "unlocked" + + -- feature status should be the previously set status again + checkFeature featureName m tid =<< setField "lockStatus" "unlocked" otherValue + +testClassifiedDomainsEnabled :: HasCallStack => App () +testClassifiedDomainsEnabled = do + (_, tid, m : _) <- createTeam OwnDomain 2 + expected <- enabled & setField "config.domains" ["example.com"] + checkFeature "classifiedDomains" m tid expected + +testClassifiedDomainsDisabled :: HasCallStack => App () +testClassifiedDomainsDisabled = do + withModifiedBackend def {galleyCfg = setField "settings.featureFlags.classifiedDomains" (object ["status" .= "disabled", "config" .= object ["domains" .= ["example.com"]]])} $ \domain -> do + (_, tid, m : _) <- createTeam domain 2 + expected <- disabled & setField "config.domains" ["example.com"] + checkFeature "classifiedDomains" m tid expected + +-- | Call 'GET /teams/:tid/features' and 'GET /feature-configs', and check if all +-- features are there. +testAllFeatures :: HasCallStack => App () +testAllFeatures = do + (_, tid, m : _) <- createTeam OwnDomain 2 + let expected = + object $ + [ "legalhold" .= disabled, + "sso" .= disabled, + "searchVisibility" .= disabled, + "validateSAMLemails" .= enabled, + "digitalSignatures" .= disabled, + "appLock" .= object ["lockStatus" .= "unlocked", "status" .= "enabled", "ttl" .= "unlimited", "config" .= object ["enforceAppLock" .= False, "inactivityTimeoutSecs" .= A.Number 60]], + "fileSharing" .= enabled, + "classifiedDomains" .= object ["lockStatus" .= "unlocked", "status" .= "enabled", "ttl" .= "unlimited", "config" .= object ["domains" .= ["example.com"]]], + "conferenceCalling" .= enabled, + "selfDeletingMessages" .= object ["lockStatus" .= "unlocked", "status" .= "enabled", "ttl" .= "unlimited", "config" .= object ["enforcedTimeoutSeconds" .= A.Number 0]], + "conversationGuestLinks" .= enabled, + "sndFactorPasswordChallenge" .= disabledLocked, + "mls" + .= object + [ "lockStatus" .= "unlocked", + "status" .= "disabled", + "ttl" .= "unlimited", + "config" + .= object + [ "protocolToggleUsers" .= ([] :: [String]), + "defaultProtocol" .= "proteus", + "supportedProtocols" .= ["proteus", "mls"], + "allowedCipherSuites" .= ([1] :: [Int]), + "defaultCipherSuite" .= A.Number 1 + ] + ], + "searchVisibilityInbound" .= disabled, + "exposeInvitationURLsToTeamAdmin" .= disabledLocked, + "outlookCalIntegration" .= disabledLocked, + "mlsE2EId" + .= object + [ "lockStatus" .= "unlocked", + "status" .= "disabled", + "ttl" .= "unlimited", + "config" + .= object + [ "verificationExpiration" .= A.Number 86400, + "useProxyOnMobile" .= False + ] + ], + "mlsMigration" + .= object + [ "lockStatus" .= "locked", + "status" .= "enabled", + "ttl" .= "unlimited", + "config" + .= object + [ "startTime" .= "2029-05-16T10:11:12.123Z", + "finaliseRegardlessAfter" .= "2029-10-17T00:00:00Z" + ] + ], + "enforceFileDownloadLocation" .= object ["lockStatus" .= "locked", "status" .= "disabled", "ttl" .= "unlimited", "config" .= object []], + "limitedEventFanout" .= disabled + ] + bindResponse (Public.getTeamFeatures m tid) $ \resp -> do + resp.status `shouldMatchInt` 200 + expected `shouldMatch` resp.json + + -- This block catches potential errors in the logic that reverts to default if there is a distinction made between + -- 1. there is no row for a team_id in galley.team_features + -- 2. there is a row for team_id in galley.team_features but the feature has a no entry (null value) + Internal.setTeamFeatureConfig OwnDomain tid "conversationGuestLinks" enabled >>= assertSuccess + + bindResponse (Public.getTeamFeatures m tid) $ \resp -> do + resp.status `shouldMatchInt` 200 + expected `shouldMatch` resp.json + + bindResponse (Public.getFeatureConfigs m) $ \resp -> do + resp.status `shouldMatchInt` 200 + expected `shouldMatch` resp.json + + randomPersonalUser <- randomUser OwnDomain def + + bindResponse (Public.getFeatureConfigs randomPersonalUser) $ \resp -> do + resp.status `shouldMatchInt` 200 + expected `shouldMatch` resp.json + +testFeatureConfigConsistency :: HasCallStack => App () +testFeatureConfigConsistency = do + (_, tid, m : _) <- createTeam OwnDomain 2 + + allFeaturesRes <- Public.getFeatureConfigs m >>= parseObjectKeys + + allTeamFeaturesRes <- Public.getTeamFeatures m tid >>= parseObjectKeys + + unless (allTeamFeaturesRes `Set.isSubsetOf` allFeaturesRes) $ + assertFailure (show allTeamFeaturesRes <> " is not a subset of " <> show allFeaturesRes) + where + parseObjectKeys :: Response -> App (Set.Set String) + parseObjectKeys res = do + val <- res.json + case val of + (A.Object hm) -> pure (Set.fromList . map (show . A.toText) . KM.keys $ hm) + x -> assertFailure ("JSON was not an object, but " <> show x) + +testSelfDeletingMessages :: HasCallStack => App () +testSelfDeletingMessages = + _testLockStatusWithConfig + "selfDeletingMessages" + Public.setTeamFeatureConfig + (object ["lockStatus" .= "unlocked", "status" .= "enabled", "ttl" .= "unlimited", "config" .= object ["enforcedTimeoutSeconds" .= A.Number 0]]) + (object ["status" .= "disabled", "config" .= object ["enforcedTimeoutSeconds" .= A.Number 0]]) + (object ["status" .= "enabled", "config" .= object ["enforcedTimeoutSeconds" .= A.Number 30]]) + (object ["status" .= "enabled", "config" .= object ["enforcedTimeoutSeconds" .= ""]]) + +testSelfDeletingMessagesInternal :: HasCallStack => App () +testSelfDeletingMessagesInternal = + _testLockStatusWithConfig + "selfDeletingMessages" + Internal.setTeamFeatureConfig + (object ["lockStatus" .= "unlocked", "status" .= "enabled", "ttl" .= "unlimited", "config" .= object ["enforcedTimeoutSeconds" .= A.Number 0]]) + (object ["status" .= "disabled", "config" .= object ["enforcedTimeoutSeconds" .= A.Number 0]]) + (object ["status" .= "enabled", "config" .= object ["enforcedTimeoutSeconds" .= A.Number 30]]) + (object ["status" .= "enabled", "config" .= object ["enforcedTimeoutSeconds" .= ""]]) + +testMls :: HasCallStack => App () +testMls = do + user <- randomUser OwnDomain def + uid <- asString $ user %. "id" + _testLockStatusWithConfig + "mls" + Public.setTeamFeatureConfig + mlsDefaultConfig + (mlsConfig1 uid) + mlsConfig2 + mlsInvalidConfig + +testMlsInternal :: HasCallStack => App () +testMlsInternal = do + user <- randomUser OwnDomain def + uid <- asString $ user %. "id" + _testLockStatusWithConfig + "mls" + Internal.setTeamFeatureConfig + mlsDefaultConfig + (mlsConfig1 uid) + mlsConfig2 + mlsInvalidConfig + +mlsDefaultConfig :: Value +mlsDefaultConfig = + object + [ "lockStatus" .= "unlocked", + "status" .= "disabled", + "ttl" .= "unlimited", + "config" + .= object + [ "protocolToggleUsers" .= ([] :: [String]), + "defaultProtocol" .= "proteus", + "supportedProtocols" .= ["proteus", "mls"], + "allowedCipherSuites" .= ([1] :: [Int]), + "defaultCipherSuite" .= A.Number 1 + ] + ] + +mlsConfig1 :: String -> Value +mlsConfig1 uid = + object + [ "status" .= "enabled", + "config" + .= object + [ "protocolToggleUsers" .= [uid], + "defaultProtocol" .= "mls", + "supportedProtocols" .= ["proteus", "mls"], + "allowedCipherSuites" .= ([1] :: [Int]), + "defaultCipherSuite" .= A.Number 1 + ] + ] + +mlsConfig2 :: Value +mlsConfig2 = + object + [ "status" .= "enabled", + "config" + .= object + [ "protocolToggleUsers" .= ([] :: [String]), + "defaultProtocol" .= "mls", + "supportedProtocols" .= ["mls"], + "allowedCipherSuites" .= ([1] :: [Int]), + "defaultCipherSuite" .= A.Number 1 + ] + ] + +mlsInvalidConfig :: Value +mlsInvalidConfig = + object + [ "status" .= "enabled", + "config" + .= object + [ "protocolToggleUsers" .= ([] :: [String]), + "defaultProtocol" .= "mls", + "supportedProtocols" .= ["proteus"], + "allowedCipherSuites" .= ([1] :: [Int]), + "defaultCipherSuite" .= A.Number 1 + ] + ] + +testEnforceDownloadLocation :: HasCallStack => App () +testEnforceDownloadLocation = + _testLockStatusWithConfig + "enforceFileDownloadLocation" + Public.setTeamFeatureConfig + (object ["lockStatus" .= "locked", "status" .= "disabled", "ttl" .= "unlimited", "config" .= object []]) + (object ["status" .= "enabled", "config" .= object ["enforcedDownloadLocation" .= "/tmp"]]) + (object ["status" .= "disabled", "config" .= object []]) + (object ["status" .= "enabled", "config" .= object ["enforcedDownloadLocation" .= object []]]) + +testEnforceDownloadLocationInternal :: HasCallStack => App () +testEnforceDownloadLocationInternal = + _testLockStatusWithConfig + "enforceFileDownloadLocation" + Internal.setTeamFeatureConfig + (object ["lockStatus" .= "locked", "status" .= "disabled", "ttl" .= "unlimited", "config" .= object []]) + (object ["status" .= "enabled", "config" .= object ["enforcedDownloadLocation" .= "/tmp"]]) + (object ["status" .= "disabled", "config" .= object []]) + (object ["status" .= "enabled", "config" .= object ["enforcedDownloadLocation" .= object []]]) + +testMlsMigration :: HasCallStack => App () +testMlsMigration = do + -- first we have to enable mls + (owner, tid, m : _) <- createTeam OwnDomain 2 + assertSuccess =<< Public.setTeamFeatureConfig owner tid "mls" mlsEnableConfig + _testLockStatusWithConfigWithTeam + (owner, tid, m) + "mlsMigration" + Public.setTeamFeatureConfig + mlsMigrationDefaultConfig + mlsMigrationConfig1 + mlsMigrationConfig2 + mlsMigrationInvalidConfig + +testMlsMigrationInternal :: HasCallStack => App () +testMlsMigrationInternal = do + -- first we have to enable mls + (owner, tid, m : _) <- createTeam OwnDomain 2 + assertSuccess =<< Public.setTeamFeatureConfig owner tid "mls" mlsEnableConfig + _testLockStatusWithConfigWithTeam + (owner, tid, m) + "mlsMigration" + Internal.setTeamFeatureConfig + mlsMigrationDefaultConfig + mlsMigrationConfig1 + mlsMigrationConfig2 + mlsMigrationInvalidConfig + +mlsEnableConfig :: Value +mlsEnableConfig = + object + [ "status" .= "enabled", + "config" + .= object + [ "protocolToggleUsers" .= ([] :: [String]), + "defaultProtocol" .= "mls", + "supportedProtocols" .= ["mls"], + "allowedCipherSuites" .= ([1] :: [Int]), + "defaultCipherSuite" .= A.Number 1 + ] + ] + +mlsMigrationDefaultConfig :: Value +mlsMigrationDefaultConfig = + object + [ "lockStatus" .= "locked", + "status" .= "enabled", + "ttl" .= "unlimited", + "config" + .= object + [ "startTime" .= "2029-05-16T10:11:12.123Z", + "finaliseRegardlessAfter" .= "2029-10-17T00:00:00Z" + ] + ] + +mlsMigrationConfig1 :: Value +mlsMigrationConfig1 = + object + [ "status" .= "enabled", + "config" + .= object + [ "startTime" .= "2029-05-16T10:11:12.123Z", + "finaliseRegardlessAfter" .= "2030-10-17T00:00:00Z" + ] + ] + +mlsMigrationConfig2 :: Value +mlsMigrationConfig2 = + object + [ "status" .= "enabled", + "config" + .= object + [ "startTime" .= "2030-05-16T10:11:12.123Z", + "finaliseRegardlessAfter" .= "2031-10-17T00:00:00Z" + ] + ] + +mlsMigrationInvalidConfig :: Value +mlsMigrationInvalidConfig = + object + [ "status" .= "enabled", + "config" + .= object + [ "startTime" .= A.Number 1 + ] + ] + +mlsE2EIdConfig :: App (Value, Value, Value, Value) +mlsE2EIdConfig = do + cfg2 <- + mlsE2EIdConfig1 + & setField "config.verificationExpiration" (A.Number 86401) + & setField "config.useProxyOnMobile" True + invalidConfig <- cfg2 & removeField "config.crlProxy" + pure (mlsE2EIdDefConfig, mlsE2EIdConfig1, cfg2, invalidConfig) + where + mlsE2EIdDefConfig :: Value + mlsE2EIdDefConfig = + object + [ "lockStatus" .= "unlocked", + "status" .= "disabled", + "ttl" .= "unlimited", + "config" + .= object + [ "verificationExpiration" .= A.Number 86400, + "useProxyOnMobile" .= False + ] + ] + mlsE2EIdConfig1 :: Value + mlsE2EIdConfig1 = + object + [ "status" .= "enabled", + "config" + .= object + [ "crlProxy" .= "https://example.com", + "verificationExpiration" .= A.Number 86400, + "useProxyOnMobile" .= False + ] + ] + +testMLSE2EId :: HasCallStack => App () +testMLSE2EId = do + (defCfg, cfg1, cfg2, invalidCfg) <- mlsE2EIdConfig + _testLockStatusWithConfig + "mlsE2EId" + Public.setTeamFeatureConfig + defCfg + cfg1 + cfg2 + invalidCfg + +testMLSE2EIdInternal :: HasCallStack => App () +testMLSE2EIdInternal = do + (defCfg, cfg1, cfg2, invalidCfg) <- mlsE2EIdConfig + -- the internal API is not as strict as the public one, so we need to tweak the invalid config some more + invalidCfg' <- invalidCfg & setField "config.crlProxy" (object []) + _testLockStatusWithConfig + "mlsE2EId" + Internal.setTeamFeatureConfig + defCfg + cfg1 + cfg2 + invalidCfg' + +_testLockStatusWithConfig :: + HasCallStack => + String -> + (Value -> String -> String -> Value -> App Response) -> + -- | the default feature config (should include the lock status and ttl, as it is returned by the API) + Value -> + -- | a valid config used to update the feature setting (should not include the lock status and ttl, as these are not part of the request payload) + Value -> + -- | another valid config + Value -> + -- | an invalid config + Value -> + App () +_testLockStatusWithConfig featureName setTeamFeatureConfig defaultFeatureConfig config1 config2 invalidConfig = do + (owner, tid, m : _) <- createTeam OwnDomain 2 + _testLockStatusWithConfigWithTeam (owner, tid, m) featureName setTeamFeatureConfig defaultFeatureConfig config1 config2 invalidConfig + +_testLockStatusWithConfigWithTeam :: + HasCallStack => + -- | (owner, tid, member) + (Value, String, Value) -> + String -> + (Value -> String -> String -> Value -> App Response) -> + -- | the default feature config (should include the lock status and ttl, as it is returned by the API) + Value -> + -- | a valid config used to update the feature setting (should not include the lock status and ttl, as these are not part of the request payload) + Value -> + -- | another valid config + Value -> + -- | an invalid config + Value -> + App () +_testLockStatusWithConfigWithTeam (owner, tid, m) featureName setTeamFeatureConfig defaultFeatureConfig config1 config2 invalidConfig = do + -- personal user + randomPersonalUser <- randomUser OwnDomain def + + bindResponse (Public.getFeatureConfigs randomPersonalUser) $ \resp -> do + resp.status `shouldMatchInt` 200 + resp.json %. featureName `shouldMatch` defaultFeatureConfig + + -- team user + nonTeamMember <- randomUser OwnDomain def + assertForbidden =<< Public.getTeamFeature nonTeamMember tid featureName + + checkFeature featureName m tid defaultFeatureConfig + + -- lock the feature + Internal.setTeamFeatureLockStatus OwnDomain tid featureName "locked" + assertStatus 409 =<< setTeamFeatureConfig owner tid featureName config1 + Internal.setTeamFeatureLockStatus OwnDomain tid featureName "unlocked" + + void $ withWebSockets [m] $ \wss -> do + assertSuccess =<< setTeamFeatureConfig owner tid featureName config1 + for_ wss $ \ws -> do + notif <- awaitMatch isFeatureConfigUpdateNotif ws + notif %. "payload.0.name" `shouldMatch` featureName + notif %. "payload.0.data" `shouldMatch` (config1 & setField "lockStatus" "unlocked" & setField "ttl" "unlimited") + + checkFeature featureName m tid =<< (config1 & setField "lockStatus" "unlocked" & setField "ttl" "unlimited") + + Internal.setTeamFeatureLockStatus OwnDomain tid featureName "locked" + checkFeature featureName m tid =<< setField "lockStatus" "locked" defaultFeatureConfig + Internal.setTeamFeatureLockStatus OwnDomain tid featureName "unlocked" + + void $ withWebSockets [m] $ \wss -> do + assertStatus 400 =<< setTeamFeatureConfig owner tid featureName invalidConfig + for_ wss $ assertNoEvent 2 + + checkFeature featureName m tid =<< (config1 & setField "lockStatus" "unlocked" & setField "ttl" "unlimited") + + void $ withWebSockets [m] $ \wss -> do + assertSuccess =<< setTeamFeatureConfig owner tid featureName config2 + for_ wss $ \ws -> do + notif <- awaitMatch isFeatureConfigUpdateNotif ws + notif %. "payload.0.name" `shouldMatch` featureName + notif %. "payload.0.data" `shouldMatch` (config2 & setField "lockStatus" "unlocked" & setField "ttl" "unlimited") + + checkFeature featureName m tid =<< (config2 & setField "lockStatus" "unlocked" & setField "ttl" "unlimited") + +testFeatureNoConfigMultiSearchVisibilityInbound :: HasCallStack => App () +testFeatureNoConfigMultiSearchVisibilityInbound = do + (_owner1, team1, _) <- createTeam OwnDomain 0 + (_owner2, team2, _) <- createTeam OwnDomain 0 + + assertSuccess =<< Internal.setTeamFeatureStatus OwnDomain team2 "searchVisibilityInbound" "enabled" + + response <- Internal.getFeatureStatusMulti OwnDomain "searchVisibilityInbound" [team1, team2] + + statuses <- response.json %. "default_status" >>= asList + length statuses `shouldMatchInt` 2 + statuses `shouldMatchSet` [object ["team" .= team1, "status" .= "disabled"], object ["team" .= team2, "status" .= "enabled"]] + +testConferenceCallingTTLIncreaseToUnlimited :: HasCallStack => App () +testConferenceCallingTTLIncreaseToUnlimited = _testSimpleFlagTTLOverride "conferenceCalling" True (Just 2) Nothing + +testConferenceCallingTTLIncrease :: HasCallStack => App () +testConferenceCallingTTLIncrease = _testSimpleFlagTTLOverride "conferenceCalling" True (Just 2) (Just 4) + +testConferenceCallingTTLReduceFromUnlimited :: HasCallStack => App () +testConferenceCallingTTLReduceFromUnlimited = _testSimpleFlagTTLOverride "conferenceCalling" True Nothing (Just 2) + +testConferenceCallingTTLReduce :: HasCallStack => App () +testConferenceCallingTTLReduce = _testSimpleFlagTTLOverride "conferenceCalling" True (Just 5) (Just 2) + +testConferenceCallingTTLUnlimitedToUnlimited :: HasCallStack => App () +testConferenceCallingTTLUnlimitedToUnlimited = _testSimpleFlagTTLOverride "conferenceCalling" True Nothing Nothing + +_testSimpleFlagTTLOverride :: HasCallStack => String -> Bool -> Maybe Int -> Maybe Int -> App () +_testSimpleFlagTTLOverride featureName enabledByDefault mTtl mTtlAfter = do + let ttl = maybe (A.String . cs $ "unlimited") (A.Number . fromIntegral) mTtl + let ttlAfter = maybe (A.String . cs $ "unlimited") (A.Number . fromIntegral) mTtlAfter + (owner, tid, _) <- createTeam OwnDomain 0 + let (defaultValue, otherValue) = if enabledByDefault then ("enabled", "disabled") else ("disabled", "enabled") + + -- Initial value should be the default value + let defFeatureStatus = object ["status" .= defaultValue, "ttl" .= "unlimited", "lockStatus" .= "unlocked"] + checkFeature featureName owner tid defFeatureStatus + + -- Setting should work + assertSuccess =<< Internal.setTeamFeatureConfig OwnDomain tid featureName (object ["status" .= otherValue, "ttl" .= ttl]) + checkFeatureLenientTtl featureName owner tid (object ["status" .= otherValue, "ttl" .= ttl, "lockStatus" .= "unlocked"]) + + case (mTtl, mTtlAfter) of + (Just d, Just d') -> do + -- wait less than expiration, override and recheck. + liftIO $ threadDelay (d * 1000000 `div` 2) -- waiting half of TTL + -- setFlagInternal otherValue ttlAfter + assertSuccess =<< Internal.setTeamFeatureConfig OwnDomain tid featureName (object ["status" .= otherValue, "ttl" .= ttlAfter]) + -- value is still correct + checkFeatureLenientTtl featureName owner tid (object ["status" .= otherValue, "ttl" .= ttlAfter, "lockStatus" .= "unlocked"]) + + liftIO $ threadDelay (d' * 1000000) -- waiting for new TTL + checkFeatureLenientTtl featureName owner tid defFeatureStatus + (Just d, Nothing) -> do + -- wait less than expiration, override and recheck. + liftIO $ threadDelay (d * 1000000 `div` 2) -- waiting half of TTL + assertSuccess =<< Internal.setTeamFeatureConfig OwnDomain tid featureName (object ["status" .= otherValue, "ttl" .= ttlAfter]) + -- value is still correct + checkFeatureLenientTtl featureName owner tid (object ["status" .= otherValue, "ttl" .= ttlAfter, "lockStatus" .= "unlocked"]) + (Nothing, Nothing) -> do + -- overriding in this case should have no effect. + assertSuccess =<< Internal.setTeamFeatureConfig OwnDomain tid featureName (object ["status" .= otherValue, "ttl" .= ttl]) + checkFeatureLenientTtl featureName owner tid (object ["status" .= otherValue, "ttl" .= ttl, "lockStatus" .= "unlocked"]) + (Nothing, Just d) -> do + assertSuccess =<< Internal.setTeamFeatureConfig OwnDomain tid featureName (object ["status" .= otherValue, "ttl" .= ttlAfter]) + checkFeatureLenientTtl featureName owner tid (object ["status" .= otherValue, "ttl" .= ttlAfter, "lockStatus" .= "unlocked"]) + liftIO $ threadDelay (d * 1000000) -- waiting it out + -- value reverts back + checkFeatureLenientTtl featureName owner tid defFeatureStatus + +-------------------------------------------------------------------------------- +-- Simple flags with implicit lock status + +testPatchSearchVisibility :: HasCallStack => App () +testPatchSearchVisibility = _testPatch "searchVisibility" False disabled enabled + +testPatchValidateSAMLEmails :: HasCallStack => App () +testPatchValidateSAMLEmails = _testPatch "validateSAMLemails" False enabled disabled + +testPatchDigitalSignatures :: HasCallStack => App () +testPatchDigitalSignatures = _testPatch "digitalSignatures" False disabled enabled + +testPatchConferenceCalling :: HasCallStack => App () +testPatchConferenceCalling = _testPatch "conferenceCalling" False enabled disabled + +-------------------------------------------------------------------------------- +-- Simple flags with explicit lock status + +testPatchFileSharing :: HasCallStack => App () +testPatchFileSharing = _testPatch "fileSharing" True enabled disabled + +testPatchGuestLinks :: HasCallStack => App () +testPatchGuestLinks = _testPatch "conversationGuestLinks" True enabled disabled + +testPatchSndFactorPasswordChallenge :: HasCallStack => App () +testPatchSndFactorPasswordChallenge = _testPatch "sndFactorPasswordChallenge" True disabledLocked enabled + +testPatchOutlookCalIntegration :: HasCallStack => App () +testPatchOutlookCalIntegration = _testPatch "outlookCalIntegration" True disabledLocked enabled + +-------------------------------------------------------------------------------- +-- Flags with config & implicit lock status + +testPatchAppLock :: HasCallStack => App () +testPatchAppLock = do + let defCfg = + object + [ "lockStatus" .= "unlocked", + "status" .= "enabled", + "ttl" .= "unlimited", + "config" .= object ["enforceAppLock" .= False, "inactivityTimeoutSecs" .= A.Number 60] + ] + _testPatch "appLock" False defCfg (object ["lockStatus" .= "locked"]) + _testPatch "appLock" False defCfg (object ["status" .= "disabled"]) + _testPatch "appLock" False defCfg (object ["lockStatus" .= "locked", "status" .= "disabled"]) + _testPatch "appLock" False defCfg (object ["lockStatus" .= "unlocked", "config" .= object ["enforceAppLock" .= True, "inactivityTimeoutSecs" .= A.Number 120]]) + _testPatch "appLock" False defCfg (object ["config" .= object ["enforceAppLock" .= True, "inactivityTimeoutSecs" .= A.Number 240]]) + +-------------------------------------------------------------------------------- +-- Flags with config & explicit lock status + +testPatchSelfDeletingMessages :: HasCallStack => App () +testPatchSelfDeletingMessages = do + let defCfg = + object + [ "lockStatus" .= "unlocked", + "status" .= "enabled", + "ttl" .= "unlimited", + "config" .= object ["enforcedTimeoutSeconds" .= A.Number 0] + ] + _testPatch "selfDeletingMessages" True defCfg (object ["lockStatus" .= "locked"]) + _testPatch "selfDeletingMessages" True defCfg (object ["status" .= "disabled"]) + _testPatch "selfDeletingMessages" True defCfg (object ["lockStatus" .= "locked", "status" .= "disabled"]) + _testPatch "selfDeletingMessages" True defCfg (object ["lockStatus" .= "unlocked", "config" .= object ["enforcedTimeoutSeconds" .= A.Number 30]]) + _testPatch "selfDeletingMessages" True defCfg (object ["config" .= object ["enforcedTimeoutSeconds" .= A.Number 60]]) + +testPatchEnforceFileDownloadLocation :: HasCallStack => App () +testPatchEnforceFileDownloadLocation = do + let defCfg = + object + [ "lockStatus" .= "locked", + "status" .= "disabled", + "ttl" .= "unlimited", + "config" .= object [] + ] + _testPatch "enforceFileDownloadLocation" True defCfg (object ["lockStatus" .= "unlocked"]) + _testPatch "enforceFileDownloadLocation" True defCfg (object ["status" .= "enabled"]) + _testPatch "enforceFileDownloadLocation" True defCfg (object ["lockStatus" .= "unlocked", "status" .= "enabled"]) + _testPatch "enforceFileDownloadLocation" True defCfg (object ["lockStatus" .= "locked", "config" .= object []]) + _testPatch "enforceFileDownloadLocation" True defCfg (object ["config" .= object ["enforcedDownloadLocation" .= "/tmp"]]) + +testPatchE2EId :: HasCallStack => App () +testPatchE2EId = do + let defCfg = + object + [ "lockStatus" .= "unlocked", + "status" .= "disabled", + "ttl" .= "unlimited", + "config" + .= object + [ "verificationExpiration" .= A.Number 86400, + "useProxyOnMobile" .= False + ] + ] + _testPatch "mlsE2EId" True defCfg (object ["lockStatus" .= "locked"]) + _testPatch "mlsE2EId" True defCfg (object ["status" .= "enabled"]) + _testPatch "mlsE2EId" True defCfg (object ["lockStatus" .= "locked", "status" .= "enabled"]) + _testPatch + "mlsE2EId" + True + defCfg + ( object + [ "lockStatus" .= "unlocked", + "config" + .= object + [ "crlProxy" .= "https://example.com", + "verificationExpiration" .= A.Number 86401, + "useProxyOnMobile" .= True + ] + ] + ) + _testPatch + "mlsE2EId" + True + defCfg + ( object + [ "config" + .= object + [ "crlProxy" .= "https://example.com", + "verificationExpiration" .= A.Number 86401, + "useProxyOnMobile" .= True + ] + ] + ) + +testPatchMLS :: HasCallStack => App () +testPatchMLS = do + dom <- asString OwnDomain + (_, tid, _) <- createTeam dom 0 + assertSuccess + =<< Internal.patchTeamFeature + dom + tid + "mlsMigration" + (object ["status" .= "disabled", "lockStatus" .= "unlocked"]) + let defCfg = + object + [ "lockStatus" .= "unlocked", + "status" .= "disabled", + "ttl" .= "unlimited", + "config" + .= object + [ "protocolToggleUsers" .= ([] :: [String]), + "defaultProtocol" .= "proteus", + "supportedProtocols" .= ["proteus", "mls"], + "allowedCipherSuites" .= ([1] :: [Int]), + "defaultCipherSuite" .= A.Number 1 + ] + ] + _testPatchWithSetup mlsMigrationSetup dom "mls" True defCfg (object ["lockStatus" .= "locked"]) + _testPatchWithSetup mlsMigrationSetup dom "mls" True defCfg (object ["status" .= "enabled"]) + _testPatchWithSetup mlsMigrationSetup dom "mls" True defCfg (object ["lockStatus" .= "locked", "status" .= "enabled"]) + _testPatchWithSetup + mlsMigrationSetup + dom + "mls" + True + defCfg + ( object + [ "status" .= "enabled", + "config" + .= object + [ "protocolToggleUsers" .= ([] :: [String]), + "defaultProtocol" .= "mls", + "supportedProtocols" .= ["proteus", "mls"], + "allowedCipherSuites" .= ([1] :: [Int]), + "defaultCipherSuite" .= A.Number 1 + ] + ] + ) + _testPatchWithSetup + mlsMigrationSetup + dom + "mls" + True + defCfg + ( object + [ "config" + .= object + [ "protocolToggleUsers" .= ([] :: [String]), + "defaultProtocol" .= "mls", + "supportedProtocols" .= ["proteus", "mls"], + "allowedCipherSuites" .= ([1] :: [Int]), + "defaultCipherSuite" .= A.Number 1 + ] + ] + ) + where + mlsMigrationSetup :: HasCallStack => String -> String -> App () + mlsMigrationSetup dom tid = + assertSuccess + =<< Internal.patchTeamFeature + dom + tid + "mlsMigration" + (object ["status" .= "disabled", "lockStatus" .= "unlocked"]) + +_testPatch :: HasCallStack => String -> Bool -> Value -> Value -> App () +_testPatch featureName hasExplicitLockStatus defaultFeatureConfig patch = do + dom <- asString OwnDomain + _testPatchWithSetup + (\_ _ -> pure ()) + dom + featureName + hasExplicitLockStatus + defaultFeatureConfig + patch + +_testPatchWithSetup :: + HasCallStack => + (String -> String -> App ()) -> + String -> + String -> + Bool -> + Value -> + Value -> + App () +_testPatchWithSetup setup domain featureName hasExplicitLockStatus defaultFeatureConfig patch = do + (owner, tid, _) <- createTeam domain 0 + -- run a feature-specific setup. For most features this is a no-op. + setup domain tid + + checkFeature featureName owner tid defaultFeatureConfig + assertSuccess =<< Internal.patchTeamFeature domain tid featureName patch + patched <- (.json) =<< Internal.getTeamFeature domain tid featureName + checkFeature featureName owner tid patched + lockStatus <- patched %. "lockStatus" >>= asString + if lockStatus == "locked" + then do + -- if lock status is locked the feature status should fall back to the default + patched `shouldMatch` (defaultFeatureConfig & setField "lockStatus" "locked") + -- if lock status is locked, it was either locked before or changed by the patch + mPatchedLockStatus <- lookupField patch "lockStatus" + case mPatchedLockStatus of + Just ls -> ls `shouldMatch` "locked" + Nothing -> defaultFeatureConfig %. "lockStatus" `shouldMatch` "locked" + else do + patched %. "status" `shouldMatch` valueOrDefault "status" + mPatchedConfig <- lookupField patched "config" + case mPatchedConfig of + Just patchedConfig -> patchedConfig `shouldMatch` valueOrDefault "config" + Nothing -> do + mDefConfig <- lookupField defaultFeatureConfig "config" + assertBool "patch had an unexpected config field" (isNothing mDefConfig) + + when hasExplicitLockStatus $ do + -- if lock status is unlocked, it was either unlocked before or changed by the patch + mPatchedLockStatus <- lookupField patch "lockStatus" + case mPatchedLockStatus of + Just ls -> ls `shouldMatch` "unlocked" + Nothing -> defaultFeatureConfig %. "lockStatus" `shouldMatch` "unlocked" + where + valueOrDefault :: String -> App Value + valueOrDefault key = do + mValue <- lookupField patch key + maybe (defaultFeatureConfig %. key) pure mValue diff --git a/integration/test/Test/FeatureFlags/Util.hs b/integration/test/Test/FeatureFlags/Util.hs new file mode 100644 index 00000000000..c03959919dd --- /dev/null +++ b/integration/test/Test/FeatureFlags/Util.hs @@ -0,0 +1,86 @@ +-- This file is part of the Wire Server implementation. +-- +-- Copyright (C) 2023 Wire Swiss GmbH +-- +-- This program is free software: you can redistribute it and/or modify it under +-- the terms of the GNU Affero General Public License as published by the Free +-- Software Foundation, either version 3 of the License, or (at your option) any +-- later version. +-- +-- This program is distributed in the hope that it will be useful, but WITHOUT +-- ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS +-- FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for more +-- details. +-- +-- You should have received a copy of the GNU Affero General Public License along +-- with this program. If not, see . + +module Test.FeatureFlags.Util where + +import qualified API.Galley as Public +import qualified API.GalleyInternal as Internal +import qualified Data.Aeson as A +import Testlib.Prelude + +disabled :: Value +disabled = object ["lockStatus" .= "unlocked", "status" .= "disabled", "ttl" .= "unlimited"] + +disabledLocked :: Value +disabledLocked = object ["lockStatus" .= "locked", "status" .= "disabled", "ttl" .= "unlimited"] + +enabled :: Value +enabled = object ["lockStatus" .= "unlocked", "status" .= "enabled", "ttl" .= "unlimited"] + +checkFeature :: (HasCallStack, MakesValue user, MakesValue tid) => String -> user -> tid -> Value -> App () +checkFeature = checkFeatureWith shouldMatch + +checkFeatureWith :: (HasCallStack, MakesValue user, MakesValue tid, MakesValue expected) => (App Value -> expected -> App ()) -> String -> user -> tid -> expected -> App () +checkFeatureWith shouldMatch' feature user tid expected = do + tidStr <- asString tid + domain <- objDomain user + bindResponse (Internal.getTeamFeature domain tidStr feature) $ \resp -> do + resp.status `shouldMatchInt` 200 + resp.json `shouldMatch'` expected + bindResponse (Public.getTeamFeatures user tid) $ \resp -> do + resp.status `shouldMatchInt` 200 + resp.json %. feature `shouldMatch'` expected + bindResponse (Public.getTeamFeature user tid feature) $ \resp -> do + resp.status `shouldMatchInt` 200 + resp.json `shouldMatch'` expected + bindResponse (Public.getFeatureConfigs user) $ \resp -> do + resp.status `shouldMatchInt` 200 + resp.json %. feature `shouldMatch'` expected + +checkFeatureLenientTtl :: (HasCallStack, MakesValue user, MakesValue tid) => String -> user -> tid -> Value -> App () +checkFeatureLenientTtl = checkFeatureWith shouldMatchLenientTtl + where + shouldMatchLenientTtl :: App Value -> Value -> App () + shouldMatchLenientTtl actual expected = do + expectedLockStatus <- expected %. "lockStatus" + actual %. "lockStatus" `shouldMatch` expectedLockStatus + expectedStatus <- expected %. "status" + actual %. "status" `shouldMatch` expectedStatus + mExpectedConfig <- lookupField expected "config" + mActualConfig <- lookupField actual "config" + mActualConfig `shouldMatch` mExpectedConfig + expectedTtl <- expected %. "ttl" + actualTtl <- actual %. "ttl" + checkTtl actualTtl expectedTtl + + checkTtl :: Value -> Value -> App () + checkTtl (A.String a) (A.String b) = do + a `shouldMatch` "unlimited" + b `shouldMatch` "unlimited" + checkTtl _ (A.String _) = assertFailure "expected the actual ttl to be unlimited, but it was limited" + checkTtl (A.String _) _ = assertFailure "expected the actual ttl to be limited, but it was unlimited" + checkTtl (A.Number actualTtl) (A.Number expectedTtl) = do + assertBool + ("expected the actual TTL to be greater than 0 and equal to or no more than 2 seconds less than " <> show expectedTtl <> ", but it was " <> show actualTtl) + ( actualTtl > 0 + && actualTtl <= expectedTtl + && abs (actualTtl - expectedTtl) <= 2 + ) + checkTtl _ _ = assertFailure "unexpected ttl value(s)" + +assertForbidden :: HasCallStack => Response -> App () +assertForbidden = assertLabel 403 "no-team-member" diff --git a/integration/test/Test/Login.hs b/integration/test/Test/Login.hs index b16f5ec3074..c5ca8b2d513 100644 --- a/integration/test/Test/Login.hs +++ b/integration/test/Test/Login.hs @@ -17,7 +17,7 @@ testLoginVerify6DigitEmailCodeSuccess = do (owner, team, []) <- createTeam OwnDomain 0 email <- owner %. "email" setTeamFeatureLockStatus owner team "sndFactorPasswordChallenge" "unlocked" - setTeamFeatureStatus owner team "sndFactorPasswordChallenge" "enabled" + assertSuccess =<< setTeamFeatureStatus owner team "sndFactorPasswordChallenge" "enabled" generateVerificationCode owner email code <- getVerificationCode owner "login" >>= getJSON 200 >>= asString bindResponse (loginWith2ndFactor owner email defPassword code) $ \resp -> do @@ -30,7 +30,7 @@ testLoginVerify6DigitWrongCodeFails = do (owner, team, []) <- createTeam OwnDomain 0 email <- owner %. "email" setTeamFeatureLockStatus owner team "sndFactorPasswordChallenge" "unlocked" - setTeamFeatureStatus owner team "sndFactorPasswordChallenge" "enabled" + assertSuccess =<< setTeamFeatureStatus owner team "sndFactorPasswordChallenge" "enabled" generateVerificationCode owner email correctCode <- getVerificationCode owner "login" >>= getJSON 200 >>= asString let wrongCode :: String = printf "%06d" $ (read @Int correctCode) + 1 `mod` 1000000 @@ -45,7 +45,7 @@ testLoginVerify6DigitMissingCodeFails = do (owner, team, []) <- createTeam OwnDomain 0 email <- owner %. "email" setTeamFeatureLockStatus owner team "sndFactorPasswordChallenge" "unlocked" - setTeamFeatureStatus owner team "sndFactorPasswordChallenge" "enabled" + assertSuccess =<< setTeamFeatureStatus owner team "sndFactorPasswordChallenge" "enabled" bindResponse (login owner email defPassword) $ \resp -> do resp.status `shouldMatchInt` 403 resp.json %. "label" `shouldMatch` "code-authentication-required" @@ -60,7 +60,7 @@ testLoginVerify6DigitExpiredCodeFails = do (owner, team, []) <- createTeam domain 0 email <- owner %. "email" setTeamFeatureLockStatus owner team "sndFactorPasswordChallenge" "unlocked" - setTeamFeatureStatus owner team "sndFactorPasswordChallenge" "enabled" + assertSuccess =<< setTeamFeatureStatus owner team "sndFactorPasswordChallenge" "enabled" bindResponse (getTeamFeature owner team "sndFactorPasswordChallenge") $ \resp -> do resp.status `shouldMatchInt` 200 resp.json %. "status" `shouldMatch` "enabled" @@ -78,7 +78,7 @@ testLoginVerify6DigitResendCodeSuccessAndRateLimiting = do (owner, team, []) <- createTeam OwnDomain 0 email <- owner %. "email" setTeamFeatureLockStatus owner team "sndFactorPasswordChallenge" "unlocked" - setTeamFeatureStatus owner team "sndFactorPasswordChallenge" "enabled" + assertSuccess =<< setTeamFeatureStatus owner team "sndFactorPasswordChallenge" "enabled" generateVerificationCode owner email fstCode <- getVerificationCode owner "login" >>= getJSON 200 >>= asString bindResponse (generateVerificationCode' owner email) $ \resp -> do @@ -100,7 +100,7 @@ testLoginVerify6DigitLimitRetries = do (owner, team, []) <- createTeam OwnDomain 0 email <- owner %. "email" setTeamFeatureLockStatus owner team "sndFactorPasswordChallenge" "unlocked" - setTeamFeatureStatus owner team "sndFactorPasswordChallenge" "enabled" + assertSuccess =<< setTeamFeatureStatus owner team "sndFactorPasswordChallenge" "enabled" generateVerificationCode owner email correctCode <- getVerificationCode owner "login" >>= getJSON 200 >>= asString let wrongCode :: String = printf "%06d" $ (read @Int correctCode) + 1 `mod` 1000000 diff --git a/integration/test/Test/Search.hs b/integration/test/Test/Search.hs index 7d93b4ff015..fab4fd54daa 100644 --- a/integration/test/Test/Search.hs +++ b/integration/test/Test/Search.hs @@ -112,7 +112,7 @@ federatedUserSearch d1 d2 test = do u2 <- randomUser d2 def {BrigI.team = True} uidD2 <- objId u2 team2 <- u2 %. "team" - GalleyI.setTeamFeatureStatus d2 team2 "searchVisibilityInbound" "enabled" + assertSuccess =<< GalleyI.setTeamFeatureStatus d2 team2 "searchVisibilityInbound" "enabled" addTeamRestriction d1 d2 team2 test.restrictionD1D2 addTeamRestriction d2 d1 teamU1 test.restrictionD2D1 @@ -167,7 +167,7 @@ testFederatedUserSearchNonTeamSearcher = do u1 <- randomUser d1 def u2 <- randomUser d2 def {BrigI.team = True} team2 <- u2 %. "team" - GalleyI.setTeamFeatureStatus d2 team2 "searchVisibilityInbound" "enabled" + assertSuccess =<< GalleyI.setTeamFeatureStatus d2 team2 "searchVisibilityInbound" "enabled" u2Handle <- API.randomHandle bindResponse (BrigP.putHandle u2 u2Handle) $ assertSuccess diff --git a/integration/test/Test/User.hs b/integration/test/Test/User.hs index 89af540d2eb..55fe4082550 100644 --- a/integration/test/Test/User.hs +++ b/integration/test/Test/User.hs @@ -66,7 +66,7 @@ testUpdateHandle = do bindResponse (getTeamFeature owner team featureName) $ \resp -> do resp.status `shouldMatchInt` 200 resp.json %. "status" `shouldMatch` "disabled" - setTeamFeatureStatus owner team featureName "enabled" + assertSuccess =<< setTeamFeatureStatus owner team featureName "enabled" bindResponse (getTeamFeature owner team featureName) $ \resp -> do resp.status `shouldMatchInt` 200 resp.json %. "status" `shouldMatch` "enabled" @@ -129,7 +129,7 @@ testUpdateSelf (MkTagged mode) = do bindResponse (getTeamFeature owner team featureName) $ \resp -> do resp.status `shouldMatchInt` 200 resp.json %. "status" `shouldMatch` "disabled" - setTeamFeatureStatus owner team featureName "enabled" + assertSuccess =<< setTeamFeatureStatus owner team featureName "enabled" bindResponse (getTeamFeature owner team featureName) $ \resp -> do resp.status `shouldMatchInt` 200 resp.json %. "status" `shouldMatch` "enabled" diff --git a/integration/test/Testlib/Cannon.hs b/integration/test/Testlib/Cannon.hs index 8ab338df38a..c6a57b66cce 100644 --- a/integration/test/Testlib/Cannon.hs +++ b/integration/test/Testlib/Cannon.hs @@ -38,6 +38,7 @@ module Testlib.Cannon printAwaitResult, printAwaitAtLeastResult, waitForResponse, + assertNoEvent, ) where @@ -463,6 +464,17 @@ awaitMatch :: App Value awaitMatch checkMatch ws = head <$> awaitNMatches 1 checkMatch ws +assertNoEvent :: + HasCallStack => + Int -> + WebSocket -> + App () +assertNoEvent to ws = do + mEvent <- awaitAnyEvent to ws + case mEvent of + Just event -> assertFailure $ "Expected no event, but got: " <> show event + Nothing -> pure () + nPayload :: MakesValue a => a -> App Value nPayload event = do payloads <- event %. "payload" & asList diff --git a/services/galley/default.nix b/services/galley/default.nix index 7985313dc72..26be21dac96 100644 --- a/services/galley/default.nix +++ b/services/galley/default.nix @@ -45,7 +45,6 @@ , gitignoreSource , gundeck-types , HsOpenSSL -, hspec , http-api-data , http-client , http-client-openssl @@ -246,7 +245,6 @@ mkDerivation { filepath galley-types HsOpenSSL - hspec http-api-data http-client http-client-openssl diff --git a/services/galley/galley.cabal b/services/galley/galley.cabal index 25e88c7ae18..b61df20ca8b 100644 --- a/services/galley/galley.cabal +++ b/services/galley/galley.cabal @@ -397,7 +397,6 @@ executable galley-integration API.Roles API.SQS API.Teams - API.Teams.Feature API.Teams.LegalHold API.Teams.LegalHold.DisabledByDefault API.Teams.LegalHold.Util @@ -489,7 +488,6 @@ executable galley-integration , galley , galley-types , HsOpenSSL - , hspec , http-api-data , http-client , http-client-openssl diff --git a/services/galley/test/integration/API.hs b/services/galley/test/integration/API.hs index b20fb577974..62c10b3e20a 100644 --- a/services/galley/test/integration/API.hs +++ b/services/galley/test/integration/API.hs @@ -32,7 +32,6 @@ import API.MessageTimer qualified as MessageTimer import API.Roles qualified as Roles import API.SQS import API.Teams qualified as Teams -import API.Teams.Feature qualified as TeamFeature import API.Teams.LegalHold qualified as Teams.LegalHold import API.Teams.LegalHold.DisabledByDefault qualified import API.Util @@ -120,7 +119,6 @@ tests s = MessageTimer.tests s, Roles.tests s, CustomBackend.tests s, - TeamFeature.tests s, Federation.tests s, API.MLS.tests s ] diff --git a/services/galley/test/integration/API/Teams/Feature.hs b/services/galley/test/integration/API/Teams/Feature.hs deleted file mode 100644 index 4e0ccdb3cca..00000000000 --- a/services/galley/test/integration/API/Teams/Feature.hs +++ /dev/null @@ -1,1401 +0,0 @@ --- This file is part of the Wire Server implementation. --- --- Copyright (C) 2022 Wire Swiss GmbH --- --- This program is free software: you can redistribute it and/or modify it under --- the terms of the GNU Affero General Public License as published by the Free --- Software Foundation, either version 3 of the License, or (at your option) any --- later version. --- - --- This program is distributed in the hope that it will be useful, but WITHOUT --- ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS --- FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for more --- details. --- --- You should have received a copy of the GNU Affero General Public License along --- with this program. If not, see . - -module API.Teams.Feature (tests) where - -import API.SQS (assertTeamActivate) -import API.Util -import API.Util.TeamFeature hiding (getFeatureConfig, setLockStatusInternal) -import API.Util.TeamFeature qualified as Util -import Bilge -import Bilge.Assert -import Brig.Types.Test.Arbitrary (Arbitrary (arbitrary)) -import Cassandra as Cql -import Control.Lens (over, to, view, (.~), (?~)) -import Control.Lens.Operators () -import Control.Monad.Catch (MonadCatch) -import Data.Aeson (FromJSON, ToJSON) -import Data.Aeson qualified as Aeson -import Data.Aeson.Key qualified as AesonKey -import Data.Aeson.KeyMap qualified as KeyMap -import Data.ByteString.Char8 (unpack) -import Data.Domain (Domain (..)) -import Data.Id -import Data.Json.Util (fromUTCTimeMillis, readUTCTimeMillis) -import Data.List1 qualified as List1 -import Data.Schema (ToSchema) -import Data.Set qualified as Set -import Data.Timeout (TimeoutUnit (Second), (#)) -import GHC.TypeLits (KnownSymbol) -import Galley.Options (exposeInvitationURLsTeamAllowlist, featureFlags, settings) -import Galley.Types.Teams -import Imports -import Network.Wai.Utilities (label) -import Test.Hspec (expectationFailure) -import Test.QuickCheck (Gen, generate, suchThat) -import Test.Tasty -import Test.Tasty.Cannon qualified as WS -import Test.Tasty.HUnit (assertFailure, (@?=)) -import TestHelpers (test) -import TestSetup -import Wire.API.Conversation.Protocol -import Wire.API.Event.FeatureConfig qualified as FeatureConfig -import Wire.API.Internal.Notification (Notification) -import Wire.API.MLS.CipherSuite -import Wire.API.Routes.Internal.Galley.TeamFeatureNoConfigMulti as Multi -import Wire.API.Team.Feature hiding (setLockStatus) - -tests :: IO TestSetup -> TestTree -tests s = - testGroup - "Feature Config API and Team Features API" - [ test s "SSO - set with HTTP PUT" (testSSO putSSOInternal), - test s "SSO - set with HTTP PATCH" (testSSO patchSSOInternal), - test s "LegalHold - set with HTTP PUT" (testLegalHold putLegalHoldInternal), - test s "LegalHold - set with HTTP PATCH" (testLegalHold patchLegalHoldInternal), - test s "SearchVisibility" testSearchVisibility, - test s "DigitalSignatures" $ testSimpleFlag @DigitalSignaturesConfig FeatureStatusDisabled, - test s "ValidateSAMLEmails" $ testSimpleFlag @ValidateSAMLEmailsConfig FeatureStatusEnabled, - test s "FileSharing with lock status" $ testSimpleFlagWithLockStatus @FileSharingConfig FeatureStatusEnabled LockStatusUnlocked, - test s "Classified Domains (enabled)" testClassifiedDomainsEnabled, - test s "Classified Domains (disabled)" testClassifiedDomainsDisabled, - test s "All features" testAllFeatures, - test s "Feature Configs / Team Features Consistency" testFeatureConfigConsistency, - test s "ConferenceCalling" $ testSimpleFlag @ConferenceCallingConfig FeatureStatusEnabled, - test s "SelfDeletingMessages" testSelfDeletingMessages, - test s "ConversationGuestLinks - public API" testGuestLinksPublic, - test s "ConversationGuestLinks - internal API" testGuestLinksInternal, - test s "ConversationGuestLinks - lock status" $ testSimpleFlagWithLockStatus @GuestLinksConfig FeatureStatusEnabled LockStatusUnlocked, - test s "SndFactorPasswordChallenge - lock status" $ testSimpleFlagWithLockStatus @SndFactorPasswordChallengeConfig FeatureStatusDisabled LockStatusLocked, - test s "SearchVisibilityInbound - internal API" testSearchVisibilityInbound, - test s "SearchVisibilityInbound - internal multi team API" testFeatureNoConfigMultiSearchVisibilityInbound, - test s "OutlookCalIntegration" $ testSimpleFlagWithLockStatus @OutlookCalIntegrationConfig FeatureStatusDisabled LockStatusLocked, - testGroup - "TTL / Conference calling" - [ test s "ConferenceCalling unlimited TTL" $ testSimpleFlagTTL @ConferenceCallingConfig FeatureStatusEnabled FeatureTTLUnlimited, - test s "ConferenceCalling 2s TTL" $ testSimpleFlagTTL @ConferenceCallingConfig FeatureStatusEnabled (FeatureTTLSeconds 2) - ], - testGroup - "TTL / Overrides" - [ test s "increase to unlimited" $ testSimpleFlagTTLOverride @ConferenceCallingConfig FeatureStatusEnabled (FeatureTTLSeconds 2) FeatureTTLUnlimited, - test s "increase" $ testSimpleFlagTTLOverride @ConferenceCallingConfig FeatureStatusEnabled (FeatureTTLSeconds 2) (FeatureTTLSeconds 4), - test s "reduce from unlimited" $ testSimpleFlagTTLOverride @ConferenceCallingConfig FeatureStatusEnabled FeatureTTLUnlimited (FeatureTTLSeconds 2), - test s "reduce" $ testSimpleFlagTTLOverride @ConferenceCallingConfig FeatureStatusEnabled (FeatureTTLSeconds 5) (FeatureTTLSeconds 2), - test s "Unlimited to unlimited" $ testSimpleFlagTTLOverride @ConferenceCallingConfig FeatureStatusEnabled FeatureTTLUnlimited FeatureTTLUnlimited - ], - test s "MLS feature config" testMLS, - test s "SearchVisibilityInbound" $ testSimpleFlag @SearchVisibilityInboundConfig FeatureStatusDisabled, - test s "MlsE2EId feature config" $ - testNonTrivialConfigNoTTL - ( withStatus - FeatureStatusDisabled - LockStatusUnlocked - (wsConfig (defFeatureStatus @MlsE2EIdConfig)) - FeatureTTLUnlimited - ), - test s "MlsMigration feature config" $ - testNonTrivialConfigNoTTL defaultMlsMigrationConfig, - test s "EnforceFileDownloadLocation feature config" $ - testNonTrivialConfigNoTTL (defFeatureStatus @EnforceFileDownloadLocationConfig), - testGroup - "Patch" - [ -- Note: `SSOConfig` and `LegalHoldConfig` may not be able to be reset - -- (depending on prior state or configuration). Thus, they cannot be - -- tested here (setting random values), but are tested with separate - -- tests. - test s (unpack $ featureNameBS @SearchVisibilityAvailableConfig) $ - testPatch IgnoreLockStatusChange FeatureStatusEnabled SearchVisibilityAvailableConfig, - test s (unpack $ featureNameBS @ValidateSAMLEmailsConfig) $ - testPatch IgnoreLockStatusChange FeatureStatusEnabled ValidateSAMLEmailsConfig, - test s (unpack $ featureNameBS @DigitalSignaturesConfig) $ - testPatch IgnoreLockStatusChange FeatureStatusEnabled DigitalSignaturesConfig, - test s (unpack $ featureNameBS @AppLockConfig) $ - testPatchWithCustomGen IgnoreLockStatusChange FeatureStatusEnabled (AppLockConfig (EnforceAppLock False) 60) validAppLockConfigGen, - test s (unpack $ featureNameBS @ConferenceCallingConfig) $ - testPatch IgnoreLockStatusChange FeatureStatusEnabled ConferenceCallingConfig, - test s (unpack $ featureNameBS @SearchVisibilityAvailableConfig) $ - testPatch IgnoreLockStatusChange FeatureStatusEnabled SearchVisibilityAvailableConfig, - test s (unpack $ featureNameBS @MLSConfig) $ - testPatchWithCustomGen - AssertLockStatusChange - FeatureStatusDisabled - ( MLSConfig - [] - ProtocolProteusTag - [MLS_128_DHKEMX25519_AES128GCM_SHA256_Ed25519] - MLS_128_DHKEMX25519_AES128GCM_SHA256_Ed25519 - [ProtocolProteusTag, ProtocolMLSTag] - ) - validMLSConfigGen, - test s (unpack $ featureNameBS @FileSharingConfig) $ - testPatch AssertLockStatusChange FeatureStatusEnabled FileSharingConfig, - test s (unpack $ featureNameBS @GuestLinksConfig) $ - testPatch AssertLockStatusChange FeatureStatusEnabled GuestLinksConfig, - test s (unpack $ featureNameBS @SndFactorPasswordChallengeConfig) $ - testPatch AssertLockStatusChange FeatureStatusDisabled SndFactorPasswordChallengeConfig, - test s (unpack $ featureNameBS @SelfDeletingMessagesConfig) $ - testPatch AssertLockStatusChange FeatureStatusEnabled (SelfDeletingMessagesConfig 0), - test s (unpack $ featureNameBS @OutlookCalIntegrationConfig) $ - testPatch AssertLockStatusChange FeatureStatusDisabled OutlookCalIntegrationConfig, - test s (unpack $ featureNameBS @MlsE2EIdConfig) $ - testPatchWithArbitrary AssertLockStatusChange FeatureStatusDisabled (wsConfig (defFeatureStatus @MlsE2EIdConfig)), - test s (unpack $ featureNameBS @EnforceFileDownloadLocationConfig) $ - testPatchWithArbitrary AssertLockStatusChange FeatureStatusDisabled (wsConfig (defFeatureStatus @EnforceFileDownloadLocationConfig)) - ], - testGroup - "ExposeInvitationURLsToTeamAdmin" - [ test s "can be set when TeamId is in allow list" testExposeInvitationURLsToTeamAdminTeamIdInAllowList, - test s "can not be set when allow list is empty" testExposeInvitationURLsToTeamAdminEmptyAllowList, - test s "server config takes precendece over team feature config" testExposeInvitationURLsToTeamAdminServerConfigTakesPrecedence - ] - ] - --- | Provides a `Gen` with test objects that are realistic and can easily be asserted -validMLSConfigGen :: Gen (WithStatusPatch MLSConfig) -validMLSConfigGen = - arbitrary - `suchThat` ( \cfg -> - case wspConfig cfg of - Just (MLSConfig us defProtocol cTags ctag supProtocol) -> - sortedAndNoDuplicates us - && sortedAndNoDuplicates cTags - && elem ctag cTags - && notElem ProtocolMixedTag supProtocol - && elem defProtocol supProtocol - && sortedAndNoDuplicates supProtocol - _ -> True - && Just FeatureStatusEnabled == wspStatus cfg - ) - where - sortedAndNoDuplicates xs = (sort . nub) xs == xs - -validAppLockConfigGen :: Gen (WithStatusPatch AppLockConfig) -validAppLockConfigGen = - arbitrary - `suchThat` ( \cfg -> case wspConfig cfg of - Just (AppLockConfig _ secs) -> secs >= 30 - Nothing -> True - ) - --- | Binary type to prevent "boolean blindness" -data AssertLockStatusChange = AssertLockStatusChange | IgnoreLockStatusChange - deriving (Eq) - -testPatchWithArbitrary :: - forall cfg. - ( HasCallStack, - IsFeatureConfig cfg, - Typeable cfg, - ToSchema cfg, - Eq cfg, - Show cfg, - KnownSymbol (FeatureSymbol cfg), - Arbitrary (WithStatusPatch cfg) - ) => - AssertLockStatusChange -> - FeatureStatus -> - cfg -> - TestM () -testPatchWithArbitrary assertLockStatusChange featureStatus cfg = do - generatedConfig <- liftIO $ generate arbitrary - testPatch' assertLockStatusChange generatedConfig featureStatus cfg - -testPatchWithCustomGen :: - forall cfg. - ( HasCallStack, - IsFeatureConfig cfg, - Typeable cfg, - ToSchema cfg, - Eq cfg, - Show cfg, - KnownSymbol (FeatureSymbol cfg) - ) => - AssertLockStatusChange -> - FeatureStatus -> - cfg -> - Gen (WithStatusPatch cfg) -> - TestM () -testPatchWithCustomGen assertLockStatusChange featureStatus cfg gen = do - generatedConfig <- liftIO $ generate gen - testPatch' assertLockStatusChange generatedConfig featureStatus cfg - -testPatch :: - forall cfg. - ( HasCallStack, - IsFeatureConfig cfg, - Typeable cfg, - ToSchema cfg, - Eq cfg, - Show cfg, - KnownSymbol (FeatureSymbol cfg), - Arbitrary (WithStatusPatch cfg) - ) => - AssertLockStatusChange -> - FeatureStatus -> - cfg -> - TestM () -testPatch assertLockStatusChange status cfg = testPatchWithCustomGen assertLockStatusChange status cfg arbitrary - -testPatch' :: - forall cfg. - ( HasCallStack, - IsFeatureConfig cfg, - Typeable cfg, - ToSchema cfg, - Eq cfg, - Show cfg, - KnownSymbol (FeatureSymbol cfg) - ) => - AssertLockStatusChange -> - WithStatusPatch cfg -> - FeatureStatus -> - cfg -> - TestM () -testPatch' testLockStatusChange rndFeatureConfig defStatus defConfig = do - (uid, tid) <- createBindingTeam - Just original <- responseJsonMaybe <$> getTeamFeatureInternal @cfg tid - patchTeamFeatureInternal tid rndFeatureConfig !!! statusCode === const 200 - Just actual <- responseJsonMaybe <$> getTeamFeatureInternal @cfg tid - liftIO $ - if wsLockStatus actual == LockStatusLocked - then do - wsStatus actual @?= defStatus - wsConfig actual @?= defConfig - else do - wsStatus actual @?= fromMaybe (wsStatus original) (wspStatus rndFeatureConfig) - when (testLockStatusChange == AssertLockStatusChange) $ - wsLockStatus actual @?= fromMaybe (wsLockStatus original) (wspLockStatus rndFeatureConfig) - wsConfig actual @?= fromMaybe (wsConfig original) (wspConfig rndFeatureConfig) - checkTeamFeatureAllEndpoints uid tid actual - -testSSO :: (TeamId -> FeatureStatus -> TestM ()) -> TestM () -testSSO setSSOFeature = do - (_owner, tid, member : _) <- createBindingTeamWithNMembers 1 - nonMember <- randomUser - - assertFlagForbidden $ getTeamFeature @SSOConfig nonMember tid - - featureSSO <- view (tsGConf . settings . featureFlags . flagSSO) - case featureSSO of - FeatureSSODisabledByDefault -> do - -- Test default - checkTeamFeatureAllEndpoints member tid (withStatus FeatureStatusDisabled LockStatusUnlocked SSOConfig FeatureTTLUnlimited) - - -- Test override - setSSOFeature tid FeatureStatusEnabled - checkTeamFeatureAllEndpoints member tid (withStatus FeatureStatusEnabled LockStatusUnlocked SSOConfig FeatureTTLUnlimited) - FeatureSSOEnabledByDefault -> do - -- since we don't allow to disable (see 'disableSsoNotImplemented'), we can't test - -- much here. (disable failure is covered in "enable/disable SSO" above.) - checkTeamFeatureAllEndpoints member tid (withStatus FeatureStatusEnabled LockStatusUnlocked SSOConfig FeatureTTLUnlimited) - -putSSOInternal :: HasCallStack => TeamId -> FeatureStatus -> TestM () -putSSOInternal tid = - void - . putTeamFeatureInternal @SSOConfig expect2xx tid - . (\st -> WithStatusNoLock st SSOConfig FeatureTTLUnlimited) - -patchSSOInternal :: HasCallStack => TeamId -> FeatureStatus -> TestM () -patchSSOInternal tid status = void $ patchTeamFeatureInternalWithMod @SSOConfig expect2xx tid (withStatus' (Just status) Nothing Nothing (Just FeatureTTLUnlimited)) - -testLegalHold :: ((Request -> Request) -> TeamId -> FeatureStatus -> TestM ()) -> TestM () -testLegalHold setLegalHoldInternal = do - (_owner, tid, member : _) <- createBindingTeamWithNMembers 1 - nonMember <- randomUser - checkTeamFeatureAllEndpoints member tid (withStatus FeatureStatusDisabled LockStatusUnlocked LegalholdConfig FeatureTTLUnlimited) - assertFlagForbidden $ getTeamFeature @LegalholdConfig nonMember tid - - -- FUTUREWORK: run two galleys, like below for custom search visibility. - featureLegalHold <- view (tsGConf . settings . featureFlags . flagLegalHold) - case featureLegalHold of - FeatureLegalHoldDisabledByDefault -> do - -- Test default - checkTeamFeatureAllEndpoints member tid (withStatus FeatureStatusDisabled LockStatusUnlocked LegalholdConfig FeatureTTLUnlimited) - - -- Test override - setLegalHoldInternal expect2xx tid FeatureStatusEnabled - checkTeamFeatureAllEndpoints member tid (withStatus FeatureStatusEnabled LockStatusUnlocked LegalholdConfig FeatureTTLUnlimited) - - -- turned off for instance - FeatureLegalHoldDisabledPermanently -> do - setLegalHoldInternal expect4xx tid FeatureStatusEnabled - - -- turned off but for whitelisted teams with implicit consent - FeatureLegalHoldWhitelistTeamsAndImplicitConsent -> do - setLegalHoldInternal expect4xx tid FeatureStatusEnabled - -putLegalHoldInternal :: HasCallStack => (Request -> Request) -> TeamId -> FeatureStatus -> TestM () -putLegalHoldInternal expectation tid = - void - . putTeamFeatureInternal @LegalholdConfig expectation tid - . (\st -> WithStatusNoLock st LegalholdConfig FeatureTTLUnlimited) - -patchLegalHoldInternal :: HasCallStack => (Request -> Request) -> TeamId -> FeatureStatus -> TestM () -patchLegalHoldInternal expectation tid status = void $ patchTeamFeatureInternalWithMod @LegalholdConfig expectation tid (withStatus' (Just status) Nothing Nothing (Just FeatureTTLUnlimited)) - -testSearchVisibility :: TestM () -testSearchVisibility = do - let setTeamSearchVisibilityInternal :: TeamId -> FeatureStatus -> TestM () - setTeamSearchVisibilityInternal teamid val = do - putTeamSearchVisibilityAvailableInternal teamid val - - (_, tid, [member]) <- createBindingTeamWithNMembers 1 - nonMember <- randomUser - - assertFlagForbidden $ getTeamFeature @SearchVisibilityAvailableConfig nonMember tid - - withCustomSearchFeature FeatureTeamSearchVisibilityUnavailableByDefault $ do - checkTeamFeatureAllEndpoints member tid (withStatus FeatureStatusDisabled LockStatusUnlocked SearchVisibilityAvailableConfig FeatureTTLUnlimited) - - setTeamSearchVisibilityInternal tid FeatureStatusEnabled - checkTeamFeatureAllEndpoints member tid (withStatus FeatureStatusEnabled LockStatusUnlocked SearchVisibilityAvailableConfig FeatureTTLUnlimited) - - setTeamSearchVisibilityInternal tid FeatureStatusDisabled - checkTeamFeatureAllEndpoints member tid (withStatus FeatureStatusDisabled LockStatusUnlocked SearchVisibilityAvailableConfig FeatureTTLUnlimited) - - (_, tid2, team2member : _) <- createBindingTeamWithNMembers 1 - - withCustomSearchFeature FeatureTeamSearchVisibilityAvailableByDefault $ do - checkTeamFeatureAllEndpoints team2member tid2 (withStatus FeatureStatusEnabled LockStatusUnlocked SearchVisibilityAvailableConfig FeatureTTLUnlimited) - - setTeamSearchVisibilityInternal tid2 FeatureStatusDisabled - checkTeamFeatureAllEndpoints team2member tid2 (withStatus FeatureStatusDisabled LockStatusUnlocked SearchVisibilityAvailableConfig FeatureTTLUnlimited) - - setTeamSearchVisibilityInternal tid2 FeatureStatusEnabled - checkTeamFeatureAllEndpoints team2member tid2 (withStatus FeatureStatusEnabled LockStatusUnlocked SearchVisibilityAvailableConfig FeatureTTLUnlimited) - -testClassifiedDomainsEnabled :: TestM () -testClassifiedDomainsEnabled = do - (_, tid, member : _) <- createBindingTeamWithNMembers 1 - let expected = - withStatus FeatureStatusEnabled LockStatusUnlocked (ClassifiedDomainsConfig [Domain "example.com"]) FeatureTTLUnlimited - - checkTeamFeatureAllEndpoints member tid expected - -testClassifiedDomainsDisabled :: TestM () -testClassifiedDomainsDisabled = do - (_owner, tid, member : _) <- createBindingTeamWithNMembers 1 - let expected = - withStatus FeatureStatusDisabled LockStatusUnlocked (ClassifiedDomainsConfig []) FeatureTTLUnlimited - - let classifiedDomainsDisabled opts = - opts - & over - (settings . featureFlags . flagClassifiedDomains) - (\(ImplicitLockStatus s) -> ImplicitLockStatus (s & setStatus FeatureStatusDisabled & setConfig (ClassifiedDomainsConfig []))) - - withSettingsOverrides classifiedDomainsDisabled $ - checkTeamFeatureAllEndpoints member tid expected - -testSimpleFlag :: - forall cfg. - ( HasCallStack, - Typeable cfg, - IsFeatureConfig cfg, - KnownSymbol (FeatureSymbol cfg), - FeatureTrivialConfig cfg, - ToSchema cfg, - FromJSON (WithStatusNoLock cfg) - ) => - FeatureStatus -> - TestM () -testSimpleFlag defaultValue = testSimpleFlagTTL @cfg defaultValue FeatureTTLUnlimited - -testSimpleFlagTTLOverride :: - forall cfg. - ( HasCallStack, - Typeable cfg, - IsFeatureConfig cfg, - KnownSymbol (FeatureSymbol cfg), - FeatureTrivialConfig cfg, - ToSchema cfg, - Eq cfg, - Show cfg - ) => - FeatureStatus -> - FeatureTTL -> - FeatureTTL -> - TestM () -testSimpleFlagTTLOverride defaultValue ttl ttlAfter = do - (_owner, tid, member : _) <- createBindingTeamWithNMembers 1 - nonMember <- randomUser - - let setFlagInternal :: FeatureStatus -> FeatureTTL -> TestM () - setFlagInternal statusValue ttl' = - void $ putTeamFeatureInternal @cfg expect2xx tid (WithStatusNoLock statusValue (trivialConfig @cfg) ttl') - - select :: PrepQuery R (Identity TeamId) (Identity (Maybe FeatureTTL)) - select = fromString "select ttl(conference_calling) from team_features where team_id = ?" - - assertUnlimited :: TestM () - assertUnlimited = do - -- TTL should be NULL inside cassandra - cassState <- view tsCass - liftIO $ do - storedTTL <- maybe Nothing runIdentity <$> Cql.runClient cassState (Cql.query1 select $ params LocalQuorum (Identity tid)) - storedTTL @?= Nothing - - assertLimited :: Word -> TestM () - assertLimited upper = do - -- TTL should NOT be NULL inside cassandra - cassState <- view tsCass - liftIO $ do - storedTTL <- maybe Nothing runIdentity <$> Cql.runClient cassState (Cql.query1 select $ params LocalQuorum (Identity tid)) - let check = case storedTTL of - Nothing -> False - Just FeatureTTLUnlimited -> False - Just (FeatureTTLSeconds i) -> i <= upper - unless check $ error ("expected ttl <= " <> show upper <> ", got " <> show storedTTL) - - toMicros :: Word -> Int - toMicros secs = fromIntegral secs * 1000000 - - assertFlagForbidden $ getTeamFeature @cfg nonMember tid - - let otherValue = case defaultValue of - FeatureStatusDisabled -> FeatureStatusEnabled - FeatureStatusEnabled -> FeatureStatusDisabled - - -- Initial value should be the default value - checkTeamFeatureAllEndpoints member tid (defFeatureStatus @cfg & setStatus defaultValue) - - -- Setting should work - setFlagInternal otherValue ttl - checkTeamFeatureAllEndpoints member tid (defFeatureStatus @cfg & setStatus otherValue & setTTL ttl) - - case (ttl, ttlAfter) of - (FeatureTTLSeconds d, FeatureTTLSeconds d') -> do - assertLimited d -- TTL should be NULL after expiration. - -- wait less than expiration, override and recheck. - liftIO $ threadDelay (toMicros d `div` 2) -- waiting half of TTL - setFlagInternal otherValue ttlAfter - -- value is still correct - checkTeamFeatureAllEndpoints member tid (defFeatureStatus @cfg & setStatus otherValue & setTTL ttlAfter) - - liftIO $ threadDelay (toMicros d') -- waiting for new TTL - checkTeamFeatureAllEndpoints member tid (defFeatureStatus @cfg & setStatus defaultValue) - (FeatureTTLSeconds d, FeatureTTLUnlimited) -> do - assertLimited d -- TTL should be NULL after expiration. - -- wait less than expiration, override and recheck. - liftIO $ threadDelay (fromIntegral d `div` 2) -- waiting half of TTL - setFlagInternal otherValue ttlAfter - -- value is still correct - checkTeamFeatureAllEndpoints member tid (defFeatureStatus @cfg & setStatus otherValue & setTTL ttlAfter) - (FeatureTTLUnlimited, FeatureTTLUnlimited) -> do - assertUnlimited - - -- overriding in this case should have no effect. - setFlagInternal otherValue ttl - checkTeamFeatureAllEndpoints member tid (defFeatureStatus @cfg & setStatus otherValue & setTTL ttl) - (FeatureTTLUnlimited, FeatureTTLSeconds d) -> do - assertUnlimited - - setFlagInternal otherValue ttlAfter - checkTeamFeatureAllEndpoints member tid (defFeatureStatus @cfg & setStatus otherValue & setTTL ttlAfter) - - liftIO $ threadDelay (toMicros d) -- waiting it out - -- value reverts back - checkTeamFeatureAllEndpoints member tid (defFeatureStatus @cfg & setStatus defaultValue & setTTL ttl) - -testSimpleFlagTTL :: - forall cfg. - ( HasCallStack, - Typeable cfg, - IsFeatureConfig cfg, - KnownSymbol (FeatureSymbol cfg), - FeatureTrivialConfig cfg, - ToSchema cfg, - FromJSON (WithStatusNoLock cfg) - ) => - FeatureStatus -> - FeatureTTL -> - TestM () -testSimpleFlagTTL defaultValue ttl = do - (_owner, tid, member : _) <- createBindingTeamWithNMembers 1 - nonMember <- randomUser - - let getFlag :: HasCallStack => FeatureStatus -> TestM () - getFlag expected = - flip (assertFlagNoConfig @cfg) expected $ getTeamFeature @cfg member tid - - getFeatureConfig :: HasCallStack => FeatureStatus -> TestM () - getFeatureConfig expected = do - actual <- Util.getFeatureConfig @cfg member - liftIO $ wsStatus actual @?= expected - - getFlagInternal :: HasCallStack => FeatureStatus -> TestM () - getFlagInternal expected = - flip (assertFlagNoConfig @cfg) expected $ getTeamFeatureInternal @cfg tid - - setFlagInternal :: FeatureStatus -> FeatureTTL -> TestM () - setFlagInternal statusValue ttl' = - void $ putTeamFeatureInternal @cfg expect2xx tid (WithStatusNoLock statusValue (trivialConfig @cfg) ttl') - - select :: PrepQuery R (Identity TeamId) (Identity (Maybe FeatureTTL)) - select = fromString "select ttl(conference_calling) from team_features where team_id = ?" - - assertUnlimited :: TestM () - assertUnlimited = do - -- TTL should be NULL inside cassandra - cassState <- view tsCass - liftIO $ do - storedTTL <- maybe Nothing runIdentity <$> Cql.runClient cassState (Cql.query1 select $ params LocalQuorum (Identity tid)) - storedTTL @?= Nothing - - assertLimited :: Word -> TestM () - assertLimited upper = do - -- TTL should NOT be NULL inside cassandra - cassState <- view tsCass - liftIO $ do - storedTTL <- maybe Nothing runIdentity <$> Cql.runClient cassState (Cql.query1 select $ params LocalQuorum (Identity tid)) - let check = case storedTTL of - Nothing -> False - Just FeatureTTLUnlimited -> False - Just (FeatureTTLSeconds i) -> i <= upper - unless check $ error ("expected ttl <= " <> show upper <> ", got " <> show storedTTL) - - assertFlagForbidden $ getTeamFeature @cfg nonMember tid - - let otherValue = case defaultValue of - FeatureStatusDisabled -> FeatureStatusEnabled - FeatureStatusEnabled -> FeatureStatusDisabled - - -- Initial value should be the default value - getFlag defaultValue - getFlagInternal defaultValue - getFeatureConfig defaultValue - - -- Setting should work - cannon <- view tsCannon - -- should receive an event - WS.bracketR cannon member $ \ws -> do - setFlagInternal otherValue ttl - void . liftIO $ - WS.assertMatch (5 # Second) ws $ - wsAssertFeatureTrivialConfigUpdate @cfg otherValue ttl - getFlag otherValue - getFeatureConfig otherValue - getFlagInternal otherValue - - case ttl of - FeatureTTLSeconds d -> do - -- should revert back after TTL expires - assertLimited d - liftIO $ threadDelay (fromIntegral d * 1000000) - assertUnlimited - getFlag defaultValue - FeatureTTLUnlimited -> do - -- TTL should be NULL inside cassandra - assertUnlimited - - -- Clean up - setFlagInternal defaultValue FeatureTTLUnlimited - getFlag defaultValue - -testSimpleFlagWithLockStatus :: - forall cfg. - ( HasCallStack, - Typeable cfg, - Eq cfg, - Show cfg, - FeatureTrivialConfig cfg, - IsFeatureConfig cfg, - KnownSymbol (FeatureSymbol cfg), - ToSchema cfg, - ToJSON (WithStatusNoLock cfg) - ) => - FeatureStatus -> - LockStatus -> - TestM () -testSimpleFlagWithLockStatus defaultStatus defaultLockStatus = do - galley <- viewGalley - (owner, tid, member : _) <- createBindingTeamWithNMembers 1 - nonMember <- randomUser - - let getFlag :: HasCallStack => FeatureStatus -> LockStatus -> TestM () - getFlag expectedStatus expectedLockStatus = do - let flag = getTeamFeature @cfg member tid - assertFlagNoConfigWithLockStatus @cfg flag expectedStatus expectedLockStatus - - getFeatureConfig :: HasCallStack => FeatureStatus -> LockStatus -> TestM () - getFeatureConfig expectedStatus expectedLockStatus = do - actual <- Util.getFeatureConfig @cfg member - liftIO $ wsStatus actual @?= expectedStatus - liftIO $ wsLockStatus actual @?= expectedLockStatus - - getFlagInternal :: HasCallStack => FeatureStatus -> LockStatus -> TestM () - getFlagInternal expectedStatus expectedLockStatus = do - let flag = getTeamFeatureInternal @cfg tid - assertFlagNoConfigWithLockStatus @cfg flag expectedStatus expectedLockStatus - - getFlags expectedStatus expectedLockStatus = do - getFlag expectedStatus expectedLockStatus - getFeatureConfig expectedStatus expectedLockStatus - getFlagInternal expectedStatus expectedLockStatus - - setFlagWithGalley :: FeatureStatus -> TestM () - setFlagWithGalley statusValue = - putTeamFeature @cfg owner tid (WithStatusNoLock statusValue (trivialConfig @cfg) FeatureTTLUnlimited) - !!! statusCode - === const 200 - - assertSetStatusForbidden :: FeatureStatus -> TestM () - assertSetStatusForbidden statusValue = - putTeamFeature @cfg owner tid (WithStatusNoLock statusValue (trivialConfig @cfg) FeatureTTLUnlimited) - !!! statusCode - === const 409 - - setLockStatus :: LockStatus -> TestM () - setLockStatus lockStatus = - Util.setLockStatusInternal @cfg galley tid lockStatus - !!! statusCode - === const 200 - - assertFlagForbidden $ getTeamFeature @cfg nonMember tid - - let otherStatus = case defaultStatus of - FeatureStatusDisabled -> FeatureStatusEnabled - FeatureStatusEnabled -> FeatureStatusDisabled - - -- Initial status and lock status should be the defaults - getFlags defaultStatus defaultLockStatus - - -- unlock feature if it is locked - when (defaultLockStatus == LockStatusLocked) $ setLockStatus LockStatusUnlocked - - -- setting should work - cannon <- view tsCannon - -- should receive an event - WS.bracketR cannon member $ \ws -> do - setFlagWithGalley otherStatus - void . liftIO $ - WS.assertMatch (5 # Second) ws $ - wsAssertFeatureConfigWithLockStatusUpdate @cfg otherStatus LockStatusUnlocked - - getFlags otherStatus LockStatusUnlocked - - -- lock feature - setLockStatus LockStatusLocked - -- feature status should now be the default again - getFlags defaultStatus LockStatusLocked - assertSetStatusForbidden defaultStatus - -- unlock feature - setLockStatus LockStatusUnlocked - -- feature status should be the previously set value - getFlags otherStatus LockStatusUnlocked - - -- clean up - setFlagWithGalley defaultStatus - setLockStatus defaultLockStatus - getFlags defaultStatus defaultLockStatus - -testSelfDeletingMessages :: TestM () -testSelfDeletingMessages = do - defLockStatus :: LockStatus <- - view - ( tsGConf - . settings - . featureFlags - . flagSelfDeletingMessages - . unDefaults - . to wsLockStatus - ) - - -- personal users - let settingWithoutLockStatus :: FeatureStatus -> Int32 -> WithStatusNoLock SelfDeletingMessagesConfig - settingWithoutLockStatus stat tout = - WithStatusNoLock - stat - (SelfDeletingMessagesConfig tout) - FeatureTTLUnlimited - settingWithLockStatus :: FeatureStatus -> Int32 -> LockStatus -> WithStatus SelfDeletingMessagesConfig - settingWithLockStatus stat tout lockStatus = - withStatus - stat - lockStatus - (SelfDeletingMessagesConfig tout) - FeatureTTLUnlimited - - personalUser <- randomUser - do - result <- Util.getFeatureConfig @SelfDeletingMessagesConfig personalUser - liftIO $ result @?= settingWithLockStatus FeatureStatusEnabled 0 defLockStatus - - -- team users - galley <- viewGalley - (owner, tid, []) <- createBindingTeamWithNMembers 0 - - let checkSet :: FeatureStatus -> Int32 -> Int -> TestM () - checkSet stat tout expectedStatusCode = - do - putTeamFeatureInternal @SelfDeletingMessagesConfig - galley - tid - (settingWithoutLockStatus stat tout) - !!! statusCode - === const expectedStatusCode - - -- internal, public (/team/:tid/features), and team-agnostic (/feature-configs). - checkGet :: HasCallStack => FeatureStatus -> Int32 -> LockStatus -> TestM () - checkGet stat tout lockStatus = do - let expected = settingWithLockStatus stat tout lockStatus - forM_ - [ getTeamFeatureInternal @SelfDeletingMessagesConfig tid, - getTeamFeature @SelfDeletingMessagesConfig owner tid - ] - (!!! responseJsonEither === const (Right expected)) - result <- Util.getFeatureConfig @SelfDeletingMessagesConfig owner - liftIO $ result @?= expected - - checkSetLockStatus :: HasCallStack => LockStatus -> TestM () - checkSetLockStatus status = - do - Util.setLockStatusInternal @SelfDeletingMessagesConfig galley tid status - !!! statusCode - === const 200 - - -- test that the default lock status comes from `galley.yaml`. - -- use this to change `galley.integration.yaml` locally and manually test that conf file - -- parsing works as expected. - checkGet FeatureStatusEnabled 0 defLockStatus - - case defLockStatus of - LockStatusLocked -> do - checkSet FeatureStatusDisabled 0 409 - LockStatusUnlocked -> do - checkSet FeatureStatusDisabled 0 200 - checkGet FeatureStatusDisabled 0 LockStatusUnlocked - checkSet FeatureStatusEnabled 0 200 - checkGet FeatureStatusEnabled 0 LockStatusUnlocked - - -- now don't worry about what's in the config, write something to cassandra, and test with that. - checkSetLockStatus LockStatusLocked - checkGet FeatureStatusEnabled 0 LockStatusLocked - checkSet FeatureStatusDisabled 0 409 - checkGet FeatureStatusEnabled 0 LockStatusLocked - checkSet FeatureStatusEnabled 30 409 - checkGet FeatureStatusEnabled 0 LockStatusLocked - checkSetLockStatus LockStatusUnlocked - checkGet FeatureStatusEnabled 0 LockStatusUnlocked - checkSet FeatureStatusDisabled 0 200 - checkGet FeatureStatusDisabled 0 LockStatusUnlocked - checkSet FeatureStatusEnabled 30 200 - checkGet FeatureStatusEnabled 30 LockStatusUnlocked - checkSet FeatureStatusDisabled 30 200 - checkGet FeatureStatusDisabled 30 LockStatusUnlocked - checkSetLockStatus LockStatusLocked - checkGet FeatureStatusEnabled 0 LockStatusLocked - checkSet FeatureStatusEnabled 50 409 - checkSetLockStatus LockStatusUnlocked - checkGet FeatureStatusDisabled 30 LockStatusUnlocked - -testGuestLinksInternal :: TestM () -testGuestLinksInternal = do - galley <- viewGalley - testGuestLinks - (const $ getTeamFeatureInternal @GuestLinksConfig) - (const $ putTeamFeatureInternal @GuestLinksConfig galley) - (Util.setLockStatusInternal @GuestLinksConfig galley) - -testGuestLinksPublic :: TestM () -testGuestLinksPublic = do - galley <- viewGalley - testGuestLinks - (getTeamFeature @GuestLinksConfig) - (putTeamFeature @GuestLinksConfig) - (Util.setLockStatusInternal @GuestLinksConfig galley) - -testGuestLinks :: - (UserId -> TeamId -> TestM ResponseLBS) -> - (UserId -> TeamId -> WithStatusNoLock GuestLinksConfig -> TestM ResponseLBS) -> - (TeamId -> LockStatus -> TestM ResponseLBS) -> - TestM () -testGuestLinks getStatus putStatus setLockStatusInternal = do - (owner, tid, []) <- createBindingTeamWithNMembers 0 - let checkGet :: HasCallStack => FeatureStatus -> LockStatus -> TestM () - checkGet status lock = - getStatus owner tid !!! do - statusCode === const 200 - responseJsonEither === const (Right (withStatus status lock GuestLinksConfig FeatureTTLUnlimited)) - - checkSet :: HasCallStack => FeatureStatus -> Int -> TestM () - checkSet status expectedStatusCode = - putStatus owner tid (WithStatusNoLock status GuestLinksConfig FeatureTTLUnlimited) !!! statusCode === const expectedStatusCode - - checkSetLockStatusInternal :: HasCallStack => LockStatus -> TestM () - checkSetLockStatusInternal lockStatus = - setLockStatusInternal tid lockStatus !!! statusCode === const 200 - - checkGet FeatureStatusEnabled LockStatusUnlocked - checkSet FeatureStatusDisabled 200 - checkGet FeatureStatusDisabled LockStatusUnlocked - checkSet FeatureStatusEnabled 200 - checkGet FeatureStatusEnabled LockStatusUnlocked - checkSet FeatureStatusDisabled 200 - checkGet FeatureStatusDisabled LockStatusUnlocked - -- when locks status is locked the team default feature status should be returned - -- and the team feature status can not be changed - checkSetLockStatusInternal LockStatusLocked - checkGet FeatureStatusEnabled LockStatusLocked - checkSet FeatureStatusDisabled 409 - -- when lock status is unlocked again the previously set feature status is restored - checkSetLockStatusInternal LockStatusUnlocked - checkGet FeatureStatusDisabled LockStatusUnlocked - --- | Call 'GET /teams/:tid/features' and 'GET /feature-configs', and check if all --- features are there. -testAllFeatures :: TestM () -testAllFeatures = do - defLockStatus :: LockStatus <- - view - ( tsGConf - . settings - . featureFlags - . flagSelfDeletingMessages - . unDefaults - . to wsLockStatus - ) - - (_owner, tid, member : _) <- createBindingTeamWithNMembers 1 - getAllTeamFeatures member tid !!! do - statusCode === const 200 - responseJsonMaybe === const (Just (expected FeatureStatusEnabled defLockStatus {- determined by default in galley -})) - - -- This block catches potential errors in the logic that reverts to default if there is a distinction made between - -- 1. there is no row for a team_id in galley.team_features - -- 2. there is a row for team_id in galley.team_features but the feature has a no entry (null value) - galley <- viewGalley - -- this sets the guest links config to its default value thereby creating a row for the team in galley.team_features - putTeamFeatureInternal @GuestLinksConfig galley tid (WithStatusNoLock FeatureStatusEnabled GuestLinksConfig FeatureTTLUnlimited) - !!! statusCode - === const 200 - getAllTeamFeatures member tid !!! do - statusCode === const 200 - responseJsonMaybe === const (Just (expected FeatureStatusEnabled defLockStatus {- determined by default in galley -})) - - getAllFeatureConfigs member !!! do - statusCode === const 200 - responseJsonMaybe === const (Just (expected FeatureStatusEnabled defLockStatus {- determined by default in galley -})) - - randomPersonalUser <- randomUser - getAllFeatureConfigs randomPersonalUser !!! do - statusCode === const 200 - responseJsonMaybe === const (Just (expected FeatureStatusEnabled defLockStatus {- determined by 'getAfcConferenceCallingDefNew' in brig -})) - where - expected confCalling lockStateSelfDeleting = - AllFeatureConfigs - { afcLegalholdStatus = withStatus FeatureStatusDisabled LockStatusUnlocked LegalholdConfig FeatureTTLUnlimited, - afcSSOStatus = withStatus FeatureStatusDisabled LockStatusUnlocked SSOConfig FeatureTTLUnlimited, - afcTeamSearchVisibilityAvailable = withStatus FeatureStatusDisabled LockStatusUnlocked SearchVisibilityAvailableConfig FeatureTTLUnlimited, - afcValidateSAMLEmails = withStatus FeatureStatusEnabled LockStatusUnlocked ValidateSAMLEmailsConfig FeatureTTLUnlimited, - afcDigitalSignatures = withStatus FeatureStatusDisabled LockStatusUnlocked DigitalSignaturesConfig FeatureTTLUnlimited, - afcAppLock = withStatus FeatureStatusEnabled LockStatusUnlocked (AppLockConfig (EnforceAppLock False) (60 :: Int32)) FeatureTTLUnlimited, - afcFileSharing = withStatus FeatureStatusEnabled LockStatusUnlocked FileSharingConfig FeatureTTLUnlimited, - afcClassifiedDomains = withStatus FeatureStatusEnabled LockStatusUnlocked (ClassifiedDomainsConfig [Domain "example.com"]) FeatureTTLUnlimited, - afcConferenceCalling = withStatus confCalling LockStatusUnlocked ConferenceCallingConfig FeatureTTLUnlimited, - afcSelfDeletingMessages = withStatus FeatureStatusEnabled lockStateSelfDeleting (SelfDeletingMessagesConfig 0) FeatureTTLUnlimited, - afcGuestLink = withStatus FeatureStatusEnabled LockStatusUnlocked GuestLinksConfig FeatureTTLUnlimited, - afcSndFactorPasswordChallenge = withStatus FeatureStatusDisabled LockStatusLocked SndFactorPasswordChallengeConfig FeatureTTLUnlimited, - afcMLS = withStatus FeatureStatusDisabled LockStatusUnlocked (MLSConfig [] ProtocolProteusTag [MLS_128_DHKEMX25519_AES128GCM_SHA256_Ed25519] MLS_128_DHKEMX25519_AES128GCM_SHA256_Ed25519 [ProtocolProteusTag, ProtocolMLSTag]) FeatureTTLUnlimited, - afcSearchVisibilityInboundConfig = withStatus FeatureStatusDisabled LockStatusUnlocked SearchVisibilityInboundConfig FeatureTTLUnlimited, - afcExposeInvitationURLsToTeamAdmin = withStatus FeatureStatusDisabled LockStatusLocked ExposeInvitationURLsToTeamAdminConfig FeatureTTLUnlimited, - afcOutlookCalIntegration = withStatus FeatureStatusDisabled LockStatusLocked OutlookCalIntegrationConfig FeatureTTLUnlimited, - afcMlsE2EId = withStatus FeatureStatusDisabled LockStatusUnlocked (wsConfig defFeatureStatus) FeatureTTLUnlimited, - afcMlsMigration = defaultMlsMigrationConfig, - afcEnforceFileDownloadLocation = defaultEnforceFileDownloadLocationConfig, - afcLimitedEventFanout = - withStatus FeatureStatusDisabled LockStatusUnlocked LimitedEventFanoutConfig FeatureTTLUnlimited - } - -testFeatureConfigConsistency :: TestM () -testFeatureConfigConsistency = do - (_owner, tid, member : _) <- createBindingTeamWithNMembers 1 - - allFeaturesRes <- getAllFeatureConfigs member >>= parseObjectKeys - - allTeamFeaturesRes <- getAllTeamFeatures member tid >>= parseObjectKeys - - unless (allTeamFeaturesRes `Set.isSubsetOf` allFeaturesRes) $ - liftIO $ - expectationFailure (show allTeamFeaturesRes <> " is not a subset of " <> show allFeaturesRes) - where - parseObjectKeys :: ResponseLBS -> TestM (Set.Set Text) - parseObjectKeys res = do - case responseJsonEither res of - Left err -> liftIO $ assertFailure ("Did not parse as an object" <> err) - Right (val :: Aeson.Value) -> - case val of - (Aeson.Object hm) -> pure (Set.fromList . map AesonKey.toText . KeyMap.keys $ hm) - x -> liftIO $ assertFailure ("JSON was not an object, but " <> show x) - -testSearchVisibilityInbound :: TestM () -testSearchVisibilityInbound = do - let defaultValue = FeatureStatusDisabled - (_owner, tid, _) <- createBindingTeamWithNMembers 1 - - let getFlagInternal :: HasCallStack => FeatureStatus -> TestM () - getFlagInternal expected = - flip (assertFlagNoConfig @SearchVisibilityInboundConfig) expected $ getTeamFeatureInternal @SearchVisibilityInboundConfig tid - - setFlagInternal :: FeatureStatus -> TestM () - setFlagInternal statusValue = - void $ putTeamFeatureInternal @SearchVisibilityInboundConfig expect2xx tid (WithStatusNoLock statusValue SearchVisibilityInboundConfig FeatureTTLUnlimited) - - let otherValue = case defaultValue of - FeatureStatusDisabled -> FeatureStatusEnabled - FeatureStatusEnabled -> FeatureStatusDisabled - - -- Initial value should be the default value - getFlagInternal defaultValue - setFlagInternal otherValue - getFlagInternal otherValue - -testFeatureNoConfigMultiSearchVisibilityInbound :: TestM () -testFeatureNoConfigMultiSearchVisibilityInbound = do - (_owner1, team1, _) <- createBindingTeamWithNMembers 0 - (_owner2, team2, _) <- createBindingTeamWithNMembers 0 - - let setFlagInternal :: TeamId -> FeatureStatus -> TestM () - setFlagInternal tid statusValue = - void $ putTeamFeatureInternal @SearchVisibilityInboundConfig expect2xx tid (WithStatusNoLock statusValue SearchVisibilityInboundConfig FeatureTTLUnlimited) - - setFlagInternal team2 FeatureStatusEnabled - - r <- - getFeatureStatusMulti @SearchVisibilityInboundConfig (Multi.TeamFeatureNoConfigMultiRequest [team1, team2]) - - WithStatus cfg -> - TestM () -testNonTrivialConfigNoTTL defaultCfg = do - (owner, tid, member : _) <- createBindingTeamWithNMembers 1 - nonMember <- randomUser - - galley <- viewGalley - cannon <- view tsCannon - - let getForTeam :: HasCallStack => WithStatusNoLock cfg -> TestM () - getForTeam expected = - flip assertFlagWithConfig expected $ getTeamFeature @cfg member tid - - getForTeamInternal :: HasCallStack => WithStatusNoLock cfg -> TestM () - getForTeamInternal expected = - flip assertFlagWithConfig expected $ getTeamFeatureInternal @cfg tid - - getForUser :: HasCallStack => WithStatusNoLock cfg -> TestM () - getForUser expected = do - result <- Util.getFeatureConfig @cfg member - liftIO $ wsStatus result @?= wssStatus expected - liftIO $ wsConfig result @?= wssConfig expected - - getViaEndpoints :: HasCallStack => WithStatusNoLock cfg -> TestM () - getViaEndpoints expected = do - getForTeam expected - getForTeamInternal expected - getForUser expected - - setForTeam :: HasCallStack => WithStatusNoLock cfg -> TestM () - setForTeam wsnl = - putTeamFeature @cfg owner tid wsnl - !!! statusCode - === const 200 - - setForTeamInternal :: HasCallStack => WithStatusNoLock cfg -> TestM () - setForTeamInternal wsnl = - void $ putTeamFeatureInternal @cfg expect2xx tid wsnl - setLockStatus :: LockStatus -> TestM () - setLockStatus lockStatus = - Util.setLockStatusInternal @cfg galley tid lockStatus - !!! statusCode - === const 200 - - assertFlagForbidden $ getTeamFeature @cfg nonMember tid - - getViaEndpoints (forgetLock defaultCfg) - - -- unlock feature - setLockStatus LockStatusUnlocked - - let defaultMLSConfig = - WithStatusNoLock - { wssStatus = FeatureStatusEnabled, - wssConfig = - MLSConfig - { mlsProtocolToggleUsers = [], - mlsDefaultProtocol = ProtocolMLSTag, - mlsAllowedCipherSuites = [MLS_128_DHKEMX25519_AES128GCM_SHA256_Ed25519], - mlsDefaultCipherSuite = MLS_128_DHKEMX25519_AES128GCM_SHA256_Ed25519, - mlsSupportedProtocols = [ProtocolProteusTag, ProtocolMLSTag] - }, - wssTTL = FeatureTTLUnlimited - } - - config2 <- liftIO $ generate arbitrary <&> (forgetLock . setTTL FeatureTTLUnlimited) - config3 <- liftIO $ generate arbitrary <&> (forgetLock . setTTL FeatureTTLUnlimited) - - putTeamFeature @MLSConfig owner tid defaultMLSConfig - !!! statusCode - === const 200 - - WS.bracketR cannon member $ \ws -> do - setForTeam config2 - void . liftIO $ - WS.assertMatch (5 # Second) ws $ - wsAssertFeatureConfigUpdate @cfg config2 LockStatusUnlocked - getViaEndpoints config2 - - WS.bracketR cannon member $ \ws -> do - setForTeamInternal config3 - void . liftIO $ - WS.assertMatch (5 # Second) ws $ - wsAssertFeatureConfigUpdate @cfg config3 LockStatusUnlocked - getViaEndpoints config3 - - -- lock the feature - setLockStatus LockStatusLocked - -- feature status should now be the default again - getViaEndpoints (forgetLock defaultCfg) - -- unlock feature - setLockStatus LockStatusUnlocked - -- feature status should be the previously set value - getViaEndpoints config3 - -testMLS :: TestM () -testMLS = do - (owner, tid, member : _) <- createBindingTeamWithNMembers 1 - - galley <- viewGalley - cannon <- view tsCannon - - let getForTeam :: HasCallStack => WithStatusNoLock MLSConfig -> TestM () - getForTeam expected = - flip assertFlagWithConfig expected $ getTeamFeature @MLSConfig member tid - - getForTeamInternal :: HasCallStack => WithStatusNoLock MLSConfig -> TestM () - getForTeamInternal expected = - flip assertFlagWithConfig expected $ getTeamFeatureInternal @MLSConfig tid - - getForUser :: HasCallStack => WithStatusNoLock MLSConfig -> TestM () - getForUser expected = do - result <- Util.getFeatureConfig @MLSConfig member - liftIO $ wsStatus result @?= wssStatus expected - liftIO $ wsConfig result @?= wssConfig expected - - getViaEndpoints :: HasCallStack => WithStatusNoLock MLSConfig -> TestM () - getViaEndpoints expected = do - getForTeam expected - getForTeamInternal expected - getForUser expected - - setForTeamWithStatusCode :: HasCallStack => Int -> WithStatusNoLock MLSConfig -> TestM () - setForTeamWithStatusCode resStatusCode wsnl = - putTeamFeature @MLSConfig owner tid wsnl - !!! statusCode - === const resStatusCode - - setForTeam :: HasCallStack => WithStatusNoLock MLSConfig -> TestM () - setForTeam = setForTeamWithStatusCode 200 - - setForTeamInternalWithStatusCode :: HasCallStack => (Request -> Request) -> WithStatusNoLock MLSConfig -> TestM () - setForTeamInternalWithStatusCode expect wsnl = - void $ putTeamFeatureInternal @MLSConfig expect tid wsnl - - setForTeamInternal :: HasCallStack => WithStatusNoLock MLSConfig -> TestM () - setForTeamInternal = setForTeamInternalWithStatusCode expect2xx - - setLockStatus :: HasCallStack => LockStatus -> TestM () - setLockStatus lockStatus = - Util.setLockStatusInternal @MLSConfig galley tid lockStatus !!! statusCode === const 200 - - let cipherSuite = MLS_128_DHKEMX25519_AES128GCM_SHA256_Ed25519 - defaultConfig = - WithStatusNoLock - FeatureStatusDisabled - (MLSConfig [] ProtocolProteusTag [cipherSuite] cipherSuite [ProtocolProteusTag, ProtocolMLSTag]) - FeatureTTLUnlimited - config2 = - WithStatusNoLock - FeatureStatusEnabled - (MLSConfig [member] ProtocolMLSTag [] cipherSuite [ProtocolProteusTag, ProtocolMLSTag]) - FeatureTTLUnlimited - config3 = - WithStatusNoLock - FeatureStatusEnabled - (MLSConfig [] ProtocolMLSTag [cipherSuite] cipherSuite [ProtocolMLSTag]) - FeatureTTLUnlimited - invalidConfig = - WithStatusNoLock - FeatureStatusEnabled - (MLSConfig [] ProtocolMLSTag [cipherSuite] cipherSuite [ProtocolProteusTag]) - FeatureTTLUnlimited - - getViaEndpoints defaultConfig - - -- when the feature is locked it cannot be changed - setLockStatus LockStatusLocked - setForTeamWithStatusCode 409 config2 - setLockStatus LockStatusUnlocked - - WS.bracketR cannon member $ \ws -> do - setForTeam config2 - void . liftIO $ - WS.assertMatch (5 # Second) ws $ - wsAssertFeatureConfigUpdate @MLSConfig config2 LockStatusUnlocked - getViaEndpoints config2 - - -- when the feature is locked the default config is returned - setLockStatus LockStatusLocked - getViaEndpoints defaultConfig - setLockStatus LockStatusUnlocked - - WS.bracketR cannon member $ \ws -> do - setForTeamWithStatusCode 400 invalidConfig - void . liftIO $ - WS.assertNoEvent (2 # Second) [ws] - getViaEndpoints config2 - - WS.bracketR cannon member $ \ws -> do - setForTeamInternal config3 - void . liftIO $ - WS.assertMatch (5 # Second) ws $ - wsAssertFeatureConfigUpdate @MLSConfig config3 LockStatusUnlocked - getViaEndpoints config3 - - WS.bracketR cannon member $ \ws -> do - setForTeamInternalWithStatusCode expect4xx invalidConfig - void . liftIO $ - WS.assertNoEvent (2 # Second) [ws] - getViaEndpoints config3 - -testExposeInvitationURLsToTeamAdminTeamIdInAllowList :: TestM () -testExposeInvitationURLsToTeamAdminTeamIdInAllowList = do - owner <- randomUser - tid <- createBindingTeamInternal "foo" owner - assertTeamActivate "create team" tid - void $ - withSettingsOverrides (\opts -> opts & settings . exposeInvitationURLsTeamAllowlist ?~ [tid]) $ do - assertExposeInvitationURLsToTeamAdminConfigStatus owner tid FeatureStatusDisabled LockStatusUnlocked - let enabled = WithStatusNoLock FeatureStatusEnabled ExposeInvitationURLsToTeamAdminConfig FeatureTTLUnlimited - void $ - putTeamFeature @ExposeInvitationURLsToTeamAdminConfig owner tid enabled !!! do - const 200 === statusCode - assertExposeInvitationURLsToTeamAdminConfigStatus owner tid FeatureStatusEnabled LockStatusUnlocked - -testExposeInvitationURLsToTeamAdminEmptyAllowList :: TestM () -testExposeInvitationURLsToTeamAdminEmptyAllowList = do - owner <- randomUser - tid <- createBindingTeamInternal "foo" owner - assertTeamActivate "create team" tid - void $ - withSettingsOverrides (\opts -> opts & settings . exposeInvitationURLsTeamAllowlist .~ Nothing) $ do - assertExposeInvitationURLsToTeamAdminConfigStatus owner tid FeatureStatusDisabled LockStatusLocked - let enabled = WithStatusNoLock FeatureStatusEnabled ExposeInvitationURLsToTeamAdminConfig FeatureTTLUnlimited - void $ - putTeamFeature @ExposeInvitationURLsToTeamAdminConfig owner tid enabled !!! do - const 409 === statusCode - assertExposeInvitationURLsToTeamAdminConfigStatus owner tid FeatureStatusDisabled LockStatusLocked - --- | Ensure that the server config takes precedence over a saved team config. --- --- In other words: When a team id is no longer in the --- `exposeInvitationURLsTeamAllowlist` the --- `ExposeInvitationURLsToTeamAdminConfig` is always disabled (even tough it --- might have been enabled before). -testExposeInvitationURLsToTeamAdminServerConfigTakesPrecedence :: TestM () -testExposeInvitationURLsToTeamAdminServerConfigTakesPrecedence = do - owner <- randomUser - tid <- createBindingTeamInternal "foo" owner - assertTeamActivate "create team" tid - void $ - withSettingsOverrides (\opts -> opts & settings . exposeInvitationURLsTeamAllowlist ?~ [tid]) $ do - assertExposeInvitationURLsToTeamAdminConfigStatus owner tid FeatureStatusDisabled LockStatusUnlocked - let enabled = WithStatusNoLock FeatureStatusEnabled ExposeInvitationURLsToTeamAdminConfig FeatureTTLUnlimited - void $ - putTeamFeature @ExposeInvitationURLsToTeamAdminConfig owner tid enabled !!! do - const 200 === statusCode - assertExposeInvitationURLsToTeamAdminConfigStatus owner tid FeatureStatusEnabled LockStatusUnlocked - void $ - withSettingsOverrides (\opts -> opts & settings . exposeInvitationURLsTeamAllowlist .~ Nothing) $ do - assertExposeInvitationURLsToTeamAdminConfigStatus owner tid FeatureStatusDisabled LockStatusLocked - let enabled = WithStatusNoLock FeatureStatusEnabled ExposeInvitationURLsToTeamAdminConfig FeatureTTLUnlimited - void $ - putTeamFeature @ExposeInvitationURLsToTeamAdminConfig owner tid enabled !!! do - const 409 === statusCode - assertExposeInvitationURLsToTeamAdminConfigStatus owner tid FeatureStatusDisabled LockStatusLocked - -assertExposeInvitationURLsToTeamAdminConfigStatus :: UserId -> TeamId -> FeatureStatus -> LockStatus -> TestM () -assertExposeInvitationURLsToTeamAdminConfigStatus owner tid fStatus lStatus = do - getTeamFeature @ExposeInvitationURLsToTeamAdminConfig owner tid !!! do - const 200 === statusCode - const (Right (withStatus fStatus lStatus ExposeInvitationURLsToTeamAdminConfig FeatureTTLUnlimited)) === responseJsonEither - -assertFlagForbidden :: HasCallStack => TestM ResponseLBS -> TestM () -assertFlagForbidden res = do - res !!! do - statusCode === const 403 - fmap label . responseJsonMaybe === const (Just "no-team-member") - -assertFlagNoConfig :: - forall cfg. - ( HasCallStack, - Typeable cfg, - FromJSON (WithStatusNoLock cfg) - ) => - TestM ResponseLBS -> - FeatureStatus -> - TestM () -assertFlagNoConfig res expected = do - res !!! do - statusCode === const 200 - ( fmap wssStatus - . responseJsonEither @(WithStatusNoLock cfg) - ) - === const (Right expected) - -assertFlagNoConfigWithLockStatus :: - forall cfg. - ( HasCallStack, - Typeable cfg, - FeatureTrivialConfig cfg, - FromJSON (WithStatus cfg), - Eq cfg, - Show cfg - ) => - TestM ResponseLBS -> - FeatureStatus -> - LockStatus -> - TestM () -assertFlagNoConfigWithLockStatus res expectedStatus expectedLockStatus = do - res !!! do - statusCode === const 200 - responseJsonEither @(WithStatus cfg) - === const (Right (withStatus expectedStatus expectedLockStatus (trivialConfig @cfg) FeatureTTLUnlimited)) - -assertFlagWithConfig :: - forall cfg m. - ( HasCallStack, - Eq cfg, - ToSchema cfg, - Show cfg, - Typeable cfg, - IsFeatureConfig cfg, - MonadIO m, - MonadCatch m - ) => - m ResponseLBS -> - WithStatusNoLock cfg -> - m () -assertFlagWithConfig response expected = do - r <- response - let rJson = responseJsonEither @(WithStatusNoLock cfg) r - pure r !!! statusCode === const 200 - liftIO $ do - fmap wssStatus rJson @?= (Right . wssStatus $ expected) - fmap wssConfig rJson @?= (Right . wssConfig $ expected) - -wsAssertFeatureTrivialConfigUpdate :: - forall cfg. - ( IsFeatureConfig cfg, - KnownSymbol (FeatureSymbol cfg), - FeatureTrivialConfig cfg, - ToSchema cfg - ) => - FeatureStatus -> - FeatureTTL -> - Notification -> - IO () -wsAssertFeatureTrivialConfigUpdate status ttl notification = do - let e :: FeatureConfig.Event = List1.head (WS.unpackPayload notification) - FeatureConfig._eventType e @?= FeatureConfig.Update - FeatureConfig._eventFeatureName e @?= featureName @cfg - FeatureConfig._eventData e - @?= Aeson.toJSON - (withStatus status (wsLockStatus (defFeatureStatus @cfg)) (trivialConfig @cfg) ttl) - -wsAssertFeatureConfigWithLockStatusUpdate :: - forall cfg. - ( IsFeatureConfig cfg, - ToSchema cfg, - KnownSymbol (FeatureSymbol cfg), - FeatureTrivialConfig cfg - ) => - FeatureStatus -> - LockStatus -> - Notification -> - IO () -wsAssertFeatureConfigWithLockStatusUpdate status lockStatus notification = do - let e :: FeatureConfig.Event = List1.head (WS.unpackPayload notification) - FeatureConfig._eventType e @?= FeatureConfig.Update - FeatureConfig._eventFeatureName e @?= (featureName @cfg) - FeatureConfig._eventData e @?= Aeson.toJSON (withStatus status lockStatus (trivialConfig @cfg) FeatureTTLUnlimited) - -wsAssertFeatureConfigUpdate :: - forall cfg. - ( KnownSymbol (FeatureSymbol cfg), - ToJSON (WithStatus cfg) - ) => - WithStatusNoLock cfg -> - LockStatus -> - Notification -> - IO () -wsAssertFeatureConfigUpdate config lockStatus notification = do - let e :: FeatureConfig.Event = List1.head (WS.unpackPayload notification) - FeatureConfig._eventType e @?= FeatureConfig.Update - FeatureConfig._eventFeatureName e @?= featureName @cfg - FeatureConfig._eventData e @?= Aeson.toJSON (withLockStatus lockStatus config) - -defaultMlsMigrationConfig :: WithStatus MlsMigrationConfig -defaultMlsMigrationConfig = - withStatus - FeatureStatusEnabled - LockStatusLocked - MlsMigrationConfig - { startTime = fmap fromUTCTimeMillis (readUTCTimeMillis "2029-05-16T10:11:12.123Z"), - finaliseRegardlessAfter = fmap fromUTCTimeMillis (readUTCTimeMillis "2029-10-17T00:00:00.000Z") - } - FeatureTTLUnlimited - -defaultEnforceFileDownloadLocationConfig :: WithStatus EnforceFileDownloadLocationConfig -defaultEnforceFileDownloadLocationConfig = - withStatus - FeatureStatusDisabled - LockStatusLocked - (EnforceFileDownloadLocationConfig Nothing) - FeatureTTLUnlimited From 44dfa39eb23ac60e190148d054afcf3ca9c62312 Mon Sep 17 00:00:00 2001 From: Matthias Fischmann Date: Wed, 29 May 2024 22:09:38 +0200 Subject: [PATCH 13/64] Update email templates to v1.0.121. (#4064) --- .../2-features/email-templates-v1.0.110 | 1 + services/brig/deb/opt/brig/template-version | 2 +- .../de/provider/email/activation.html | 2 +- .../de/provider/email/approval-confirm.html | 2 +- .../email/approval-request-subject.txt | 1 + .../de/provider/email/approval-request.html | 2 +- .../templates/de/team/email/invitation.html | 2 +- .../de/team/email/new-member-welcome.html | 2 +- .../templates/de/user/email/activation.html | 2 +- .../templates/de/user/email/deletion.html | 2 +- .../templates/de/user/email/new-client.html | 2 +- .../de/user/email/password-reset.html | 2 +- .../de/user/email/team-activation.html | 2 +- .../brig/templates/de/user/email/update.html | 2 +- .../verification-delete-team-subject.txt | 1 + .../user/email/verification-delete-team.html | 2 +- .../user/email/verification-login-subject.txt | 1 + .../de/user/email/verification-login.html | 2 +- .../email/verification-scim-token-subject.txt | 1 + .../user/email/verification-scim-token.html | 2 +- .../templates/de/user/email/verification.html | 2 +- .../en/provider/email/activation.html | 2 +- .../en/provider/email/approval-confirm.html | 2 +- .../en/provider/email/approval-request.html | 2 +- .../templates/en/team/email/invitation.html | 2 +- .../en/team/email/new-member-welcome.html | 2 +- .../templates/en/user/email/activation.html | 2 +- .../templates/en/user/email/deletion.html | 2 +- .../templates/en/user/email/new-client.html | 2 +- .../en/user/email/password-reset.html | 2 +- .../en/user/email/team-activation.html | 2 +- .../brig/templates/en/user/email/update.html | 2 +- .../user/email/verification-delete-team.html | 2 +- .../en/user/email/verification-login.html | 2 +- .../user/email/verification-scim-token.html | 2 +- .../templates/en/user/email/verification.html | 2 +- .../templates/et/user/email/activation.html | 2 +- .../templates/et/user/email/deletion.html | 2 +- .../templates/et/user/email/new-client.html | 2 +- .../et/user/email/password-reset.html | 2 +- .../et/user/email/team-activation.html | 2 +- .../brig/templates/et/user/email/update.html | 2 +- .../user/email/verification-delete-team.html | 2 +- .../et/user/email/verification-login.html | 2 +- .../user/email/verification-scim-token.html | 2 +- .../templates/et/user/email/verification.html | 2 +- .../templates/fr/user/email/activation.html | 2 +- .../templates/fr/user/email/deletion.html | 2 +- .../templates/fr/user/email/new-client.html | 2 +- .../fr/user/email/password-reset.html | 2 +- .../fr/user/email/team-activation.html | 2 +- .../brig/templates/fr/user/email/update.html | 2 +- .../verification-delete-team-subject.txt | 1 + .../user/email/verification-delete-team.html | 2 +- .../fr/user/email/verification-login.html | 2 +- .../email/verification-scim-token-subject.txt | 1 + .../user/email/verification-scim-token.html | 2 +- .../templates/fr/user/email/verification.html | 2 +- .../brig/deb/opt/brig/templates/index.html | 2 +- .../templates/it/user/call/activation.txt | 2 +- .../opt/brig/templates/it/user/call/login.txt | 2 +- .../it/user/email/activation-subject.txt | 2 +- .../templates/it/user/email/activation.html | 125 +----------------- .../templates/it/user/email/activation.txt | 25 ++-- .../it/user/email/deletion-subject.txt | 2 +- .../templates/it/user/email/deletion.html | 124 +---------------- .../brig/templates/it/user/email/deletion.txt | 21 ++- .../templates/it/user/email/new-client.html | 100 +------------- .../templates/it/user/email/new-client.txt | 24 ++-- .../it/user/email/password-reset-subject.txt | 2 +- .../it/user/email/password-reset.html | 116 +--------------- .../it/user/email/password-reset.txt | 24 ++-- .../it/user/email/team-activation-subject.txt | 2 +- .../it/user/email/team-activation.html | 122 +---------------- .../it/user/email/team-activation.txt | 25 ++-- .../it/user/email/update-subject.txt | 2 +- .../brig/templates/it/user/email/update.html | 124 +---------------- .../brig/templates/it/user/email/update.txt | 25 ++-- .../verification-delete-team-subject.txt | 1 + .../user/email/verification-delete-team.html | 1 + .../user/email/verification-delete-team.txt | 18 +++ .../user/email/verification-login-subject.txt | 1 + .../it/user/email/verification-login.html | 1 + .../it/user/email/verification-login.txt | 18 +++ .../email/verification-scim-token-subject.txt | 1 + .../user/email/verification-scim-token.html | 1 + .../it/user/email/verification-scim-token.txt | 18 +++ .../it/user/email/verification-subject.txt | 1 + .../templates/it/user/email/verification.html | 83 +----------- .../templates/it/user/email/verification.txt | 20 +-- .../brig/templates/it/user/sms/activation.txt | 4 +- .../brig/templates/it/user/sms/deletion.txt | 4 +- .../opt/brig/templates/it/user/sms/login.txt | 4 +- .../templates/it/user/sms/password-reset.txt | 4 +- .../templates/ja/user/call/activation.txt | 1 + .../opt/brig/templates/ja/user/call/login.txt | 1 + .../ja/user/email/activation-subject.txt | 1 + .../templates/ja/user/email/activation.html | 1 + .../templates/ja/user/email/activation.txt | 19 +++ .../ja/user/email/deletion-subject.txt | 1 + .../templates/ja/user/email/deletion.html | 1 + .../brig/templates/ja/user/email/deletion.txt | 21 +++ .../ja/user/email/new-client-subject.txt | 1 + .../templates/ja/user/email/new-client.html | 1 + .../templates/ja/user/email/new-client.txt | 21 +++ .../ja/user/email/password-reset-subject.txt | 1 + .../ja/user/email/password-reset.html | 1 + .../ja/user/email/password-reset.txt | 18 +++ .../ja/user/email/team-activation-subject.txt | 1 + .../ja/user/email/team-activation.html | 1 + .../ja/user/email/team-activation.txt | 18 +++ .../ja/user/email/update-subject.txt | 1 + .../brig/templates/ja/user/email/update.html | 1 + .../brig/templates/ja/user/email/update.txt | 18 +++ .../verification-delete-team-subject.txt | 1 + .../user/email/verification-delete-team.html | 1 + .../user/email/verification-delete-team.txt | 17 +++ .../user/email/verification-login-subject.txt | 1 + .../ja/user/email/verification-login.html | 1 + .../ja/user/email/verification-login.txt | 17 +++ .../email/verification-scim-token-subject.txt | 1 + .../user/email/verification-scim-token.html | 1 + .../ja/user/email/verification-scim-token.txt | 17 +++ .../ja/user/email/verification-subject.txt | 1 + .../templates/ja/user/email/verification.html | 1 + .../templates/ja/user/email/verification.txt | 16 +++ .../brig/templates/ja/user/sms/activation.txt | 3 + .../brig/templates/ja/user/sms/deletion.txt | 2 + .../opt/brig/templates/ja/user/sms/login.txt | 3 + .../templates/ja/user/sms/password-reset.txt | 3 + .../templates/lt/user/email/activation.html | 2 +- .../templates/lt/user/email/deletion.html | 2 +- .../templates/lt/user/email/new-client.html | 2 +- .../lt/user/email/password-reset.html | 2 +- .../lt/user/email/team-activation.html | 2 +- .../brig/templates/lt/user/email/update.html | 2 +- .../user/email/verification-delete-team.html | 2 +- .../lt/user/email/verification-login.html | 2 +- .../user/email/verification-scim-token.html | 2 +- .../templates/lt/user/email/verification.html | 2 +- .../templates/pl/user/call/activation.txt | 1 + .../opt/brig/templates/pl/user/call/login.txt | 1 + .../pl/user/email/activation-subject.txt | 1 + .../templates/pl/user/email/activation.html | 1 + .../templates/pl/user/email/activation.txt | 21 +++ .../pl/user/email/deletion-subject.txt | 1 + .../templates/pl/user/email/deletion.html | 1 + .../brig/templates/pl/user/email/deletion.txt | 23 ++++ .../pl/user/email/new-client-subject.txt | 1 + .../templates/pl/user/email/new-client.html | 1 + .../templates/pl/user/email/new-client.txt | 23 ++++ .../pl/user/email/password-reset-subject.txt | 1 + .../pl/user/email/password-reset.html | 1 + .../pl/user/email/password-reset.txt | 21 +++ .../pl/user/email/team-activation-subject.txt | 1 + .../pl/user/email/team-activation.html | 1 + .../pl/user/email/team-activation.txt | 21 +++ .../pl/user/email/update-subject.txt | 1 + .../brig/templates/pl/user/email/update.html | 1 + .../brig/templates/pl/user/email/update.txt | 21 +++ .../verification-delete-team-subject.txt | 1 + .../user/email/verification-delete-team.html | 1 + .../user/email/verification-delete-team.txt | 18 +++ .../user/email/verification-login-subject.txt | 1 + .../pl/user/email/verification-login.html | 1 + .../pl/user/email/verification-login.txt | 18 +++ .../email/verification-scim-token-subject.txt | 1 + .../user/email/verification-scim-token.html | 1 + .../pl/user/email/verification-scim-token.txt | 18 +++ .../pl/user/email/verification-subject.txt | 1 + .../templates/pl/user/email/verification.html | 1 + .../templates/pl/user/email/verification.txt | 18 +++ .../brig/templates/pl/user/sms/activation.txt | 3 + .../brig/templates/pl/user/sms/deletion.txt | 2 + .../opt/brig/templates/pl/user/sms/login.txt | 3 + .../templates/pl/user/sms/password-reset.txt | 3 + .../templates/pt/user/call/activation.txt | 1 + .../opt/brig/templates/pt/user/call/login.txt | 1 + .../pt/user/email/activation-subject.txt | 1 + .../templates/pt/user/email/activation.html | 1 + .../templates/pt/user/email/activation.txt | 21 +++ .../pt/user/email/deletion-subject.txt | 1 + .../templates/pt/user/email/deletion.html | 1 + .../brig/templates/pt/user/email/deletion.txt | 24 ++++ .../pt/user/email/new-client-subject.txt | 1 + .../templates/pt/user/email/new-client.html | 1 + .../templates/pt/user/email/new-client.txt | 23 ++++ .../pt/user/email/password-reset-subject.txt | 1 + .../pt/user/email/password-reset.html | 1 + .../pt/user/email/password-reset.txt | 21 +++ .../pt/user/email/team-activation-subject.txt | 1 + .../pt/user/email/team-activation.html | 1 + .../pt/user/email/team-activation.txt | 21 +++ .../pt/user/email/update-subject.txt | 1 + .../brig/templates/pt/user/email/update.html | 1 + .../brig/templates/pt/user/email/update.txt | 21 +++ .../verification-delete-team-subject.txt | 1 + .../user/email/verification-delete-team.html | 1 + .../user/email/verification-delete-team.txt | 18 +++ .../user/email/verification-login-subject.txt | 1 + .../pt/user/email/verification-login.html | 1 + .../pt/user/email/verification-login.txt | 18 +++ .../email/verification-scim-token-subject.txt | 1 + .../user/email/verification-scim-token.html | 1 + .../pt/user/email/verification-scim-token.txt | 18 +++ .../pt/user/email/verification-subject.txt | 1 + .../templates/pt/user/email/verification.html | 1 + .../templates/pt/user/email/verification.txt | 18 +++ .../brig/templates/pt/user/sms/activation.txt | 3 + .../brig/templates/pt/user/sms/deletion.txt | 2 + .../opt/brig/templates/pt/user/sms/login.txt | 3 + .../templates/pt/user/sms/password-reset.txt | 3 + .../templates/ru/user/email/activation.html | 2 +- .../templates/ru/user/email/deletion.html | 2 +- .../templates/ru/user/email/new-client.html | 2 +- .../templates/ru/user/email/new-client.txt | 6 +- .../ru/user/email/password-reset.html | 2 +- .../ru/user/email/team-activation.html | 2 +- .../ru/user/email/team-activation.txt | 2 +- .../brig/templates/ru/user/email/update.html | 2 +- .../verification-delete-team-subject.txt | 1 + .../user/email/verification-delete-team.html | 2 +- .../user/email/verification-login-subject.txt | 1 + .../ru/user/email/verification-login.html | 2 +- .../email/verification-scim-token-subject.txt | 1 + .../user/email/verification-scim-token.html | 2 +- .../templates/ru/user/email/verification.html | 2 +- .../templates/si/user/call/activation.txt | 1 + .../opt/brig/templates/si/user/call/login.txt | 1 + .../si/user/email/activation-subject.txt | 1 + .../templates/si/user/email/activation.html | 1 + .../templates/si/user/email/activation.txt | 21 +++ .../si/user/email/deletion-subject.txt | 1 + .../templates/si/user/email/deletion.html | 1 + .../brig/templates/si/user/email/deletion.txt | 23 ++++ .../si/user/email/new-client-subject.txt | 1 + .../templates/si/user/email/new-client.html | 1 + .../templates/si/user/email/new-client.txt | 22 +++ .../si/user/email/password-reset-subject.txt | 1 + .../si/user/email/password-reset.html | 1 + .../si/user/email/password-reset.txt | 21 +++ .../si/user/email/team-activation-subject.txt | 1 + .../si/user/email/team-activation.html | 1 + .../si/user/email/team-activation.txt | 20 +++ .../si/user/email/update-subject.txt | 1 + .../brig/templates/si/user/email/update.html | 1 + .../brig/templates/si/user/email/update.txt | 21 +++ .../verification-delete-team-subject.txt | 1 + .../user/email/verification-delete-team.html | 1 + .../user/email/verification-delete-team.txt | 18 +++ .../user/email/verification-login-subject.txt | 1 + .../si/user/email/verification-login.html | 1 + .../si/user/email/verification-login.txt | 18 +++ .../email/verification-scim-token-subject.txt | 1 + .../user/email/verification-scim-token.html | 1 + .../si/user/email/verification-scim-token.txt | 18 +++ .../si/user/email/verification-subject.txt | 1 + .../templates/si/user/email/verification.html | 1 + .../templates/si/user/email/verification.txt | 18 +++ .../brig/templates/si/user/sms/activation.txt | 3 + .../brig/templates/si/user/sms/deletion.txt | 2 + .../opt/brig/templates/si/user/sms/login.txt | 3 + .../templates/si/user/sms/password-reset.txt | 3 + .../templates/tr/user/call/activation.txt | 2 +- .../opt/brig/templates/tr/user/call/login.txt | 2 +- .../tr/user/email/activation-subject.txt | 1 + .../templates/tr/user/email/activation.html | 1 + .../templates/tr/user/email/activation.txt | 21 +++ .../tr/user/email/deletion-subject.txt | 1 + .../templates/tr/user/email/deletion.html | 1 + .../brig/templates/tr/user/email/deletion.txt | 24 ++++ .../tr/user/email/new-client-subject.txt | 1 + .../templates/tr/user/email/new-client.html | 1 + .../templates/tr/user/email/new-client.txt | 23 ++++ .../tr/user/email/password-reset-subject.txt | 1 + .../tr/user/email/password-reset.html | 1 + .../tr/user/email/password-reset.txt | 21 +++ .../tr/user/email/team-activation-subject.txt | 1 + .../tr/user/email/team-activation.html | 1 + .../tr/user/email/team-activation.txt | 21 +++ .../tr/user/email/update-subject.txt | 1 + .../brig/templates/tr/user/email/update.html | 1 + .../brig/templates/tr/user/email/update.txt | 21 +++ .../verification-delete-team-subject.txt | 1 + .../user/email/verification-delete-team.html | 1 + .../user/email/verification-delete-team.txt | 18 +++ .../user/email/verification-login-subject.txt | 1 + .../tr/user/email/verification-login.html | 1 + .../tr/user/email/verification-login.txt | 18 +++ .../email/verification-scim-token-subject.txt | 1 + .../user/email/verification-scim-token.html | 1 + .../tr/user/email/verification-scim-token.txt | 18 +++ .../tr/user/email/verification-subject.txt | 1 + .../templates/tr/user/email/verification.html | 1 + .../templates/tr/user/email/verification.txt | 18 +++ .../brig/templates/tr/user/sms/activation.txt | 4 +- .../brig/templates/tr/user/sms/deletion.txt | 4 +- .../opt/brig/templates/tr/user/sms/login.txt | 4 +- .../templates/tr/user/sms/password-reset.txt | 4 +- services/brig/deb/opt/brig/templates/version | 2 +- .../templates/vi/user/call/activation.txt | 1 + .../opt/brig/templates/vi/user/call/login.txt | 1 + .../vi/user/email/activation-subject.txt | 1 + .../templates/vi/user/email/activation.html | 1 + .../templates/vi/user/email/activation.txt | 21 +++ .../vi/user/email/deletion-subject.txt | 1 + .../templates/vi/user/email/deletion.html | 1 + .../brig/templates/vi/user/email/deletion.txt | 24 ++++ .../vi/user/email/new-client-subject.txt | 1 + .../templates/vi/user/email/new-client.html | 1 + .../templates/vi/user/email/new-client.txt | 23 ++++ .../vi/user/email/password-reset-subject.txt | 1 + .../vi/user/email/password-reset.html | 1 + .../vi/user/email/password-reset.txt | 21 +++ .../vi/user/email/team-activation-subject.txt | 1 + .../vi/user/email/team-activation.html | 1 + .../vi/user/email/team-activation.txt | 21 +++ .../vi/user/email/update-subject.txt | 1 + .../brig/templates/vi/user/email/update.html | 1 + .../brig/templates/vi/user/email/update.txt | 21 +++ .../verification-delete-team-subject.txt | 1 + .../user/email/verification-delete-team.html | 1 + .../user/email/verification-delete-team.txt | 18 +++ .../user/email/verification-login-subject.txt | 1 + .../vi/user/email/verification-login.html | 1 + .../vi/user/email/verification-login.txt | 18 +++ .../email/verification-scim-token-subject.txt | 1 + .../user/email/verification-scim-token.html | 1 + .../vi/user/email/verification-scim-token.txt | 18 +++ .../vi/user/email/verification-subject.txt | 1 + .../templates/vi/user/email/verification.html | 1 + .../templates/vi/user/email/verification.txt | 18 +++ .../brig/templates/vi/user/sms/activation.txt | 3 + .../brig/templates/vi/user/sms/deletion.txt | 2 + .../opt/brig/templates/vi/user/sms/login.txt | 3 + .../templates/vi/user/sms/password-reset.txt | 3 + 336 files changed, 1645 insertions(+), 966 deletions(-) create mode 100644 changelog.d/2-features/email-templates-v1.0.110 create mode 100644 services/brig/deb/opt/brig/templates/it/user/email/verification-delete-team-subject.txt create mode 100644 services/brig/deb/opt/brig/templates/it/user/email/verification-delete-team.html create mode 100644 services/brig/deb/opt/brig/templates/it/user/email/verification-delete-team.txt create mode 100644 services/brig/deb/opt/brig/templates/it/user/email/verification-login-subject.txt create mode 100644 services/brig/deb/opt/brig/templates/it/user/email/verification-login.html create mode 100644 services/brig/deb/opt/brig/templates/it/user/email/verification-login.txt create mode 100644 services/brig/deb/opt/brig/templates/it/user/email/verification-scim-token-subject.txt create mode 100644 services/brig/deb/opt/brig/templates/it/user/email/verification-scim-token.html create mode 100644 services/brig/deb/opt/brig/templates/it/user/email/verification-scim-token.txt create mode 100644 services/brig/deb/opt/brig/templates/it/user/email/verification-subject.txt create mode 100644 services/brig/deb/opt/brig/templates/ja/user/call/activation.txt create mode 100644 services/brig/deb/opt/brig/templates/ja/user/call/login.txt create mode 100644 services/brig/deb/opt/brig/templates/ja/user/email/activation-subject.txt create mode 100644 services/brig/deb/opt/brig/templates/ja/user/email/activation.html create mode 100644 services/brig/deb/opt/brig/templates/ja/user/email/activation.txt create mode 100644 services/brig/deb/opt/brig/templates/ja/user/email/deletion-subject.txt create mode 100644 services/brig/deb/opt/brig/templates/ja/user/email/deletion.html create mode 100644 services/brig/deb/opt/brig/templates/ja/user/email/deletion.txt create mode 100644 services/brig/deb/opt/brig/templates/ja/user/email/new-client-subject.txt create mode 100644 services/brig/deb/opt/brig/templates/ja/user/email/new-client.html create mode 100644 services/brig/deb/opt/brig/templates/ja/user/email/new-client.txt create mode 100644 services/brig/deb/opt/brig/templates/ja/user/email/password-reset-subject.txt create mode 100644 services/brig/deb/opt/brig/templates/ja/user/email/password-reset.html create mode 100644 services/brig/deb/opt/brig/templates/ja/user/email/password-reset.txt create mode 100644 services/brig/deb/opt/brig/templates/ja/user/email/team-activation-subject.txt create mode 100644 services/brig/deb/opt/brig/templates/ja/user/email/team-activation.html create mode 100644 services/brig/deb/opt/brig/templates/ja/user/email/team-activation.txt create mode 100644 services/brig/deb/opt/brig/templates/ja/user/email/update-subject.txt create mode 100644 services/brig/deb/opt/brig/templates/ja/user/email/update.html create mode 100644 services/brig/deb/opt/brig/templates/ja/user/email/update.txt create mode 100644 services/brig/deb/opt/brig/templates/ja/user/email/verification-delete-team-subject.txt create mode 100644 services/brig/deb/opt/brig/templates/ja/user/email/verification-delete-team.html create mode 100644 services/brig/deb/opt/brig/templates/ja/user/email/verification-delete-team.txt create mode 100644 services/brig/deb/opt/brig/templates/ja/user/email/verification-login-subject.txt create mode 100644 services/brig/deb/opt/brig/templates/ja/user/email/verification-login.html create mode 100644 services/brig/deb/opt/brig/templates/ja/user/email/verification-login.txt create mode 100644 services/brig/deb/opt/brig/templates/ja/user/email/verification-scim-token-subject.txt create mode 100644 services/brig/deb/opt/brig/templates/ja/user/email/verification-scim-token.html create mode 100644 services/brig/deb/opt/brig/templates/ja/user/email/verification-scim-token.txt create mode 100644 services/brig/deb/opt/brig/templates/ja/user/email/verification-subject.txt create mode 100644 services/brig/deb/opt/brig/templates/ja/user/email/verification.html create mode 100644 services/brig/deb/opt/brig/templates/ja/user/email/verification.txt create mode 100644 services/brig/deb/opt/brig/templates/ja/user/sms/activation.txt create mode 100644 services/brig/deb/opt/brig/templates/ja/user/sms/deletion.txt create mode 100644 services/brig/deb/opt/brig/templates/ja/user/sms/login.txt create mode 100644 services/brig/deb/opt/brig/templates/ja/user/sms/password-reset.txt create mode 100644 services/brig/deb/opt/brig/templates/pl/user/call/activation.txt create mode 100644 services/brig/deb/opt/brig/templates/pl/user/call/login.txt create mode 100644 services/brig/deb/opt/brig/templates/pl/user/email/activation-subject.txt create mode 100644 services/brig/deb/opt/brig/templates/pl/user/email/activation.html create mode 100644 services/brig/deb/opt/brig/templates/pl/user/email/activation.txt create mode 100644 services/brig/deb/opt/brig/templates/pl/user/email/deletion-subject.txt create mode 100644 services/brig/deb/opt/brig/templates/pl/user/email/deletion.html create mode 100644 services/brig/deb/opt/brig/templates/pl/user/email/deletion.txt create mode 100644 services/brig/deb/opt/brig/templates/pl/user/email/new-client-subject.txt create mode 100644 services/brig/deb/opt/brig/templates/pl/user/email/new-client.html create mode 100644 services/brig/deb/opt/brig/templates/pl/user/email/new-client.txt create mode 100644 services/brig/deb/opt/brig/templates/pl/user/email/password-reset-subject.txt create mode 100644 services/brig/deb/opt/brig/templates/pl/user/email/password-reset.html create mode 100644 services/brig/deb/opt/brig/templates/pl/user/email/password-reset.txt create mode 100644 services/brig/deb/opt/brig/templates/pl/user/email/team-activation-subject.txt create mode 100644 services/brig/deb/opt/brig/templates/pl/user/email/team-activation.html create mode 100644 services/brig/deb/opt/brig/templates/pl/user/email/team-activation.txt create mode 100644 services/brig/deb/opt/brig/templates/pl/user/email/update-subject.txt create mode 100644 services/brig/deb/opt/brig/templates/pl/user/email/update.html create mode 100644 services/brig/deb/opt/brig/templates/pl/user/email/update.txt create mode 100644 services/brig/deb/opt/brig/templates/pl/user/email/verification-delete-team-subject.txt create mode 100644 services/brig/deb/opt/brig/templates/pl/user/email/verification-delete-team.html create mode 100644 services/brig/deb/opt/brig/templates/pl/user/email/verification-delete-team.txt create mode 100644 services/brig/deb/opt/brig/templates/pl/user/email/verification-login-subject.txt create mode 100644 services/brig/deb/opt/brig/templates/pl/user/email/verification-login.html create mode 100644 services/brig/deb/opt/brig/templates/pl/user/email/verification-login.txt create mode 100644 services/brig/deb/opt/brig/templates/pl/user/email/verification-scim-token-subject.txt create mode 100644 services/brig/deb/opt/brig/templates/pl/user/email/verification-scim-token.html create mode 100644 services/brig/deb/opt/brig/templates/pl/user/email/verification-scim-token.txt create mode 100644 services/brig/deb/opt/brig/templates/pl/user/email/verification-subject.txt create mode 100644 services/brig/deb/opt/brig/templates/pl/user/email/verification.html create mode 100644 services/brig/deb/opt/brig/templates/pl/user/email/verification.txt create mode 100644 services/brig/deb/opt/brig/templates/pl/user/sms/activation.txt create mode 100644 services/brig/deb/opt/brig/templates/pl/user/sms/deletion.txt create mode 100644 services/brig/deb/opt/brig/templates/pl/user/sms/login.txt create mode 100644 services/brig/deb/opt/brig/templates/pl/user/sms/password-reset.txt create mode 100644 services/brig/deb/opt/brig/templates/pt/user/call/activation.txt create mode 100644 services/brig/deb/opt/brig/templates/pt/user/call/login.txt create mode 100644 services/brig/deb/opt/brig/templates/pt/user/email/activation-subject.txt create mode 100644 services/brig/deb/opt/brig/templates/pt/user/email/activation.html create mode 100644 services/brig/deb/opt/brig/templates/pt/user/email/activation.txt create mode 100644 services/brig/deb/opt/brig/templates/pt/user/email/deletion-subject.txt create mode 100644 services/brig/deb/opt/brig/templates/pt/user/email/deletion.html create mode 100644 services/brig/deb/opt/brig/templates/pt/user/email/deletion.txt create mode 100644 services/brig/deb/opt/brig/templates/pt/user/email/new-client-subject.txt create mode 100644 services/brig/deb/opt/brig/templates/pt/user/email/new-client.html create mode 100644 services/brig/deb/opt/brig/templates/pt/user/email/new-client.txt create mode 100644 services/brig/deb/opt/brig/templates/pt/user/email/password-reset-subject.txt create mode 100644 services/brig/deb/opt/brig/templates/pt/user/email/password-reset.html create mode 100644 services/brig/deb/opt/brig/templates/pt/user/email/password-reset.txt create mode 100644 services/brig/deb/opt/brig/templates/pt/user/email/team-activation-subject.txt create mode 100644 services/brig/deb/opt/brig/templates/pt/user/email/team-activation.html create mode 100644 services/brig/deb/opt/brig/templates/pt/user/email/team-activation.txt create mode 100644 services/brig/deb/opt/brig/templates/pt/user/email/update-subject.txt create mode 100644 services/brig/deb/opt/brig/templates/pt/user/email/update.html create mode 100644 services/brig/deb/opt/brig/templates/pt/user/email/update.txt create mode 100644 services/brig/deb/opt/brig/templates/pt/user/email/verification-delete-team-subject.txt create mode 100644 services/brig/deb/opt/brig/templates/pt/user/email/verification-delete-team.html create mode 100644 services/brig/deb/opt/brig/templates/pt/user/email/verification-delete-team.txt create mode 100644 services/brig/deb/opt/brig/templates/pt/user/email/verification-login-subject.txt create mode 100644 services/brig/deb/opt/brig/templates/pt/user/email/verification-login.html create mode 100644 services/brig/deb/opt/brig/templates/pt/user/email/verification-login.txt create mode 100644 services/brig/deb/opt/brig/templates/pt/user/email/verification-scim-token-subject.txt create mode 100644 services/brig/deb/opt/brig/templates/pt/user/email/verification-scim-token.html create mode 100644 services/brig/deb/opt/brig/templates/pt/user/email/verification-scim-token.txt create mode 100644 services/brig/deb/opt/brig/templates/pt/user/email/verification-subject.txt create mode 100644 services/brig/deb/opt/brig/templates/pt/user/email/verification.html create mode 100644 services/brig/deb/opt/brig/templates/pt/user/email/verification.txt create mode 100644 services/brig/deb/opt/brig/templates/pt/user/sms/activation.txt create mode 100644 services/brig/deb/opt/brig/templates/pt/user/sms/deletion.txt create mode 100644 services/brig/deb/opt/brig/templates/pt/user/sms/login.txt create mode 100644 services/brig/deb/opt/brig/templates/pt/user/sms/password-reset.txt create mode 100644 services/brig/deb/opt/brig/templates/si/user/call/activation.txt create mode 100644 services/brig/deb/opt/brig/templates/si/user/call/login.txt create mode 100644 services/brig/deb/opt/brig/templates/si/user/email/activation-subject.txt create mode 100644 services/brig/deb/opt/brig/templates/si/user/email/activation.html create mode 100644 services/brig/deb/opt/brig/templates/si/user/email/activation.txt create mode 100644 services/brig/deb/opt/brig/templates/si/user/email/deletion-subject.txt create mode 100644 services/brig/deb/opt/brig/templates/si/user/email/deletion.html create mode 100644 services/brig/deb/opt/brig/templates/si/user/email/deletion.txt create mode 100644 services/brig/deb/opt/brig/templates/si/user/email/new-client-subject.txt create mode 100644 services/brig/deb/opt/brig/templates/si/user/email/new-client.html create mode 100644 services/brig/deb/opt/brig/templates/si/user/email/new-client.txt create mode 100644 services/brig/deb/opt/brig/templates/si/user/email/password-reset-subject.txt create mode 100644 services/brig/deb/opt/brig/templates/si/user/email/password-reset.html create mode 100644 services/brig/deb/opt/brig/templates/si/user/email/password-reset.txt create mode 100644 services/brig/deb/opt/brig/templates/si/user/email/team-activation-subject.txt create mode 100644 services/brig/deb/opt/brig/templates/si/user/email/team-activation.html create mode 100644 services/brig/deb/opt/brig/templates/si/user/email/team-activation.txt create mode 100644 services/brig/deb/opt/brig/templates/si/user/email/update-subject.txt create mode 100644 services/brig/deb/opt/brig/templates/si/user/email/update.html create mode 100644 services/brig/deb/opt/brig/templates/si/user/email/update.txt create mode 100644 services/brig/deb/opt/brig/templates/si/user/email/verification-delete-team-subject.txt create mode 100644 services/brig/deb/opt/brig/templates/si/user/email/verification-delete-team.html create mode 100644 services/brig/deb/opt/brig/templates/si/user/email/verification-delete-team.txt create mode 100644 services/brig/deb/opt/brig/templates/si/user/email/verification-login-subject.txt create mode 100644 services/brig/deb/opt/brig/templates/si/user/email/verification-login.html create mode 100644 services/brig/deb/opt/brig/templates/si/user/email/verification-login.txt create mode 100644 services/brig/deb/opt/brig/templates/si/user/email/verification-scim-token-subject.txt create mode 100644 services/brig/deb/opt/brig/templates/si/user/email/verification-scim-token.html create mode 100644 services/brig/deb/opt/brig/templates/si/user/email/verification-scim-token.txt create mode 100644 services/brig/deb/opt/brig/templates/si/user/email/verification-subject.txt create mode 100644 services/brig/deb/opt/brig/templates/si/user/email/verification.html create mode 100644 services/brig/deb/opt/brig/templates/si/user/email/verification.txt create mode 100644 services/brig/deb/opt/brig/templates/si/user/sms/activation.txt create mode 100644 services/brig/deb/opt/brig/templates/si/user/sms/deletion.txt create mode 100644 services/brig/deb/opt/brig/templates/si/user/sms/login.txt create mode 100644 services/brig/deb/opt/brig/templates/si/user/sms/password-reset.txt create mode 100644 services/brig/deb/opt/brig/templates/tr/user/email/activation-subject.txt create mode 100644 services/brig/deb/opt/brig/templates/tr/user/email/activation.html create mode 100644 services/brig/deb/opt/brig/templates/tr/user/email/activation.txt create mode 100644 services/brig/deb/opt/brig/templates/tr/user/email/deletion-subject.txt create mode 100644 services/brig/deb/opt/brig/templates/tr/user/email/deletion.html create mode 100644 services/brig/deb/opt/brig/templates/tr/user/email/deletion.txt create mode 100644 services/brig/deb/opt/brig/templates/tr/user/email/new-client-subject.txt create mode 100644 services/brig/deb/opt/brig/templates/tr/user/email/new-client.html create mode 100644 services/brig/deb/opt/brig/templates/tr/user/email/new-client.txt create mode 100644 services/brig/deb/opt/brig/templates/tr/user/email/password-reset-subject.txt create mode 100644 services/brig/deb/opt/brig/templates/tr/user/email/password-reset.html create mode 100644 services/brig/deb/opt/brig/templates/tr/user/email/password-reset.txt create mode 100644 services/brig/deb/opt/brig/templates/tr/user/email/team-activation-subject.txt create mode 100644 services/brig/deb/opt/brig/templates/tr/user/email/team-activation.html create mode 100644 services/brig/deb/opt/brig/templates/tr/user/email/team-activation.txt create mode 100644 services/brig/deb/opt/brig/templates/tr/user/email/update-subject.txt create mode 100644 services/brig/deb/opt/brig/templates/tr/user/email/update.html create mode 100644 services/brig/deb/opt/brig/templates/tr/user/email/update.txt create mode 100644 services/brig/deb/opt/brig/templates/tr/user/email/verification-delete-team-subject.txt create mode 100644 services/brig/deb/opt/brig/templates/tr/user/email/verification-delete-team.html create mode 100644 services/brig/deb/opt/brig/templates/tr/user/email/verification-delete-team.txt create mode 100644 services/brig/deb/opt/brig/templates/tr/user/email/verification-login-subject.txt create mode 100644 services/brig/deb/opt/brig/templates/tr/user/email/verification-login.html create mode 100644 services/brig/deb/opt/brig/templates/tr/user/email/verification-login.txt create mode 100644 services/brig/deb/opt/brig/templates/tr/user/email/verification-scim-token-subject.txt create mode 100644 services/brig/deb/opt/brig/templates/tr/user/email/verification-scim-token.html create mode 100644 services/brig/deb/opt/brig/templates/tr/user/email/verification-scim-token.txt create mode 100644 services/brig/deb/opt/brig/templates/tr/user/email/verification-subject.txt create mode 100644 services/brig/deb/opt/brig/templates/tr/user/email/verification.html create mode 100644 services/brig/deb/opt/brig/templates/tr/user/email/verification.txt create mode 100644 services/brig/deb/opt/brig/templates/vi/user/call/activation.txt create mode 100644 services/brig/deb/opt/brig/templates/vi/user/call/login.txt create mode 100644 services/brig/deb/opt/brig/templates/vi/user/email/activation-subject.txt create mode 100644 services/brig/deb/opt/brig/templates/vi/user/email/activation.html create mode 100644 services/brig/deb/opt/brig/templates/vi/user/email/activation.txt create mode 100644 services/brig/deb/opt/brig/templates/vi/user/email/deletion-subject.txt create mode 100644 services/brig/deb/opt/brig/templates/vi/user/email/deletion.html create mode 100644 services/brig/deb/opt/brig/templates/vi/user/email/deletion.txt create mode 100644 services/brig/deb/opt/brig/templates/vi/user/email/new-client-subject.txt create mode 100644 services/brig/deb/opt/brig/templates/vi/user/email/new-client.html create mode 100644 services/brig/deb/opt/brig/templates/vi/user/email/new-client.txt create mode 100644 services/brig/deb/opt/brig/templates/vi/user/email/password-reset-subject.txt create mode 100644 services/brig/deb/opt/brig/templates/vi/user/email/password-reset.html create mode 100644 services/brig/deb/opt/brig/templates/vi/user/email/password-reset.txt create mode 100644 services/brig/deb/opt/brig/templates/vi/user/email/team-activation-subject.txt create mode 100644 services/brig/deb/opt/brig/templates/vi/user/email/team-activation.html create mode 100644 services/brig/deb/opt/brig/templates/vi/user/email/team-activation.txt create mode 100644 services/brig/deb/opt/brig/templates/vi/user/email/update-subject.txt create mode 100644 services/brig/deb/opt/brig/templates/vi/user/email/update.html create mode 100644 services/brig/deb/opt/brig/templates/vi/user/email/update.txt create mode 100644 services/brig/deb/opt/brig/templates/vi/user/email/verification-delete-team-subject.txt create mode 100644 services/brig/deb/opt/brig/templates/vi/user/email/verification-delete-team.html create mode 100644 services/brig/deb/opt/brig/templates/vi/user/email/verification-delete-team.txt create mode 100644 services/brig/deb/opt/brig/templates/vi/user/email/verification-login-subject.txt create mode 100644 services/brig/deb/opt/brig/templates/vi/user/email/verification-login.html create mode 100644 services/brig/deb/opt/brig/templates/vi/user/email/verification-login.txt create mode 100644 services/brig/deb/opt/brig/templates/vi/user/email/verification-scim-token-subject.txt create mode 100644 services/brig/deb/opt/brig/templates/vi/user/email/verification-scim-token.html create mode 100644 services/brig/deb/opt/brig/templates/vi/user/email/verification-scim-token.txt create mode 100644 services/brig/deb/opt/brig/templates/vi/user/email/verification-subject.txt create mode 100644 services/brig/deb/opt/brig/templates/vi/user/email/verification.html create mode 100644 services/brig/deb/opt/brig/templates/vi/user/email/verification.txt create mode 100644 services/brig/deb/opt/brig/templates/vi/user/sms/activation.txt create mode 100644 services/brig/deb/opt/brig/templates/vi/user/sms/deletion.txt create mode 100644 services/brig/deb/opt/brig/templates/vi/user/sms/login.txt create mode 100644 services/brig/deb/opt/brig/templates/vi/user/sms/password-reset.txt diff --git a/changelog.d/2-features/email-templates-v1.0.110 b/changelog.d/2-features/email-templates-v1.0.110 new file mode 100644 index 00000000000..d8807d1328a --- /dev/null +++ b/changelog.d/2-features/email-templates-v1.0.110 @@ -0,0 +1 @@ +Update email templates to v1.0.121. diff --git a/services/brig/deb/opt/brig/template-version b/services/brig/deb/opt/brig/template-version index 4af04f0f334..fea60e70c1a 100644 --- a/services/brig/deb/opt/brig/template-version +++ b/services/brig/deb/opt/brig/template-version @@ -1 +1 @@ -v1.0.102 +v1.0.121 diff --git a/services/brig/deb/opt/brig/templates/de/provider/email/activation.html b/services/brig/deb/opt/brig/templates/de/provider/email/activation.html index b612ef7f8a2..e0f5f48f6a9 100644 --- a/services/brig/deb/opt/brig/templates/de/provider/email/activation.html +++ b/services/brig/deb/opt/brig/templates/de/provider/email/activation.html @@ -1 +1 @@ -Ihr ${brand_service}-Benutzerkonto

${brand_label_url}

Bestätigen Sie Ihre E-Mail-Adresse

Ihre E-Mail-Adresse ${email} wurde verwendet, um sich als ${brand_service} zu registrieren.

Um die Registrierung abzuschließen, bestätigen Sie bitte Ihre E-Mail-Adresse, indem Sie auf den unteren Button klicken.

Bitte beachten Sie, dass das Service-Provider-Konto nach der Bestätigung der E-Mail-Adresse noch durch uns freigeschaltet werden muss. Dies geschieht üblicherweise innerhalb von 24 Stunden. Sie werden in einer separaten E-Mail über die Freischaltung informiert.

 
Bestätigen
 

Falls Sie nicht auf den Button klicken können, kopieren Sie diesen Link und fügen Sie ihn in Ihren Browser ein:

${url}

Wenn Sie sich nicht mit dieser E-Mail-Adresse für ein ${brand}-Benutzerkonto registriert haben, können Sie diese Nachricht ignorieren. Wenn Sie den Missbrauch Ihrer E-Mail-Adresse melden möchten, kontaktiere Sie uns bitte.

Bitte antworten Sie nicht auf diese Nachricht.

Datenschutzrichtlinien und Nutzungsbedingungen · Missbrauch melden
${copyright}. ALLE RECHTE VORBEHALTEN.

                                                           
\ No newline at end of file +Ihr ${brand_service}-Benutzerkonto

${brand_label_url}

Bestätigen Sie Ihre E-Mail-Adresse

Ihre E-Mail-Adresse ${email} wurde verwendet, um sich als ${brand_service} zu registrieren.

Um die Registrierung abzuschließen, bestätigen Sie bitte Ihre E-Mail-Adresse, indem Sie auf den unteren Button klicken.

Bitte beachten Sie, dass das Service-Provider-Konto nach der Bestätigung der E-Mail-Adresse noch durch uns freigeschaltet werden muss. Dies geschieht üblicherweise innerhalb von 24 Stunden. Sie werden in einer separaten E-Mail über die Freischaltung informiert.

 
Bestätigen
 

Falls Sie nicht auf den Button klicken können, kopieren Sie diesen Link und fügen Sie ihn in Ihren Browser ein:

${url}

Wenn Sie sich nicht mit dieser E-Mail-Adresse für ein ${brand}-Benutzerkonto registriert haben, können Sie diese Nachricht ignorieren. Wenn Sie den Missbrauch Ihrer E-Mail-Adresse melden möchten, kontaktiere Sie uns bitte.

Bitte antworten Sie nicht auf diese Nachricht.

Datenschutzrichtlinien und Nutzungsbedingungen · Missbrauch melden
${copyright}. ALLE RECHTE VORBEHALTEN.

                                                           
\ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/de/provider/email/approval-confirm.html b/services/brig/deb/opt/brig/templates/de/provider/email/approval-confirm.html index 5ddabbceeed..dba2f45a57b 100644 --- a/services/brig/deb/opt/brig/templates/de/provider/email/approval-confirm.html +++ b/services/brig/deb/opt/brig/templates/de/provider/email/approval-confirm.html @@ -1 +1 @@ -Ihr ${brand_service}-Benutzerkonto

${brand_label_url}

Guten Tag,

Wir freuen uns, Ihnen mitteilen zu können, dass Sie jetzt ein anerkannter ${brand_service} sind.

Bitte antworten Sie nicht auf diese Nachricht.

Wenn Sie sich nicht mit dieser E-Mail-Adresse für ein ${brand_service}-Konto registriert haben, kontaktieren Sie uns bitte.

Datenschutzrichtlinien und Nutzungsbedingungen · Missbrauch melden
${copyright}. ALLE RECHTE VORBEHALTEN.

                                                           
\ No newline at end of file +Ihr ${brand_service}-Benutzerkonto

${brand_label_url}

Guten Tag,

Wir freuen uns, Ihnen mitteilen zu können, dass Sie jetzt ein anerkannter ${brand_service} sind.

Bitte antworten Sie nicht auf diese Nachricht.

Wenn Sie sich nicht mit dieser E-Mail-Adresse für ein ${brand_service}-Konto registriert haben, kontaktieren Sie uns bitte.

Datenschutzrichtlinien und Nutzungsbedingungen · Missbrauch melden
${copyright}. ALLE RECHTE VORBEHALTEN.

                                                           
\ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/de/provider/email/approval-request-subject.txt b/services/brig/deb/opt/brig/templates/de/provider/email/approval-request-subject.txt index e69de29bb2d..c443f0f727c 100644 --- a/services/brig/deb/opt/brig/templates/de/provider/email/approval-request-subject.txt +++ b/services/brig/deb/opt/brig/templates/de/provider/email/approval-request-subject.txt @@ -0,0 +1 @@ +Genehmigungsanfrage: ${brand_service} \ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/de/provider/email/approval-request.html b/services/brig/deb/opt/brig/templates/de/provider/email/approval-request.html index 4d25202c0a6..c15511e2223 100644 --- a/services/brig/deb/opt/brig/templates/de/provider/email/approval-request.html +++ b/services/brig/deb/opt/brig/templates/de/provider/email/approval-request.html @@ -1 +1 @@ -

${brand_label_url}

Genehmigungsanfrage

Ein neuer ${brand_service} ist registriert und wartet auf die Genehmigung. Bitte lesen Sie die unten angegebenen Informationen.

Name: ${name}

E-Mail: ${email}

Website: ${url}

Beschreibung: ${description}

Wenn die Anfrage echt scheint, können Sie den Anbieter genehmigen, indem Sie auf den unteren Button klicken. Sobald genehmigt, kann sich der Anbieter anmelden und mit der Registrierung von Diensten beginnen, die ${brand}-Nutzer ihren Unterhaltungen hinzufügen können.

Falls die Anfrage zweifelhaft scheint, wenden Sie sich bitte an den Anbieter zur Klärung, bevor Sie fortfahren.

 
Genehmigen
 

Falls Sie nicht auf den Button klicken können, kopieren Sie diesen Link und fügen Sie ihn in Ihren Browser ein:

${url}

Bitte antworten Sie nicht auf diese Nachricht.

Datenschutzrichtlinien und Nutzungsbedingungen · Missbrauch melden
${copyright}. ALLE RECHTE VORBEHALTEN.

                                                           
\ No newline at end of file +Genehmigungsanfrage: ${brand_service}

${brand_label_url}

Genehmigungsanfrage

Ein neuer ${brand_service} ist registriert und wartet auf die Genehmigung. Bitte lesen Sie die unten angegebenen Informationen.

Name: ${name}

E-Mail: ${email}

Website: ${url}

Beschreibung: ${description}

Wenn die Anfrage echt scheint, können Sie den Anbieter genehmigen, indem Sie auf den unteren Button klicken. Sobald genehmigt, kann sich der Anbieter anmelden und mit der Registrierung von Diensten beginnen, die ${brand}-Nutzer ihren Unterhaltungen hinzufügen können.

Falls die Anfrage zweifelhaft scheint, wenden Sie sich bitte an den Anbieter zur Klärung, bevor Sie fortfahren.

 
Genehmigen
 

Falls Sie nicht auf den Button klicken können, kopieren Sie diesen Link und fügen Sie ihn in Ihren Browser ein:

${url}

Bitte antworten Sie nicht auf diese Nachricht.

Datenschutzrichtlinien und Nutzungsbedingungen · Missbrauch melden
${copyright}. ALLE RECHTE VORBEHALTEN.

                                                           
\ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/de/team/email/invitation.html b/services/brig/deb/opt/brig/templates/de/team/email/invitation.html index a5e5763d5ed..7abcafc58aa 100644 --- a/services/brig/deb/opt/brig/templates/de/team/email/invitation.html +++ b/services/brig/deb/opt/brig/templates/de/team/email/invitation.html @@ -1 +1 @@ -Sie wurden eingeladen, einem ${brand}-Team beizutreten

${brand_label_url}

Einladung zum Team

${inviter} hat Sie auf ${brand} zu einem Team eingeladen. Klicken Sie bitte auf den unteren Button, um die Einladung anzunehmen.

 
Team beitreten
 

Falls Sie nicht auf den Button klicken können, kopieren Sie diesen Link und fügen Sie ihn in Ihren Browser ein:

${url}

Wenn Sie Fragen haben, dann kontaktieren Sie uns bitte.

Was ist Wire?
Wire ist die sicherste Plattform für Ihre Kommunikation. Wo auch immer Sie sind, arbeiten Sie mit Ihrem Team und externen Partnern zusammen – mittels Nachrichten, Videokonferenzen und Dateiaustausch, alles mit Ende-zu-Ende-Verschlüsselung. Mehr erfahren.

Datenschutzrichtlinien und Nutzungsbedingungen · Missbrauch melden
${copyright}. ALLE RECHTE VORBEHALTEN.

                                                           
\ No newline at end of file +Sie wurden eingeladen, einem ${brand}-Team beizutreten

${brand_label_url}

Einladung zum Team

${inviter} hat Sie auf ${brand} zu einem Team eingeladen. Klicken Sie bitte auf den unteren Button, um die Einladung anzunehmen.

 
Team beitreten
 

Falls Sie nicht auf den Button klicken können, kopieren Sie diesen Link und fügen Sie ihn in Ihren Browser ein:

${url}

Wenn Sie Fragen haben, dann kontaktieren Sie uns bitte.

Was ist Wire?
Wire ist die sicherste Plattform für Ihre Kommunikation. Wo auch immer Sie sind, arbeiten Sie mit Ihrem Team und externen Partnern zusammen – mittels Nachrichten, Videokonferenzen und Dateiaustausch, alles mit Ende-zu-Ende-Verschlüsselung. Mehr erfahren.

Datenschutzrichtlinien und Nutzungsbedingungen · Missbrauch melden
${copyright}. ALLE RECHTE VORBEHALTEN.

                                                           
\ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/de/team/email/new-member-welcome.html b/services/brig/deb/opt/brig/templates/de/team/email/new-member-welcome.html index 420ebc845ab..03c007c723f 100644 --- a/services/brig/deb/opt/brig/templates/de/team/email/new-member-welcome.html +++ b/services/brig/deb/opt/brig/templates/de/team/email/new-member-welcome.html @@ -1 +1 @@ -Sie sind einem Team auf ${brand} beigetreten

${brand_label_url}

Willkommen bei ${team_name}.

Sie sind soeben mit ${email} einem Team namens ${team_name} auf ${brand} beigetreten.

 

${brand} vereint sichere Verschlüsselung mit reichhaltigem Funktionsumfang und einfacher Bedienung in einer einzigen App. Unterstützt alle gängigen Plattformen.

 
${brand} herunterladen
 

Falls Sie nicht auf den Button klicken können, kopieren Sie diesen Link und fügen Sie ihn in Ihren Browser ein:

${url}

Wenn Sie Fragen haben, dann kontaktieren Sie uns bitte.

Team ID: ${team_id}

Datenschutzrichtlinien und Nutzungsbedingungen · Missbrauch melden
${copyright}. ALLE RECHTE VORBEHALTEN.

                                                           
\ No newline at end of file +Sie sind einem Team auf ${brand} beigetreten

${brand_label_url}

Willkommen bei ${team_name}.

Sie sind soeben mit ${email} einem Team namens ${team_name} auf ${brand} beigetreten.

 

${brand} vereint sichere Verschlüsselung mit reichhaltigem Funktionsumfang und einfacher Bedienung in einer einzigen App. Unterstützt alle gängigen Plattformen.

 
${brand} herunterladen
 

Falls Sie nicht auf den Button klicken können, kopieren Sie diesen Link und fügen Sie ihn in Ihren Browser ein:

${url}

Wenn Sie Fragen haben, dann kontaktieren Sie uns bitte.

Team ID: ${team_id}

Datenschutzrichtlinien und Nutzungsbedingungen · Missbrauch melden
${copyright}. ALLE RECHTE VORBEHALTEN.

                                                           
\ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/de/user/email/activation.html b/services/brig/deb/opt/brig/templates/de/user/email/activation.html index be729533ed6..ec58a8e1a32 100644 --- a/services/brig/deb/opt/brig/templates/de/user/email/activation.html +++ b/services/brig/deb/opt/brig/templates/de/user/email/activation.html @@ -1 +1 @@ -Ihr ${brand}-Benutzerkonto

${brand_label_url}

Bestätigen Sie Ihre E-Mail-Adresse

${email} wurde verwendet, um ein Benutzerkonto auf ${brand} zu erstellen.
Klicken Sie auf den folgenden Button, um Ihre E-Mail-Adresse zu bestätigen.

 
Bestätigen
 

Falls Sie nicht auf den Button klicken können, kopieren Sie diesen Link und fügen Sie ihn in Ihren Browser ein:

${url}

Wenn Sie Fragen haben, dann kontaktieren Sie uns bitte.

Datenschutzrichtlinien und Nutzungsbedingungen · Missbrauch melden
${copyright}. ALLE RECHTE VORBEHALTEN.

                                                           
\ No newline at end of file +Ihr ${brand}-Benutzerkonto

${brand_label_url}

Bestätigen Sie Ihre E-Mail-Adresse

${email} wurde verwendet, um ein Benutzerkonto auf ${brand} zu erstellen.
Klicken Sie auf den folgenden Button, um Ihre E-Mail-Adresse zu bestätigen.

 
Bestätigen
 

Falls Sie nicht auf den Button klicken können, kopieren Sie diesen Link und fügen Sie ihn in Ihren Browser ein:

${url}

Wenn Sie Fragen haben, dann kontaktieren Sie uns bitte.

Datenschutzrichtlinien und Nutzungsbedingungen · Missbrauch melden
${copyright}. ALLE RECHTE VORBEHALTEN.

                                                           
\ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/de/user/email/deletion.html b/services/brig/deb/opt/brig/templates/de/user/email/deletion.html index 7febba8ad1c..7c6ba323943 100644 --- a/services/brig/deb/opt/brig/templates/de/user/email/deletion.html +++ b/services/brig/deb/opt/brig/templates/de/user/email/deletion.html @@ -1 +1 @@ -Benutzerkonto löschen?

${brand_label_url}

Ihr Benutzerkonto löschen

Wir haben eine Anfrage zur Löschung Ihrer ${brand}-Benutzerkontos erhalten. Klicken Sie innerhalb der nächsten 10 Minuten auf den folgenden Link, um alle Ihre Unterhaltungen, Nachrichten und Kontakte zu löschen.

 
Benutzerkonto löschen
 

Falls Sie nicht auf den Button klicken können, kopieren Sie diesen Link und fügen Sie ihn in Ihren Browser ein:

${url}

Falls Sie dies nicht angefordert haben, setzen Sie Ihr Passwort zurück.

Wenn Sie Fragen haben, dann kontaktieren Sie uns bitte.

Datenschutzrichtlinien und Nutzungsbedingungen · Missbrauch melden
${copyright}. ALLE RECHTE VORBEHALTEN.

                                                           
\ No newline at end of file +Benutzerkonto löschen?

${brand_label_url}

Ihr Benutzerkonto löschen

Wir haben eine Anfrage zur Löschung Ihrer ${brand}-Benutzerkontos erhalten. Klicken Sie innerhalb der nächsten 10 Minuten auf den folgenden Link, um alle Ihre Unterhaltungen, Nachrichten und Kontakte zu löschen.

 
Benutzerkonto löschen
 

Falls Sie nicht auf den Button klicken können, kopieren Sie diesen Link und fügen Sie ihn in Ihren Browser ein:

${url}

Falls Sie dies nicht angefordert haben, setzen Sie Ihr Passwort zurück.

Wenn Sie Fragen haben, dann kontaktieren Sie uns bitte.

Datenschutzrichtlinien und Nutzungsbedingungen · Missbrauch melden
${copyright}. ALLE RECHTE VORBEHALTEN.

                                                           
\ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/de/user/email/new-client.html b/services/brig/deb/opt/brig/templates/de/user/email/new-client.html index a499050c1d5..5db2fe516cb 100644 --- a/services/brig/deb/opt/brig/templates/de/user/email/new-client.html +++ b/services/brig/deb/opt/brig/templates/de/user/email/new-client.html @@ -1 +1 @@ -Neues Gerät

${brand_label_url}

Neues Gerät

Ein neues Gerät wurde zu Ihrem ${brand}-Benutzerkonto hinzugefügt:

${date}

${model}

Sie haben ${brand} vermutlich auf einem neuen Gerät installiert oder sich auf einem bestehenden Gerät erneut eingeloggt. Falls dies nicht der Fall ist, gehen Sie in Ihre ${brand} Einstellungen, entfernen Sie das Gerät und setzen Sie Ihr Passwort zurück.

Wenn Sie Fragen haben, dann kontaktieren Sie uns bitte.

Datenschutzrichtlinien und Nutzungsbedingungen · Missbrauch melden
${copyright}. ALLE RECHTE VORBEHALTEN.

                                                           
\ No newline at end of file +Neues Gerät

${brand_label_url}

Neues Gerät

Ein neues Gerät wurde zu Ihrem ${brand}-Benutzerkonto hinzugefügt:

${date}

${model}

Sie haben ${brand} vermutlich auf einem neuen Gerät installiert oder sich auf einem bestehenden Gerät erneut eingeloggt. Falls dies nicht der Fall ist, gehen Sie in Ihre ${brand} Einstellungen, entfernen Sie das Gerät und setzen Sie Ihr Passwort zurück.

Wenn Sie Fragen haben, dann kontaktieren Sie uns bitte.

Datenschutzrichtlinien und Nutzungsbedingungen · Missbrauch melden
${copyright}. ALLE RECHTE VORBEHALTEN.

                                                           
\ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/de/user/email/password-reset.html b/services/brig/deb/opt/brig/templates/de/user/email/password-reset.html index 3f52cef6d49..de528deb585 100644 --- a/services/brig/deb/opt/brig/templates/de/user/email/password-reset.html +++ b/services/brig/deb/opt/brig/templates/de/user/email/password-reset.html @@ -1 +1 @@ -Änderung des Passworts auf ${brand}

${brand_label_url}

Passwort zurücksetzen

Wir haben eine Anfrage zum Zurücksetzen des Passworts für Ihr ${brand}-Benutzerkonto erhalten. Klicken Sie auf den folgenden Button, um ein neues Passwort zu erstellen.

 
Passwort zurücksetzen
 

Falls Sie nicht auf den Button klicken können, kopieren Sie diesen Link und fügen Sie ihn in Ihren Browser ein:

${url}

Wenn Sie Fragen haben, dann kontaktieren Sie uns bitte.

Datenschutzrichtlinien und Nutzungsbedingungen · Missbrauch melden
${copyright}. ALLE RECHTE VORBEHALTEN.

                                                           
\ No newline at end of file +Änderung des Passworts auf ${brand}

${brand_label_url}

Passwort zurücksetzen

Wir haben eine Anfrage zum Zurücksetzen des Passworts für Ihr ${brand}-Benutzerkonto erhalten. Klicken Sie auf den folgenden Button, um ein neues Passwort zu erstellen.

 
Passwort zurücksetzen
 

Falls Sie nicht auf den Button klicken können, kopieren Sie diesen Link und fügen Sie ihn in Ihren Browser ein:

${url}

Wenn Sie Fragen haben, dann kontaktieren Sie uns bitte.

Datenschutzrichtlinien und Nutzungsbedingungen · Missbrauch melden
${copyright}. ALLE RECHTE VORBEHALTEN.

                                                           
\ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/de/user/email/team-activation.html b/services/brig/deb/opt/brig/templates/de/user/email/team-activation.html index 157a676fe8a..6818d31b724 100644 --- a/services/brig/deb/opt/brig/templates/de/user/email/team-activation.html +++ b/services/brig/deb/opt/brig/templates/de/user/email/team-activation.html @@ -1 +1 @@ -${brand} Benutzerkonto

${brand_label_url}

Ihr neues ${brand}-Benutzerkonto

Ein neues ${brand} Team wurde mit ${email} erstellt. Bitte bestätigen Sie Ihre E-Mail-Adresse.

 
Bestätigen
 

Falls Sie nicht auf den Button klicken können, kopieren Sie diesen Link und fügen Sie ihn in Ihren Browser ein:

${url}

Wenn Sie Fragen haben, dann kontaktieren Sie uns bitte.

Datenschutzrichtlinien und Nutzungsbedingungen · Missbrauch melden
${copyright}. ALLE RECHTE VORBEHALTEN.

                                                           
\ No newline at end of file +${brand} Benutzerkonto

${brand_label_url}

Ihr neues ${brand}-Benutzerkonto

Ein neues ${brand} Team wurde mit ${email} erstellt. Bitte bestätigen Sie Ihre E-Mail-Adresse.

 
Bestätigen
 

Falls Sie nicht auf den Button klicken können, kopieren Sie diesen Link und fügen Sie ihn in Ihren Browser ein:

${url}

Wenn Sie Fragen haben, dann kontaktieren Sie uns bitte.

Datenschutzrichtlinien und Nutzungsbedingungen · Missbrauch melden
${copyright}. ALLE RECHTE VORBEHALTEN.

                                                           
\ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/de/user/email/update.html b/services/brig/deb/opt/brig/templates/de/user/email/update.html index bbf507c7b65..61148ef262b 100644 --- a/services/brig/deb/opt/brig/templates/de/user/email/update.html +++ b/services/brig/deb/opt/brig/templates/de/user/email/update.html @@ -1 +1 @@ -Ihre neue E-Mail-Adresse auf ${brand}

${brand_label_url}

Bestätigen Sie Ihre E-Mail-Adresse

${email} wurde als Ihre neue E-Mail-Adresse auf ${brand} registriert. Klicken Sie auf den folgenden Button, um Ihre neue Adresse zu bestätigen.

 
Bestätigen
 

Falls Sie nicht auf den Button klicken können, kopieren Sie diesen Link und fügen Sie ihn in Ihren Browser ein:

${url}

Wenn Sie Fragen haben, dann kontaktieren Sie uns bitte.

Datenschutzrichtlinien und Nutzungsbedingungen · Missbrauch melden
${copyright}. ALLE RECHTE VORBEHALTEN.

                                                           
\ No newline at end of file +Ihre neue E-Mail-Adresse auf ${brand}

${brand_label_url}

Bestätigen Sie Ihre E-Mail-Adresse

${email} wurde als Ihre neue E-Mail-Adresse auf ${brand} registriert. Klicken Sie auf den folgenden Button, um Ihre neue Adresse zu bestätigen.

 
Bestätigen
 

Falls Sie nicht auf den Button klicken können, kopieren Sie diesen Link und fügen Sie ihn in Ihren Browser ein:

${url}

Wenn Sie Fragen haben, dann kontaktieren Sie uns bitte.

Datenschutzrichtlinien und Nutzungsbedingungen · Missbrauch melden
${copyright}. ALLE RECHTE VORBEHALTEN.

                                                           
\ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/de/user/email/verification-delete-team-subject.txt b/services/brig/deb/opt/brig/templates/de/user/email/verification-delete-team-subject.txt index e69de29bb2d..5a8e6a53fe2 100644 --- a/services/brig/deb/opt/brig/templates/de/user/email/verification-delete-team-subject.txt +++ b/services/brig/deb/opt/brig/templates/de/user/email/verification-delete-team-subject.txt @@ -0,0 +1 @@ +Ihr ${brand}-Bestätigungscode lautet ${code} \ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/de/user/email/verification-delete-team.html b/services/brig/deb/opt/brig/templates/de/user/email/verification-delete-team.html index cf8d6856feb..3b8852f6dad 100644 --- a/services/brig/deb/opt/brig/templates/de/user/email/verification-delete-team.html +++ b/services/brig/deb/opt/brig/templates/de/user/email/verification-delete-team.html @@ -1 +1 @@ -

${brand_label_url}

Bestätigen Sie die Kündigung

${email} wurde verwendet, um Ihr ${brand}-Team zu löschen. Geben Sie diesen Code ein, um Ihre E-Mail-Adresse zu bestätigen und das Team zu löschen.

 

${code}

 

Wenn Sie Fragen haben, dann kontaktieren Sie uns bitte.

Datenschutzrichtlinien und Nutzungsbedingungen · Missbrauch melden
${copyright}. ALLE RECHTE VORBEHALTEN.

                                                           
\ No newline at end of file +Ihr ${brand}-Bestätigungscode lautet ${code}

${brand_label_url}

Bestätigen Sie die Kündigung

${email} wurde verwendet, um Ihr ${brand}-Team zu löschen. Geben Sie diesen Code ein, um Ihre E-Mail-Adresse zu bestätigen und das Team zu löschen.

 

${code}

 

Wenn Sie Fragen haben, dann kontaktieren Sie uns bitte.

Datenschutzrichtlinien und Nutzungsbedingungen · Missbrauch melden
${copyright}. ALLE RECHTE VORBEHALTEN.

                                                           
\ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/de/user/email/verification-login-subject.txt b/services/brig/deb/opt/brig/templates/de/user/email/verification-login-subject.txt index e69de29bb2d..5a8e6a53fe2 100644 --- a/services/brig/deb/opt/brig/templates/de/user/email/verification-login-subject.txt +++ b/services/brig/deb/opt/brig/templates/de/user/email/verification-login-subject.txt @@ -0,0 +1 @@ +Ihr ${brand}-Bestätigungscode lautet ${code} \ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/de/user/email/verification-login.html b/services/brig/deb/opt/brig/templates/de/user/email/verification-login.html index 77c2a061ecd..9237c11e73d 100644 --- a/services/brig/deb/opt/brig/templates/de/user/email/verification-login.html +++ b/services/brig/deb/opt/brig/templates/de/user/email/verification-login.html @@ -1 +1 @@ -

${brand_label_url}

Bestätigen Sie Ihre Anmeldung

${email} wurde verwendet, um sich bei Ihrem ${brand}-Benutzerkonto anzumelden. Geben Sie diesen Code ein, um Ihre E-Mail-Adresse zu bestätigen und sich anzumelden.

 

${code}

 

Wenn Sie Fragen haben, dann kontaktieren Sie uns bitte.

Datenschutzrichtlinien und Nutzungsbedingungen · Missbrauch melden
${copyright}. ALLE RECHTE VORBEHALTEN.

                                                           
\ No newline at end of file +Ihr ${brand}-Bestätigungscode lautet ${code}

${brand_label_url}

Bestätigen Sie Ihre Anmeldung

${email} wurde verwendet, um sich bei Ihrem ${brand}-Benutzerkonto anzumelden. Geben Sie diesen Code ein, um Ihre E-Mail-Adresse zu bestätigen und sich anzumelden.

 

${code}

 

Wenn Sie Fragen haben, dann kontaktieren Sie uns bitte.

Datenschutzrichtlinien und Nutzungsbedingungen · Missbrauch melden
${copyright}. ALLE RECHTE VORBEHALTEN.

                                                           
\ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/de/user/email/verification-scim-token-subject.txt b/services/brig/deb/opt/brig/templates/de/user/email/verification-scim-token-subject.txt index e69de29bb2d..5a8e6a53fe2 100644 --- a/services/brig/deb/opt/brig/templates/de/user/email/verification-scim-token-subject.txt +++ b/services/brig/deb/opt/brig/templates/de/user/email/verification-scim-token-subject.txt @@ -0,0 +1 @@ +Ihr ${brand}-Bestätigungscode lautet ${code} \ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/de/user/email/verification-scim-token.html b/services/brig/deb/opt/brig/templates/de/user/email/verification-scim-token.html index 00ed3439996..5936fd050ec 100644 --- a/services/brig/deb/opt/brig/templates/de/user/email/verification-scim-token.html +++ b/services/brig/deb/opt/brig/templates/de/user/email/verification-scim-token.html @@ -1 +1 @@ -

${brand_label_url}

Bestätigen Sie die Erstellung eines SCIM-Token

${email} wurde verwendet, um ein SCIM-Token zu generieren. Geben Sie diesen Code ein, um Ihre E-Mail-Adresse zu bestätigen und den Token zu erstellen.

 

${code}

 

Wenn Sie Fragen haben, dann kontaktieren Sie uns bitte.

Datenschutzrichtlinien und Nutzungsbedingungen · Missbrauch melden
${copyright}. ALLE RECHTE VORBEHALTEN.

                                                           
\ No newline at end of file +Ihr ${brand}-Bestätigungscode lautet ${code}

${brand_label_url}

Bestätigen Sie die Erstellung eines SCIM-Token

${email} wurde verwendet, um ein SCIM-Token zu generieren. Geben Sie diesen Code ein, um Ihre E-Mail-Adresse zu bestätigen und den Token zu erstellen.

 

${code}

 

Wenn Sie Fragen haben, dann kontaktieren Sie uns bitte.

Datenschutzrichtlinien und Nutzungsbedingungen · Missbrauch melden
${copyright}. ALLE RECHTE VORBEHALTEN.

                                                           
\ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/de/user/email/verification.html b/services/brig/deb/opt/brig/templates/de/user/email/verification.html index 2e80eafea70..5c27fc2d57a 100644 --- a/services/brig/deb/opt/brig/templates/de/user/email/verification.html +++ b/services/brig/deb/opt/brig/templates/de/user/email/verification.html @@ -1 +1 @@ -${code} ist Ihr ${brand}-Bestätigungscode

${brand_label_url}

Bestätigen Sie Ihre E-Mail-Adresse

${email} wurde verwendet, um ein Benutzerkonto auf ${brand} zu erstellen. Geben Sie diesen Code ein, um Ihre E-Mail-Adresse zu bestätigen und Ihr Benutzerkonto zu erstellen.

 

${code}

 

Wenn Sie Fragen haben, dann kontaktieren Sie uns bitte.

Datenschutzrichtlinien und Nutzungsbedingungen · Missbrauch melden
${copyright}. ALLE RECHTE VORBEHALTEN.

                                                           
\ No newline at end of file +${code} ist Ihr ${brand}-Bestätigungscode

${brand_label_url}

Bestätigen Sie Ihre E-Mail-Adresse

${email} wurde verwendet, um ein Benutzerkonto auf ${brand} zu erstellen. Geben Sie diesen Code ein, um Ihre E-Mail-Adresse zu bestätigen und Ihr Benutzerkonto zu erstellen.

 

${code}

 

Wenn Sie Fragen haben, dann kontaktieren Sie uns bitte.

Datenschutzrichtlinien und Nutzungsbedingungen · Missbrauch melden
${copyright}. ALLE RECHTE VORBEHALTEN.

                                                           
\ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/en/provider/email/activation.html b/services/brig/deb/opt/brig/templates/en/provider/email/activation.html index 489b5fd0be0..fce3dd2e80b 100644 --- a/services/brig/deb/opt/brig/templates/en/provider/email/activation.html +++ b/services/brig/deb/opt/brig/templates/en/provider/email/activation.html @@ -1 +1 @@ -Your ${brand_service} Account

${brand_label_url}

Verify your email

Your email address ${email} was used to register as a ${brand_service}.

To complete the registration, it is necessary that you verify your e-mail address by clicking on the button below.

Please note that upon successful verification of your e-mail, your ${brand_service} account is still subject to approval through our staff, which usually happens within 24 hours. You will be informed of the approval via a separate e-mail.

 
Verify
 

If you can’t click the button, copy and paste this link to your browser:

${url}

If you didn’t register for a ${brand} service provider account using this e-mail address, you can safely ignore this message. If you want to report abuse of your e-mail address, please contact us.

Please don’t reply to this message.

Privacy policy and terms of use · Report Misuse
${copyright}. ALL RIGHTS RESERVED.

                                                           
\ No newline at end of file +Your ${brand_service} Account

${brand_label_url}

Verify your email

Your email address ${email} was used to register as a ${brand_service}.

To complete the registration, it is necessary that you verify your e-mail address by clicking on the button below.

Please note that upon successful verification of your e-mail, your ${brand_service} account is still subject to approval through our staff, which usually happens within 24 hours. You will be informed of the approval via a separate e-mail.

 
Verify
 

If you can’t click the button, copy and paste this link to your browser:

${url}

If you didn’t register for a ${brand} service provider account using this e-mail address, you can safely ignore this message. If you want to report abuse of your e-mail address, please contact us.

Please don’t reply to this message.

Privacy policy and terms of use · Report Misuse
${copyright}. ALL RIGHTS RESERVED.

                                                           
\ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/en/provider/email/approval-confirm.html b/services/brig/deb/opt/brig/templates/en/provider/email/approval-confirm.html index 96d8422307d..9ab7127a0a1 100644 --- a/services/brig/deb/opt/brig/templates/en/provider/email/approval-confirm.html +++ b/services/brig/deb/opt/brig/templates/en/provider/email/approval-confirm.html @@ -1 +1 @@ -Your ${brand_service} Account

${brand_label_url}

Hello,

We are happy to inform you that you are now an approved ${brand_service}.

Please don’t reply to this message.

If you didn’t register for a ${brand_service} account using this e-mail address, please contact us.

Privacy policy and terms of use · Report Misuse
${copyright}. ALL RIGHTS RESERVED.

                                                           
\ No newline at end of file +Your ${brand_service} Account

${brand_label_url}

Hello,

We are happy to inform you that you are now an approved ${brand_service}.

Please don’t reply to this message.

If you didn’t register for a ${brand_service} account using this e-mail address, please contact us.

Privacy policy and terms of use · Report Misuse
${copyright}. ALL RIGHTS RESERVED.

                                                           
\ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/en/provider/email/approval-request.html b/services/brig/deb/opt/brig/templates/en/provider/email/approval-request.html index 5fa64b5de5d..d2900b45d9a 100644 --- a/services/brig/deb/opt/brig/templates/en/provider/email/approval-request.html +++ b/services/brig/deb/opt/brig/templates/en/provider/email/approval-request.html @@ -1 +1 @@ -Approval Request: ${brand_service}

${brand_label_url}

Approval request

A new ${brand_service} has registered and is awaiting approval. Please review the information provided below.

Name: ${name}

E-mail: ${email}

Website: ${url}

Description: ${description}

If the request seems genuine, you can approve the provider by clicking on the button below. Once approved, the provider will be able to sign in and start registering services that ${brand} users can add to their conversations.

If the request seems dubious, please contact the provider for clarifications before proceeding.

 
Approve
 

If you can’t click the button, copy and paste this link to your browser:

${url}

Please don’t reply to this message.

Privacy policy and terms of use · Report Misuse
${copyright}. ALL RIGHTS RESERVED.

                                                           
\ No newline at end of file +Approval Request: ${brand_service}

${brand_label_url}

Approval request

A new ${brand_service} has registered and is awaiting approval. Please review the information provided below.

Name: ${name}

E-mail: ${email}

Website: ${url}

Description: ${description}

If the request seems genuine, you can approve the provider by clicking on the button below. Once approved, the provider will be able to sign in and start registering services that ${brand} users can add to their conversations.

If the request seems dubious, please contact the provider for clarifications before proceeding.

 
Approve
 

If you can’t click the button, copy and paste this link to your browser:

${url}

Please don’t reply to this message.

Privacy policy and terms of use · Report Misuse
${copyright}. ALL RIGHTS RESERVED.

                                                           
\ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/en/team/email/invitation.html b/services/brig/deb/opt/brig/templates/en/team/email/invitation.html index 4581a262ee4..1643844f28e 100644 --- a/services/brig/deb/opt/brig/templates/en/team/email/invitation.html +++ b/services/brig/deb/opt/brig/templates/en/team/email/invitation.html @@ -1 +1 @@ -You have been invited to join a team on ${brand}

${brand_label_url}

Team invitation

${inviter} has invited you to join a team on ${brand}. Click the button below to accept the invitation.

 
Join team
 

If you can’t click the button, copy and paste this link to your browser:

${url}

If you have any questions, please contact us.

What is Wire?
Wire is the most secure collaboration platform. Work with your team and external partners wherever you are through messages, video conferencing and file sharing – always secured with end-to-end-encryption. Learn more.

Privacy policy and terms of use · Report Misuse
${copyright}. ALL RIGHTS RESERVED.

                                                           
\ No newline at end of file +You have been invited to join a team on ${brand}

${brand_label_url}

Team invitation

${inviter} has invited you to join a team on ${brand}. Click the button below to accept the invitation.

 
Join team
 

If you can’t click the button, copy and paste this link to your browser:

${url}

If you have any questions, please contact us.

What is Wire?
Wire is the most secure collaboration platform. Work with your team and external partners wherever you are through messages, video conferencing and file sharing – always secured with end-to-end-encryption. Learn more.

Privacy policy and terms of use · Report Misuse
${copyright}. ALL RIGHTS RESERVED.

                                                           
\ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/en/team/email/new-member-welcome.html b/services/brig/deb/opt/brig/templates/en/team/email/new-member-welcome.html index df0a884e71e..a63b3a1d9c6 100644 --- a/services/brig/deb/opt/brig/templates/en/team/email/new-member-welcome.html +++ b/services/brig/deb/opt/brig/templates/en/team/email/new-member-welcome.html @@ -1 +1 @@ -You joined a team on ${brand}

${brand_label_url}

Welcome to ${team_name}.

You have just joined a team called ${team_name} on ${brand} with ${email}.

 

${brand} combines strong encryption, a rich feature set and ease-of-use in one app like never before. Works on all popular platforms.

 
Download ${brand}
 

If you can’t click the button, copy and paste this link to your browser:

${url}

If you have any questions, please contact us.

Team ID: ${team_id}

Privacy policy and terms of use · Report Misuse
${copyright}. ALL RIGHTS RESERVED.

                                                           
\ No newline at end of file +You joined a team on ${brand}

${brand_label_url}

Welcome to ${team_name}.

You have just joined a team called ${team_name} on ${brand} with ${email}.

 

${brand} combines strong encryption, a rich feature set and ease-of-use in one app like never before. Works on all popular platforms.

 
Download ${brand}
 

If you can’t click the button, copy and paste this link to your browser:

${url}

If you have any questions, please contact us.

Team ID: ${team_id}

Privacy policy and terms of use · Report Misuse
${copyright}. ALL RIGHTS RESERVED.

                                                           
\ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/en/user/email/activation.html b/services/brig/deb/opt/brig/templates/en/user/email/activation.html index 46848555fe1..c67376c606b 100644 --- a/services/brig/deb/opt/brig/templates/en/user/email/activation.html +++ b/services/brig/deb/opt/brig/templates/en/user/email/activation.html @@ -1 +1 @@ -Your ${brand} Account

${brand_label_url}

Verify your email

${email} was used to register on ${brand}.
Click the button to verify your address.

 
Verify
 

If you can’t click the button, copy and paste this link to your browser:

${url}

If you have any questions, please contact us.

Privacy policy and terms of use · Report Misuse
${copyright}. ALL RIGHTS RESERVED.

                                                           
\ No newline at end of file +Your ${brand} Account

${brand_label_url}

Verify your email

${email} was used to register on ${brand}.
Click the button to verify your address.

 
Verify
 

If you can’t click the button, copy and paste this link to your browser:

${url}

If you have any questions, please contact us.

Privacy policy and terms of use · Report Misuse
${copyright}. ALL RIGHTS RESERVED.

                                                           
\ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/en/user/email/deletion.html b/services/brig/deb/opt/brig/templates/en/user/email/deletion.html index 3746238c1cb..690b0104fdd 100644 --- a/services/brig/deb/opt/brig/templates/en/user/email/deletion.html +++ b/services/brig/deb/opt/brig/templates/en/user/email/deletion.html @@ -1 +1 @@ -Delete account?

${brand_label_url}

Delete your account

We’ve received a request to delete your ${brand} account. Click the button below within 10 minutes to delete all your conversations, content and connections.

 
Delete account
 

If you can’t click the button, copy and paste this link to your browser:

${url}

If you didn’t request this, reset your password.

If you have any questions, please contact us.

Privacy policy and terms of use · Report Misuse
${copyright}. ALL RIGHTS RESERVED.

                                                           
\ No newline at end of file +Delete account?

${brand_label_url}

Delete your account

We’ve received a request to delete your ${brand} account. Click the button below within 10 minutes to delete all your conversations, content and connections.

 
Delete account
 

If you can’t click the button, copy and paste this link to your browser:

${url}

If you didn’t request this, reset your password.

If you have any questions, please contact us.

Privacy policy and terms of use · Report Misuse
${copyright}. ALL RIGHTS RESERVED.

                                                           
\ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/en/user/email/new-client.html b/services/brig/deb/opt/brig/templates/en/user/email/new-client.html index b923eeb4ca5..81371023e58 100644 --- a/services/brig/deb/opt/brig/templates/en/user/email/new-client.html +++ b/services/brig/deb/opt/brig/templates/en/user/email/new-client.html @@ -1 +1 @@ -New device

${brand_label_url}

New device

Your ${brand} account was used on:

${date}

${model}

You may have installed ${brand} on a new device or installed it again on an existing one. If that was not the case, go to ${brand} Settings, remove the device and reset your password.

If you have any questions, please contact us.

Privacy policy and terms of use · Report Misuse
${copyright}. ALL RIGHTS RESERVED.

                                                           
\ No newline at end of file +New device

${brand_label_url}

New device

Your ${brand} account was used on:

${date}

${model}

You may have installed ${brand} on a new device or installed it again on an existing one. If that was not the case, go to ${brand} Settings, remove the device and reset your password.

If you have any questions, please contact us.

Privacy policy and terms of use · Report Misuse
${copyright}. ALL RIGHTS RESERVED.

                                                           
\ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/en/user/email/password-reset.html b/services/brig/deb/opt/brig/templates/en/user/email/password-reset.html index 18071d996fe..53ffea05fde 100644 --- a/services/brig/deb/opt/brig/templates/en/user/email/password-reset.html +++ b/services/brig/deb/opt/brig/templates/en/user/email/password-reset.html @@ -1 +1 @@ -Password Change at ${brand}

${brand_label_url}

Reset your password

We’ve received a request to reset the password for your ${brand} account. To create a new password, click the button below.

 
Reset password
 

If you can’t click the button, copy and paste this link to your browser:

${url}

If you have any questions, please contact us.

Privacy policy and terms of use · Report Misuse
${copyright}. ALL RIGHTS RESERVED.

                                                           
\ No newline at end of file +Password Change at ${brand}

${brand_label_url}

Reset your password

We’ve received a request to reset the password for your ${brand} account. To create a new password, click the button below.

 
Reset password
 

If you can’t click the button, copy and paste this link to your browser:

${url}

If you have any questions, please contact us.

Privacy policy and terms of use · Report Misuse
${copyright}. ALL RIGHTS RESERVED.

                                                           
\ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/en/user/email/team-activation.html b/services/brig/deb/opt/brig/templates/en/user/email/team-activation.html index de3833956be..e34ca5f3894 100644 --- a/services/brig/deb/opt/brig/templates/en/user/email/team-activation.html +++ b/services/brig/deb/opt/brig/templates/en/user/email/team-activation.html @@ -1 +1 @@ -${brand} Account

${brand_label_url}

Your new account on ${brand}

A new ${brand} team was created with ${email}. Please verify your email.

 
Verify
 

If you can’t click the button, copy and paste this link to your browser:

${url}

If you have any questions, please contact us.

Privacy policy and terms of use · Report Misuse
${copyright}. ALL RIGHTS RESERVED.

                                                           
\ No newline at end of file +${brand} Account

${brand_label_url}

Your new account on ${brand}

A new ${brand} team was created with ${email}. Please verify your email.

 
Verify
 

If you can’t click the button, copy and paste this link to your browser:

${url}

If you have any questions, please contact us.

Privacy policy and terms of use · Report Misuse
${copyright}. ALL RIGHTS RESERVED.

                                                           
\ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/en/user/email/update.html b/services/brig/deb/opt/brig/templates/en/user/email/update.html index be3a81b8644..339aad5dea7 100644 --- a/services/brig/deb/opt/brig/templates/en/user/email/update.html +++ b/services/brig/deb/opt/brig/templates/en/user/email/update.html @@ -1 +1 @@ -Your new email address on ${brand}

${brand_label_url}

Verify your email

${email} was registered as your new email address on ${brand}. Click the button below to verify your address.

 
Verify
 

If you can’t click the button, copy and paste this link to your browser:

${url}

If you have any questions, please contact us.

Privacy policy and terms of use · Report Misuse
${copyright}. ALL RIGHTS RESERVED.

                                                           
\ No newline at end of file +Your new email address on ${brand}

${brand_label_url}

Verify your email

${email} was registered as your new email address on ${brand}. Click the button below to verify your address.

 
Verify
 

If you can’t click the button, copy and paste this link to your browser:

${url}

If you have any questions, please contact us.

Privacy policy and terms of use · Report Misuse
${copyright}. ALL RIGHTS RESERVED.

                                                           
\ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/en/user/email/verification-delete-team.html b/services/brig/deb/opt/brig/templates/en/user/email/verification-delete-team.html index a957cc75b85..7f0bd94bc56 100644 --- a/services/brig/deb/opt/brig/templates/en/user/email/verification-delete-team.html +++ b/services/brig/deb/opt/brig/templates/en/user/email/verification-delete-team.html @@ -1 +1 @@ -your ${brand} verification code is ${code}

${brand_label_url}

Verify team deletion

${email} was used to delete your ${brand} team. Enter this code to verify your email and delete the team.

 

${code}

 

If you have any questions, please contact us.

Privacy policy and terms of use · Report Misuse
${copyright}. ALL RIGHTS RESERVED.

                                                           
\ No newline at end of file +your ${brand} verification code is ${code}

${brand_label_url}

Verify team deletion

${email} was used to delete your ${brand} team. Enter this code to verify your email and delete the team.

 

${code}

 

If you have any questions, please contact us.

Privacy policy and terms of use · Report Misuse
${copyright}. ALL RIGHTS RESERVED.

                                                           
\ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/en/user/email/verification-login.html b/services/brig/deb/opt/brig/templates/en/user/email/verification-login.html index 78c0bf1a2ee..96783ebe654 100644 --- a/services/brig/deb/opt/brig/templates/en/user/email/verification-login.html +++ b/services/brig/deb/opt/brig/templates/en/user/email/verification-login.html @@ -1 +1 @@ -your ${brand} verification code is ${code}

${brand_label_url}

Verify login

${email} was used to log in to your ${brand} account. Enter this code to verify your email and log in.

 

${code}

 

If you have any questions, please contact us.

Privacy policy and terms of use · Report Misuse
${copyright}. ALL RIGHTS RESERVED.

                                                           
\ No newline at end of file +your ${brand} verification code is ${code}

${brand_label_url}

Verify login

${email} was used to log in to your ${brand} account. Enter this code to verify your email and log in.

 

${code}

 

If you have any questions, please contact us.

Privacy policy and terms of use · Report Misuse
${copyright}. ALL RIGHTS RESERVED.

                                                           
\ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/en/user/email/verification-scim-token.html b/services/brig/deb/opt/brig/templates/en/user/email/verification-scim-token.html index abf8c05d4d1..35c8525e298 100644 --- a/services/brig/deb/opt/brig/templates/en/user/email/verification-scim-token.html +++ b/services/brig/deb/opt/brig/templates/en/user/email/verification-scim-token.html @@ -1 +1 @@ -your ${brand} verification code is ${code}

${brand_label_url}

Verify SCIM token creation

${email} was used to generate a SCIM token. Enter this code to verify your email and create the token.

 

${code}

 

If you have any questions, please contact us.

Privacy policy and terms of use · Report Misuse
${copyright}. ALL RIGHTS RESERVED.

                                                           
\ No newline at end of file +your ${brand} verification code is ${code}

${brand_label_url}

Verify SCIM token creation

${email} was used to generate a SCIM token. Enter this code to verify your email and create the token.

 

${code}

 

If you have any questions, please contact us.

Privacy policy and terms of use · Report Misuse
${copyright}. ALL RIGHTS RESERVED.

                                                           
\ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/en/user/email/verification.html b/services/brig/deb/opt/brig/templates/en/user/email/verification.html index d59229ac555..ad903d3607c 100644 --- a/services/brig/deb/opt/brig/templates/en/user/email/verification.html +++ b/services/brig/deb/opt/brig/templates/en/user/email/verification.html @@ -1 +1 @@ -${code} is your ${brand} verification code

${brand_label_url}

Verify your email

${email} was used to register on ${brand}. Enter this code to verify your email and create your account.

 

${code}

 

If you have any questions, please contact us.

Privacy policy and terms of use · Report Misuse
${copyright}. ALL RIGHTS RESERVED.

                                                           
\ No newline at end of file +${code} is your ${brand} verification code

${brand_label_url}

Verify your email

${email} was used to register on ${brand}. Enter this code to verify your email and create your account.

 

${code}

 

If you have any questions, please contact us.

Privacy policy and terms of use · Report Misuse
${copyright}. ALL RIGHTS RESERVED.

                                                           
\ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/et/user/email/activation.html b/services/brig/deb/opt/brig/templates/et/user/email/activation.html index 537e333f6a9..bd77e33958a 100644 --- a/services/brig/deb/opt/brig/templates/et/user/email/activation.html +++ b/services/brig/deb/opt/brig/templates/et/user/email/activation.html @@ -1 +1 @@ -Your ${brand} Account

${brand_label_url}

Kinnita oma e-posti aadress

${email} was used to register on ${brand}.
Click the button to verify your address.

 
Kinnita
 

Kui sul pole võimalik nuppu klikkida, siis kopeeri allolev aadress veebibrauserisse:

${url}

If you have any questions, please contact us.

Privacy policy and terms of use · Report Misuse
${copyright}. ALL RIGHTS RESERVED.

                                                           
\ No newline at end of file +Your ${brand} Account

${brand_label_url}

Kinnita oma e-posti aadress

${email} was used to register on ${brand}.
Click the button to verify your address.

 
Kinnita
 

Kui sul pole võimalik nuppu klikkida, siis kopeeri allolev aadress veebibrauserisse:

${url}

If you have any questions, please contact us.

Privacy policy and terms of use · Report Misuse
${copyright}. ALL RIGHTS RESERVED.

                                                           
\ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/et/user/email/deletion.html b/services/brig/deb/opt/brig/templates/et/user/email/deletion.html index 7a2265f982b..36eb10cdf00 100644 --- a/services/brig/deb/opt/brig/templates/et/user/email/deletion.html +++ b/services/brig/deb/opt/brig/templates/et/user/email/deletion.html @@ -1 +1 @@ -Kustuta konto?

${brand_label_url}

Kustuta konto

We’ve received a request to delete your ${brand} account. Kogu kontoga seotud info kustutamise kinnitamiseks kliki kümne minuti jooksul alloleval lingil.

 
Kustuta konto
 

Kui sul pole võimalik nuppu klikkida, siis kopeeri allolev aadress veebibrauserisse:

${url}

If you didn’t request this, reset your password.

If you have any questions, please contact us.

Privacy policy and terms of use · Report Misuse
${copyright}. ALL RIGHTS RESERVED.

                                                           
\ No newline at end of file +Kustuta konto?

${brand_label_url}

Kustuta konto

We’ve received a request to delete your ${brand} account. Kogu kontoga seotud info kustutamise kinnitamiseks kliki kümne minuti jooksul alloleval lingil.

 
Kustuta konto
 

Kui sul pole võimalik nuppu klikkida, siis kopeeri allolev aadress veebibrauserisse:

${url}

If you didn’t request this, reset your password.

If you have any questions, please contact us.

Privacy policy and terms of use · Report Misuse
${copyright}. ALL RIGHTS RESERVED.

                                                           
\ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/et/user/email/new-client.html b/services/brig/deb/opt/brig/templates/et/user/email/new-client.html index 71fcf3a4397..622ea916c83 100644 --- a/services/brig/deb/opt/brig/templates/et/user/email/new-client.html +++ b/services/brig/deb/opt/brig/templates/et/user/email/new-client.html @@ -1 +1 @@ -Sisselogimine uuelt seadmelt

${brand_label_url}

Wire uuel seadmel

Your ${brand} account was used on:

${date}

${model}

You may have installed ${brand} on a new device or installed it again on an existing one. If that was not the case, go to ${brand} Settings, remove the device and reset your password.

If you have any questions, please contact us.

Privacy policy and terms of use · Report Misuse
${copyright}. ALL RIGHTS RESERVED.

                                                           
\ No newline at end of file +Sisselogimine uuelt seadmelt

${brand_label_url}

Wire uuel seadmel

Your ${brand} account was used on:

${date}

${model}

You may have installed ${brand} on a new device or installed it again on an existing one. If that was not the case, go to ${brand} Settings, remove the device and reset your password.

If you have any questions, please contact us.

Privacy policy and terms of use · Report Misuse
${copyright}. ALL RIGHTS RESERVED.

                                                           
\ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/et/user/email/password-reset.html b/services/brig/deb/opt/brig/templates/et/user/email/password-reset.html index 6ec235c3b89..2055ca88695 100644 --- a/services/brig/deb/opt/brig/templates/et/user/email/password-reset.html +++ b/services/brig/deb/opt/brig/templates/et/user/email/password-reset.html @@ -1 +1 @@ -Password Change at ${brand}

${brand_label_url}

Lähtesta oma parool

We’ve received a request to reset the password for your ${brand} account. Uue salasõna loomiseks vajutage järgmisele lingile:

 
Lähesta parool
 

Kui sul pole võimalik nuppu klikkida, siis kopeeri allolev aadress veebibrauserisse:

${url}

If you have any questions, please contact us.

Privacy policy and terms of use · Report Misuse
${copyright}. ALL RIGHTS RESERVED.

                                                           
\ No newline at end of file +Password Change at ${brand}

${brand_label_url}

Lähtesta oma parool

We’ve received a request to reset the password for your ${brand} account. Uue salasõna loomiseks vajutage järgmisele lingile:

 
Lähesta parool
 

Kui sul pole võimalik nuppu klikkida, siis kopeeri allolev aadress veebibrauserisse:

${url}

If you have any questions, please contact us.

Privacy policy and terms of use · Report Misuse
${copyright}. ALL RIGHTS RESERVED.

                                                           
\ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/et/user/email/team-activation.html b/services/brig/deb/opt/brig/templates/et/user/email/team-activation.html index 980a3abf701..d042ee19056 100644 --- a/services/brig/deb/opt/brig/templates/et/user/email/team-activation.html +++ b/services/brig/deb/opt/brig/templates/et/user/email/team-activation.html @@ -1 +1 @@ -${brand} Account

${brand_label_url}

Your new account on ${brand}

A new ${brand} team was created with ${email}. Palun kinnita oma meiliaadress.

 
Kinnita
 

Kui sul pole võimalik nuppu klikkida, siis kopeeri allolev aadress veebibrauserisse:

${url}

If you have any questions, please contact us.

Privacy policy and terms of use · Report Misuse
${copyright}. ALL RIGHTS RESERVED.

                                                           
\ No newline at end of file +${brand} Account

${brand_label_url}

Your new account on ${brand}

A new ${brand} team was created with ${email}. Palun kinnita oma meiliaadress.

 
Kinnita
 

Kui sul pole võimalik nuppu klikkida, siis kopeeri allolev aadress veebibrauserisse:

${url}

If you have any questions, please contact us.

Privacy policy and terms of use · Report Misuse
${copyright}. ALL RIGHTS RESERVED.

                                                           
\ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/et/user/email/update.html b/services/brig/deb/opt/brig/templates/et/user/email/update.html index 1d2a00961bb..92c86559af6 100644 --- a/services/brig/deb/opt/brig/templates/et/user/email/update.html +++ b/services/brig/deb/opt/brig/templates/et/user/email/update.html @@ -1 +1 @@ -Your new email address on ${brand}

${brand_label_url}

Kinnita oma e-posti aadress

${email} was registered as your new email address on ${brand}. Aadressi kinnitamiseks kliki alloleval lingil.

 
Kinnita
 

Kui sul pole võimalik nuppu klikkida, siis kopeeri allolev aadress veebibrauserisse:

${url}

If you have any questions, please contact us.

Privacy policy and terms of use · Report Misuse
${copyright}. ALL RIGHTS RESERVED.

                                                           
\ No newline at end of file +Your new email address on ${brand}

${brand_label_url}

Kinnita oma e-posti aadress

${email} was registered as your new email address on ${brand}. Aadressi kinnitamiseks kliki alloleval lingil.

 
Kinnita
 

Kui sul pole võimalik nuppu klikkida, siis kopeeri allolev aadress veebibrauserisse:

${url}

If you have any questions, please contact us.

Privacy policy and terms of use · Report Misuse
${copyright}. ALL RIGHTS RESERVED.

                                                           
\ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/et/user/email/verification-delete-team.html b/services/brig/deb/opt/brig/templates/et/user/email/verification-delete-team.html index a957cc75b85..7f0bd94bc56 100644 --- a/services/brig/deb/opt/brig/templates/et/user/email/verification-delete-team.html +++ b/services/brig/deb/opt/brig/templates/et/user/email/verification-delete-team.html @@ -1 +1 @@ -your ${brand} verification code is ${code}

${brand_label_url}

Verify team deletion

${email} was used to delete your ${brand} team. Enter this code to verify your email and delete the team.

 

${code}

 

If you have any questions, please contact us.

Privacy policy and terms of use · Report Misuse
${copyright}. ALL RIGHTS RESERVED.

                                                           
\ No newline at end of file +your ${brand} verification code is ${code}

${brand_label_url}

Verify team deletion

${email} was used to delete your ${brand} team. Enter this code to verify your email and delete the team.

 

${code}

 

If you have any questions, please contact us.

Privacy policy and terms of use · Report Misuse
${copyright}. ALL RIGHTS RESERVED.

                                                           
\ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/et/user/email/verification-login.html b/services/brig/deb/opt/brig/templates/et/user/email/verification-login.html index 78c0bf1a2ee..96783ebe654 100644 --- a/services/brig/deb/opt/brig/templates/et/user/email/verification-login.html +++ b/services/brig/deb/opt/brig/templates/et/user/email/verification-login.html @@ -1 +1 @@ -your ${brand} verification code is ${code}

${brand_label_url}

Verify login

${email} was used to log in to your ${brand} account. Enter this code to verify your email and log in.

 

${code}

 

If you have any questions, please contact us.

Privacy policy and terms of use · Report Misuse
${copyright}. ALL RIGHTS RESERVED.

                                                           
\ No newline at end of file +your ${brand} verification code is ${code}

${brand_label_url}

Verify login

${email} was used to log in to your ${brand} account. Enter this code to verify your email and log in.

 

${code}

 

If you have any questions, please contact us.

Privacy policy and terms of use · Report Misuse
${copyright}. ALL RIGHTS RESERVED.

                                                           
\ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/et/user/email/verification-scim-token.html b/services/brig/deb/opt/brig/templates/et/user/email/verification-scim-token.html index abf8c05d4d1..35c8525e298 100644 --- a/services/brig/deb/opt/brig/templates/et/user/email/verification-scim-token.html +++ b/services/brig/deb/opt/brig/templates/et/user/email/verification-scim-token.html @@ -1 +1 @@ -your ${brand} verification code is ${code}

${brand_label_url}

Verify SCIM token creation

${email} was used to generate a SCIM token. Enter this code to verify your email and create the token.

 

${code}

 

If you have any questions, please contact us.

Privacy policy and terms of use · Report Misuse
${copyright}. ALL RIGHTS RESERVED.

                                                           
\ No newline at end of file +your ${brand} verification code is ${code}

${brand_label_url}

Verify SCIM token creation

${email} was used to generate a SCIM token. Enter this code to verify your email and create the token.

 

${code}

 

If you have any questions, please contact us.

Privacy policy and terms of use · Report Misuse
${copyright}. ALL RIGHTS RESERVED.

                                                           
\ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/et/user/email/verification.html b/services/brig/deb/opt/brig/templates/et/user/email/verification.html index a198747ba3e..e15dfcd7a48 100644 --- a/services/brig/deb/opt/brig/templates/et/user/email/verification.html +++ b/services/brig/deb/opt/brig/templates/et/user/email/verification.html @@ -1 +1 @@ -${code} is your ${brand} verification code

${brand_label_url}

Kinnita oma e-posti aadress

${email} was used to register on ${brand}. Konto loomiseks sisestage see kood brauseriaknas.

 

${code}

 

If you have any questions, please contact us.

Privacy policy and terms of use · Report Misuse
${copyright}. ALL RIGHTS RESERVED.

                                                           
\ No newline at end of file +${code} is your ${brand} verification code

${brand_label_url}

Kinnita oma e-posti aadress

${email} was used to register on ${brand}. Konto loomiseks sisestage see kood brauseriaknas.

 

${code}

 

If you have any questions, please contact us.

Privacy policy and terms of use · Report Misuse
${copyright}. ALL RIGHTS RESERVED.

                                                           
\ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/fr/user/email/activation.html b/services/brig/deb/opt/brig/templates/fr/user/email/activation.html index d2fb45305ed..8435bf74e19 100644 --- a/services/brig/deb/opt/brig/templates/fr/user/email/activation.html +++ b/services/brig/deb/opt/brig/templates/fr/user/email/activation.html @@ -1 +1 @@ -Votre Compte ${brand}

${brand_label_url}

Vérification de votre adresse email

${email} a été utilisé pour s'enregistrer sur ${brand}.
Cliquez sur le bouton ci-dessous pour vérifier votre adresse.

 
Vérifier
 

Si vous ne pouvez pas cliquer sur le bouton, copiez et collez ce lien dans votre navigateur :

${url}

Si vous avez des questions, veuillez nous contacter.

Règles de confidentialité et conditions d'utilisation · Signaler un abus
${copyright}. TOUS DROITS RÉSERVÉS.

                                                           
\ No newline at end of file +Votre Compte ${brand}

${brand_label_url}

Vérification de votre adresse email

${email} a été utilisé pour s'enregistrer sur ${brand}.
Cliquez sur le bouton ci-dessous pour vérifier votre adresse.

 
Vérifier
 

Si vous ne pouvez pas cliquer sur le bouton, copiez et collez ce lien dans votre navigateur :

${url}

Si vous avez des questions, veuillez nous contacter.

Règles de confidentialité et conditions d'utilisation · Signaler un abus
${copyright}. TOUS DROITS RÉSERVÉS.

                                                           
\ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/fr/user/email/deletion.html b/services/brig/deb/opt/brig/templates/fr/user/email/deletion.html index 03721e20ac2..331a6b0cbcf 100644 --- a/services/brig/deb/opt/brig/templates/fr/user/email/deletion.html +++ b/services/brig/deb/opt/brig/templates/fr/user/email/deletion.html @@ -1 +1 @@ -Supprimer votre compte ?

${brand_label_url}

Supprimer votre compte

Nous avons reçu une demande de suppression de votre compte ${brand}. Cliquez sur le lien ci-dessous dans les 10 minutes pour supprimer toutes vos conversations, contenus et connexions.

 
Supprimer le compte
 

Si vous ne pouvez pas cliquer sur le bouton, copiez et collez ce lien dans votre navigateur :

${url}

Si vous n'êtes pas à l'origine de cette demande, réinitialisez votre mot de passe.

Si vous avez des questions, veuillez nous contacter.

Règles de confidentialité et conditions d'utilisation · Signaler un abus
${copyright}. TOUS DROITS RÉSERVÉS.

                                                           
\ No newline at end of file +Supprimer votre compte ?

${brand_label_url}

Supprimer votre compte

Nous avons reçu une demande de suppression de votre compte ${brand}. Cliquez sur le lien ci-dessous dans les 10 minutes pour supprimer toutes vos conversations, contenus et connexions.

 
Supprimer le compte
 

Si vous ne pouvez pas cliquer sur le bouton, copiez et collez ce lien dans votre navigateur :

${url}

Si vous n'êtes pas à l'origine de cette demande, réinitialisez votre mot de passe.

Si vous avez des questions, veuillez nous contacter.

Règles de confidentialité et conditions d'utilisation · Signaler un abus
${copyright}. TOUS DROITS RÉSERVÉS.

                                                           
\ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/fr/user/email/new-client.html b/services/brig/deb/opt/brig/templates/fr/user/email/new-client.html index f971057e648..6c3a77b13e8 100644 --- a/services/brig/deb/opt/brig/templates/fr/user/email/new-client.html +++ b/services/brig/deb/opt/brig/templates/fr/user/email/new-client.html @@ -1 +1 @@ -Nouvel appareil

${brand_label_url}

Nouvel appareil

Votre compte ${brand} a été utilisé sur :

${date}

${model}

Il se peut que vous ayez installé ${brand} sur un nouvel appareil ou réinstallé sur le même. Si ce n'était pas le cas, allez dans les paramètres de ${brand}, retirez cet appareil et réinitialisez votre mot de passe.

Si vous avez des questions, veuillez nous contacter.

Règles de confidentialité et conditions d'utilisation · Signaler un abus
${copyright}. TOUS DROITS RÉSERVÉS.

                                                           
\ No newline at end of file +Nouvel appareil

${brand_label_url}

Nouvel appareil

Votre compte ${brand} a été utilisé sur :

${date}

${model}

Il se peut que vous ayez installé ${brand} sur un nouvel appareil ou réinstallé sur le même. Si ce n'était pas le cas, allez dans les paramètres de ${brand}, retirez cet appareil et réinitialisez votre mot de passe.

Si vous avez des questions, veuillez nous contacter.

Règles de confidentialité et conditions d'utilisation · Signaler un abus
${copyright}. TOUS DROITS RÉSERVÉS.

                                                           
\ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/fr/user/email/password-reset.html b/services/brig/deb/opt/brig/templates/fr/user/email/password-reset.html index c95987ccc7d..02cc9de42e7 100644 --- a/services/brig/deb/opt/brig/templates/fr/user/email/password-reset.html +++ b/services/brig/deb/opt/brig/templates/fr/user/email/password-reset.html @@ -1 +1 @@ -Réinitialisation du mot de passe ${brand}

${brand_label_url}

Réinitialiser votre mot de passe

Nous avons reçu une demande pour réinitialiser le mot de passe de votre compte ${brand}. Pour créer un nouveau mot de passe, cliquez sur le bouton ci-dessous.

 
Réinitialiser le mot de passe
 

Si vous ne pouvez pas cliquer sur le bouton, copiez et collez ce lien dans votre navigateur :

${url}

Si vous avez des questions, veuillez nous contacter.

Règles de confidentialité et conditions d'utilisation · Signaler un abus
${copyright}. TOUS DROITS RÉSERVÉS.

                                                           
\ No newline at end of file +Réinitialisation du mot de passe ${brand}

${brand_label_url}

Réinitialiser votre mot de passe

Nous avons reçu une demande pour réinitialiser le mot de passe de votre compte ${brand}. Pour créer un nouveau mot de passe, cliquez sur le bouton ci-dessous.

 
Réinitialiser le mot de passe
 

Si vous ne pouvez pas cliquer sur le bouton, copiez et collez ce lien dans votre navigateur :

${url}

Si vous avez des questions, veuillez nous contacter.

Règles de confidentialité et conditions d'utilisation · Signaler un abus
${copyright}. TOUS DROITS RÉSERVÉS.

                                                           
\ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/fr/user/email/team-activation.html b/services/brig/deb/opt/brig/templates/fr/user/email/team-activation.html index c1a3c2eb890..d4450a20a3d 100644 --- a/services/brig/deb/opt/brig/templates/fr/user/email/team-activation.html +++ b/services/brig/deb/opt/brig/templates/fr/user/email/team-activation.html @@ -1 +1 @@ -Compte ${brand}

${brand_label_url}

Votre nouveau compte ${brand}

Une nouvelle équipé a été créée sur ${brand} avec ${email}. Veuillez vérifier votre adresse email s’il vous plaît.

 
Vérifier
 

Si vous ne pouvez pas cliquer sur le bouton, copiez et collez ce lien dans votre navigateur :

${url}

Si vous avez des questions, veuillez nous contacter.

Règles de confidentialité et conditions d'utilisation · Signaler un abus
${copyright}. TOUS DROITS RÉSERVÉS.

                                                           
\ No newline at end of file +Compte ${brand}

${brand_label_url}

Votre nouveau compte ${brand}

Une nouvelle équipé a été créée sur ${brand} avec ${email}. Veuillez vérifier votre adresse email s’il vous plaît.

 
Vérifier
 

Si vous ne pouvez pas cliquer sur le bouton, copiez et collez ce lien dans votre navigateur :

${url}

Si vous avez des questions, veuillez nous contacter.

Règles de confidentialité et conditions d'utilisation · Signaler un abus
${copyright}. TOUS DROITS RÉSERVÉS.

                                                           
\ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/fr/user/email/update.html b/services/brig/deb/opt/brig/templates/fr/user/email/update.html index eba1972a7b3..5aeb1430126 100644 --- a/services/brig/deb/opt/brig/templates/fr/user/email/update.html +++ b/services/brig/deb/opt/brig/templates/fr/user/email/update.html @@ -1 +1 @@ -Votre nouvelle adresse e-mail sur ${brand}

${brand_label_url}

Vérification de votre adresse email

${email} a été enregistré comme votre nouvelle adresse email sur ${brand}. Veuillez vérifier votre email s’il vous plaît. Cliquez sur le bouton ci-dessous pour vérifier votre adresse email.

 
Vérifier
 

Si vous ne pouvez pas cliquer sur le bouton, copiez et collez ce lien dans votre navigateur :

${url}

Si vous avez des questions, veuillez nous contacter.

Règles de confidentialité et conditions d'utilisation · Signaler un abus
${copyright}. TOUS DROITS RÉSERVÉS.

                                                           
\ No newline at end of file +Votre nouvelle adresse e-mail sur ${brand}

${brand_label_url}

Vérification de votre adresse email

${email} a été enregistré comme votre nouvelle adresse email sur ${brand}. Veuillez vérifier votre email s’il vous plaît. Cliquez sur le bouton ci-dessous pour vérifier votre adresse email.

 
Vérifier
 

Si vous ne pouvez pas cliquer sur le bouton, copiez et collez ce lien dans votre navigateur :

${url}

Si vous avez des questions, veuillez nous contacter.

Règles de confidentialité et conditions d'utilisation · Signaler un abus
${copyright}. TOUS DROITS RÉSERVÉS.

                                                           
\ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/fr/user/email/verification-delete-team-subject.txt b/services/brig/deb/opt/brig/templates/fr/user/email/verification-delete-team-subject.txt index e69de29bb2d..2498475de38 100644 --- a/services/brig/deb/opt/brig/templates/fr/user/email/verification-delete-team-subject.txt +++ b/services/brig/deb/opt/brig/templates/fr/user/email/verification-delete-team-subject.txt @@ -0,0 +1 @@ +« votre code de vérification ${brand} est ${code} » \ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/fr/user/email/verification-delete-team.html b/services/brig/deb/opt/brig/templates/fr/user/email/verification-delete-team.html index 3f6dfbd6a81..cd176964978 100644 --- a/services/brig/deb/opt/brig/templates/fr/user/email/verification-delete-team.html +++ b/services/brig/deb/opt/brig/templates/fr/user/email/verification-delete-team.html @@ -1 +1 @@ -

${brand_label_url}

Vérifier la suppression de l'équipe

${email} a été utilisé pour supprimer votre équipe ${brand}. Entrez ce code pour vérifier votre adresse courriel et supprimer l'équipe.

 

${code}

 

Si vous avez des questions, veuillez nous contacter.

Règles de confidentialité et conditions d'utilisation · Signaler un abus
${copyright}. TOUS DROITS RÉSERVÉS.

                                                           
\ No newline at end of file +« votre code de vérification ${brand} est ${code} »

${brand_label_url}

Vérifier la suppression de l'équipe

${email} a été utilisé pour supprimer votre équipe ${brand}. Entrez ce code pour vérifier votre adresse courriel et supprimer l'équipe.

 

${code}

 

Si vous avez des questions, veuillez nous contacter.

Règles de confidentialité et conditions d'utilisation · Signaler un abus
${copyright}. TOUS DROITS RÉSERVÉS.

                                                           
\ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/fr/user/email/verification-login.html b/services/brig/deb/opt/brig/templates/fr/user/email/verification-login.html index 8e9d0b12908..e7706bd69fd 100644 --- a/services/brig/deb/opt/brig/templates/fr/user/email/verification-login.html +++ b/services/brig/deb/opt/brig/templates/fr/user/email/verification-login.html @@ -1 +1 @@ -« votre code de vérification ${brand} est ${code} »

${brand_label_url}

Vérifier la connexion

${email} a été utilisé pour se connecter à votre compte ${brand}. Entrez ce code pour vérifier votre adresse courriel et connectez-vous.

 

${code}

 

Si vous avez des questions, veuillez nous contacter.

Règles de confidentialité et conditions d'utilisation · Signaler un abus
${copyright}. TOUS DROITS RÉSERVÉS.

                                                           
\ No newline at end of file +« votre code de vérification ${brand} est ${code} »

${brand_label_url}

Vérifier la connexion

${email} a été utilisé pour se connecter à votre compte ${brand}. Entrez ce code pour vérifier votre adresse courriel et connectez-vous.

 

${code}

 

Si vous avez des questions, veuillez nous contacter.

Règles de confidentialité et conditions d'utilisation · Signaler un abus
${copyright}. TOUS DROITS RÉSERVÉS.

                                                           
\ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/fr/user/email/verification-scim-token-subject.txt b/services/brig/deb/opt/brig/templates/fr/user/email/verification-scim-token-subject.txt index e69de29bb2d..2498475de38 100644 --- a/services/brig/deb/opt/brig/templates/fr/user/email/verification-scim-token-subject.txt +++ b/services/brig/deb/opt/brig/templates/fr/user/email/verification-scim-token-subject.txt @@ -0,0 +1 @@ +« votre code de vérification ${brand} est ${code} » \ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/fr/user/email/verification-scim-token.html b/services/brig/deb/opt/brig/templates/fr/user/email/verification-scim-token.html index cc6237b38ce..ebee6e06170 100644 --- a/services/brig/deb/opt/brig/templates/fr/user/email/verification-scim-token.html +++ b/services/brig/deb/opt/brig/templates/fr/user/email/verification-scim-token.html @@ -1 +1 @@ -

${brand_label_url}

Vérifier la création du jeton SCIM

${email} a été utilisé pour générer un jeton SCIM. Entrez ce code pour vérifier votre adresse courriel et créer le jeton.

 

${code}

 

Si vous avez des questions, veuillez nous contacter.

Règles de confidentialité et conditions d'utilisation · Signaler un abus
${copyright}. TOUS DROITS RÉSERVÉS.

                                                           
\ No newline at end of file +« votre code de vérification ${brand} est ${code} »

${brand_label_url}

Vérifier la création du jeton SCIM

${email} a été utilisé pour générer un jeton SCIM. Entrez ce code pour vérifier votre adresse courriel et créer le jeton.

 

${code}

 

Si vous avez des questions, veuillez nous contacter.

Règles de confidentialité et conditions d'utilisation · Signaler un abus
${copyright}. TOUS DROITS RÉSERVÉS.

                                                           
\ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/fr/user/email/verification.html b/services/brig/deb/opt/brig/templates/fr/user/email/verification.html index 0209a72d2d7..a3ab5aa79f1 100644 --- a/services/brig/deb/opt/brig/templates/fr/user/email/verification.html +++ b/services/brig/deb/opt/brig/templates/fr/user/email/verification.html @@ -1 +1 @@ -${code} est votre code de vérification pour ${brand}

${brand_label_url}

Vérification de votre adresse email

L'adresse ${email} a été utilisée pour créer un compte sur ${brand}. Entrez ce code afin de vérifier votre adresse email et créer votre compte.

 

${code}

 

Si vous avez des questions, veuillez nous contacter.

Règles de confidentialité et conditions d'utilisation · Signaler un abus
${copyright}. TOUS DROITS RÉSERVÉS.

                                                           
\ No newline at end of file +${code} est votre code de vérification pour ${brand}

${brand_label_url}

Vérification de votre adresse email

L'adresse ${email} a été utilisée pour créer un compte sur ${brand}. Entrez ce code afin de vérifier votre adresse email et créer votre compte.

 

${code}

 

Si vous avez des questions, veuillez nous contacter.

Règles de confidentialité et conditions d'utilisation · Signaler un abus
${copyright}. TOUS DROITS RÉSERVÉS.

                                                           
\ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/index.html b/services/brig/deb/opt/brig/templates/index.html index 7c4de7c2040..f0d4029dc3a 100644 --- a/services/brig/deb/opt/brig/templates/index.html +++ b/services/brig/deb/opt/brig/templates/index.html @@ -4,4 +4,4 @@ link.rel = 'stylesheet'; link.href = '//cdnjs.cloudflare.com/ajax/libs/flag-icon-css/2.9.0/css/flag-icon.min.css'; document.head.appendChild(link); - }
 

Wire Email Templates Preview

Click the links below to display the content of each message:

Provider
  1. Activation — txt
  2. Approval confirm — txt
  3. Approval request — txt
Team
  1. Invitation — txt
  2. New member welcome — txt
User
  1. Activation — txt
  2. Deletion — txt
  3. New client — txt
  4. Password reset — txt
  5. Update — txt
  6. Verification — txt
  7. Team activation — txt
  8. Second factor verification for login — txt
  9. Second factor verification create SCIM token — txt
  10. Second factor verification delete team — txt
Billing
  1. Suspension — txt

For source and instructions, see github.com/wireapp/wire-emails or visit the Crowdin project to help with translations.

                                                           
\ No newline at end of file + }
 

Wire Email Templates Preview

Click the links below to display the content of each message:

Provider
  1. Activation — txt
  2. Approval confirm — txt
  3. Approval request — txt
Team
  1. Invitation — txt
  2. New member welcome — txt
User
  1. Activation — txt
  2. Deletion — txt
  3. New client — txt
  4. Password reset — txt
  5. Update — txt
  6. Verification — txt
  7. Team activation — txt
  8. Second factor verification for login — txt
  9. Second factor verification create SCIM token — txt
  10. Second factor verification delete team — txt
Billing
  1. Suspension — txt

For source and instructions, see github.com/wireapp/wire-emails or visit the Crowdin project to help with translations.

                                                           
\ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/it/user/call/activation.txt b/services/brig/deb/opt/brig/templates/it/user/call/activation.txt index fa1e320db39..c1b51fc95b8 100644 --- a/services/brig/deb/opt/brig/templates/it/user/call/activation.txt +++ b/services/brig/deb/opt/brig/templates/it/user/call/activation.txt @@ -1 +1 @@ -Ciao, il tuo codice di verifica di Wire è: ${code}. Ripeto, il codice è: ${code} \ No newline at end of file +Ciao, il tuo codice verifica di Wire è: ${code}. Ancora una volta, il codice è: ${code} \ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/it/user/call/login.txt b/services/brig/deb/opt/brig/templates/it/user/call/login.txt index e51ef3c5a68..fd6cfc78e6a 100644 --- a/services/brig/deb/opt/brig/templates/it/user/call/login.txt +++ b/services/brig/deb/opt/brig/templates/it/user/call/login.txt @@ -1 +1 @@ -Ciao, il tuo codice di accesso Wire è: ${code}. Ripeto, il codice è: ${code} +Ciao, il tuo codice di accesso di Wire è: ${code}. Ancora una volta, il codice è: ${code} \ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/it/user/email/activation-subject.txt b/services/brig/deb/opt/brig/templates/it/user/email/activation-subject.txt index 4934020198c..ee3b847edfb 100644 --- a/services/brig/deb/opt/brig/templates/it/user/email/activation-subject.txt +++ b/services/brig/deb/opt/brig/templates/it/user/email/activation-subject.txt @@ -1 +1 @@ -Il tuo account su Wire \ No newline at end of file +Il tuo account ${brand} \ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/it/user/email/activation.html b/services/brig/deb/opt/brig/templates/it/user/email/activation.html index b6c7a766375..0812e96af31 100644 --- a/services/brig/deb/opt/brig/templates/it/user/email/activation.html +++ b/services/brig/deb/opt/brig/templates/it/user/email/activation.html @@ -1,124 +1 @@ - - - - - - - -
- - - - - - - - - - - - - - - - - -
- - - wire.com -
-

- Ciao, -

- -

- L'indirizzo ${email} è stato usato per create un account su Wire. Ti preghiamo di confermare l'indirizzoo email. -

-

- - CONFERMA - -

-

- Clicca sul pulsante qui sopra per verificare il tuo indirizzo. Non puoi utilizzare Wire fino a che non premi il pulsante. -

-

- Se non è possibile fare clic sul pulsante, usa questo link:
-

-

- ${url} -

-

- Se non hai richiesto tu questa modifica, puoi ignorare questa email o - - contattaci - . -

-
- Informativa sulla privacy · Segnala uso improprio
© Wire Swiss GmbH. Tutti i diritti riservati. -
- - +Il tuo account ${brand}

${brand_label_url}

Verifica il tuo indirizzo e-mail

${email} è stato utilizzata per registrarsi su ${brand}.
Clicca il pulsante per verificare il tuo indirizzo.

 
Verifica
 

Se non puoi fare clic sul pulsante, copia e incolla questo link nel tuo browser:

${url}

Se hai domande, per favore contattaci.

Politica della privacy e termini d'uso · Segnala Uso Scorretto
${copyright}. TUTTI I DIRITTI RISERVATI.

                                                           
\ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/it/user/email/activation.txt b/services/brig/deb/opt/brig/templates/it/user/email/activation.txt index dd8fa3fe157..b655bab11cb 100644 --- a/services/brig/deb/opt/brig/templates/it/user/email/activation.txt +++ b/services/brig/deb/opt/brig/templates/it/user/email/activation.txt @@ -1,22 +1,21 @@ -Wire +[${brand_logo}] +${brand_label_url} [${brand_url}] -Ciao, - -Il tuo indirizzo e-mail ${email} è stato utilizzato per creare un account su Wire. Ti preghiamo di verificare l'indirizzo email. - -Apri il link qui sotto per confermare il tuo indirizzo. Non potrai usare Wire fino a che non avrai confermato. +VERIFICA IL TUO INDIRIZZO E-MAIL +${email} è stato utilizzata per registrarsi su ${brand}. +Clicca il pulsante per verificare il tuo indirizzo. +Verifica [${url}]Se non puoi fare clic sul pulsante, copia e incolla questo link +nel tuo browser: ${url} -Si prega di non rispondere a questo messaggio. - -Se non sei stato tu a create un account Wire con questa e-mail, si prega di visitare https://support.wire.com - - +Se hai domande, per favore contattaci [${support}]. -(c) Wire Swiss GmbH +-------------------------------------------------------------------------------- -Informativa sulla privacy | Riporta uso improprio +Politica della privacy e termini d'uso [${legal}] · Segnala Uso Scorretto +[${misuse}] +${copyright}. TUTTI I DIRITTI RISERVATI. \ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/it/user/email/deletion-subject.txt b/services/brig/deb/opt/brig/templates/it/user/email/deletion-subject.txt index c2b90f5c4cf..9e0674745cf 100644 --- a/services/brig/deb/opt/brig/templates/it/user/email/deletion-subject.txt +++ b/services/brig/deb/opt/brig/templates/it/user/email/deletion-subject.txt @@ -1 +1 @@ -Eliminare l'account? \ No newline at end of file +Eliminare account? \ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/it/user/email/deletion.html b/services/brig/deb/opt/brig/templates/it/user/email/deletion.html index cebdc7ae191..10d09fa2521 100644 --- a/services/brig/deb/opt/brig/templates/it/user/email/deletion.html +++ b/services/brig/deb/opt/brig/templates/it/user/email/deletion.html @@ -1,123 +1 @@ - - - - - - - -
- - - - - - - - - - - - - - - - - -
- - - wire.com -
-

- Ciao ${name}, -

- -

- Abbiamo ricevuto una richiesta per eliminare il tuo account su Wire. Clicca sul pulsante sotto entro 10 minuti per eliminare tutte le tue conversazioni, contenuti e collegamenti -

-

- - ELIMINA ACCOUNT - -

-

- Se non è possibile fare clic sul pulsante, usa questo link:
-

-

- ${url} -

-

- Se non sei stato tu a richiederlo, reimposta la tua password. -

-

- Il team di Wire -

-
- Informativa sulla privacy · Segnala uso improprio
© Wire Swiss GmbH. Tutti i diritti riservati. -
- - +Eliminare account?

${brand_label_url}

Elimina il tuo account

Abbiamo ricevuto una richiesta per eliminare il tuo account ${brand}. Clicca sul pulsante qui sotto entro 10 minuti per eliminare tutte le conversazioni, i contenuti e le connessioni.

 
Elimina account
 

Se non puoi fare clic sul pulsante, copia e incolla questo link nel tuo browser:

${url}

Se non lo hai richiesto, reimposta la password.

Se hai domande, per favore contattaci.

Politica della privacy e termini d'uso · Segnala Uso Scorretto
${copyright}. TUTTI I DIRITTI RISERVATI.

                                                           
\ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/it/user/email/deletion.txt b/services/brig/deb/opt/brig/templates/it/user/email/deletion.txt index 4333b54d64d..376449de73c 100644 --- a/services/brig/deb/opt/brig/templates/it/user/email/deletion.txt +++ b/services/brig/deb/opt/brig/templates/it/user/email/deletion.txt @@ -1,17 +1,24 @@ -Wire +[${brand_logo}] +${brand_label_url} [${brand_url}] -Ciao ${name}, +ELIMINA IL TUO ACCOUNT +Abbiamo ricevuto una richiesta per eliminare il tuo account ${brand}. Clicca sul +pulsante qui sotto entro 10 minuti per eliminare tutte le conversazioni, i +contenuti e le connessioni. -Abbiamo ricevuto una richiesta per eliminare il tuo account su Wire. Visita il link qui sotto entro 10 minuti per eliminare tutte le tue conversazioni, contenuti e collegamenti +Elimina account [${url}]Se non puoi fare clic sul pulsante, copia e incolla +questo link nel tuo browser: ${url} -Se non sei stato tu a richiedere l'eliminazione, reimposta la password. +Se non lo hai richiesto, reimposta la password [${forgot}]. -Il team di Wire +Se hai domande, per favore contattaci [${support}]. -(c) Wire Swiss GmbH +-------------------------------------------------------------------------------- -Informativa sulla privacy | Riporta uso improprio +Politica della privacy e termini d'uso [${legal}] · Segnala Uso Scorretto +[${misuse}] +${copyright}. TUTTI I DIRITTI RISERVATI. \ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/it/user/email/new-client.html b/services/brig/deb/opt/brig/templates/it/user/email/new-client.html index 100a746e2dd..dc4dbaccb0e 100644 --- a/services/brig/deb/opt/brig/templates/it/user/email/new-client.html +++ b/services/brig/deb/opt/brig/templates/it/user/email/new-client.html @@ -1,99 +1 @@ - - - - - - - -
- - - - - - - - - - - - - - - - - -
- - - wire.com -
-

- Ciao ${name}, -

- -

- Il tuo account di Wire è stato utilizzato in data: -

- -

- ${date} -

-

- ${model} -

- -

- Potresti avere installato Wire su un nuovo dispositivo o averlo installato di nuovo su uno utilizzato precedentemente. Se non fosse così, vai alle impostazioni di Wire, rimuovi il dispositivo e reimposta la password. -

- -

- Il team di Wire -

-
- Informativa sulla privacy · Segnala uso improprio
© Wire Swiss GmbH. Tutti i diritti riservati. -
- - +Nuovo dispositivo

${brand_label_url}

Nuovo dispositivo

Il tuo account ${brand} è stato utilizzato in data:

${date}

${model}

Potresti avere installato ${brand} su un nuovo dispositivo o averlo installato di nuovo su uno utilizzato precedentemente. Se questo non è il caso, vai nelle impostazioni di ${brand} rimuovi quel dispositivo e reimposta la tua password.

Se hai domande, per favore contattaci.

Politica della privacy e termini d'uso · Segnala Uso Scorretto
${copyright}. TUTTI I DIRITTI RISERVATI.

                                                           
\ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/it/user/email/new-client.txt b/services/brig/deb/opt/brig/templates/it/user/email/new-client.txt index 1193c2cf489..ae7cc169b84 100644 --- a/services/brig/deb/opt/brig/templates/it/user/email/new-client.txt +++ b/services/brig/deb/opt/brig/templates/it/user/email/new-client.txt @@ -1,18 +1,24 @@ -Wire +[${brand_logo}] +${brand_label_url} [${brand_url}] -Ciao ${name}, +NUOVO DISPOSITIVO +Il tuo account ${brand} è stato utilizzato in data: -Il tuo account di Wire è stato utilizzato in data: +${date} - ${date} - ${model} +${model} -Potresti avere installato Wire su un nuovo dispositivo o averlo installato di nuovo su uno utilizzato precedentemente. Se questo non è il caso, vai nelle impostazioni di Wire, rimuovi quel dispositivo e reimposta la tua password. +Potresti avere installato ${brand} su un nuovo dispositivo o averlo installato +di nuovo su uno utilizzato precedentemente. Se questo non è il caso, vai nelle +impostazioni di ${brand} rimuovi quel dispositivo e reimposta la tua password +[${forgot}]. -Il team di Wire +Se hai domande, per favore contattaci [${support}]. -(c) Wire Swiss GmbH +-------------------------------------------------------------------------------- -Informativa sulla privacy | Riporta uso improprio +Politica della privacy e termini d'uso [${legal}] · Segnala Uso Scorretto +[${misuse}] +${copyright}. TUTTI I DIRITTI RISERVATI. \ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/it/user/email/password-reset-subject.txt b/services/brig/deb/opt/brig/templates/it/user/email/password-reset-subject.txt index f4f06b6f47e..e052e20d512 100644 --- a/services/brig/deb/opt/brig/templates/it/user/email/password-reset-subject.txt +++ b/services/brig/deb/opt/brig/templates/it/user/email/password-reset-subject.txt @@ -1 +1 @@ -Modifica della password di Wire \ No newline at end of file +Cambio di password di ${brand} \ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/it/user/email/password-reset.html b/services/brig/deb/opt/brig/templates/it/user/email/password-reset.html index e3b992d6813..475f1d82b97 100644 --- a/services/brig/deb/opt/brig/templates/it/user/email/password-reset.html +++ b/services/brig/deb/opt/brig/templates/it/user/email/password-reset.html @@ -1,115 +1 @@ - - - - - - - -
- - - - - - - - - - - - - - - - - -
- - - wire.com -
-

- Ciao, -

-

- Abbiamo ricevuto una richiesta per modificare la password per l'account di Wire. Per modificare Per modificare la password, fai clic sul pulsante qui sotto. -

-

- - CAMBIA PASSWORD - -

-

- Se non è possibile fare clic sul pulsante, usa questo link:
-

-

- ${url} -

-

- Questo è un messaggio automatico e nessuno potrà leggere la tua risposta. -

-
- Informativa sulla privacy · Segnala uso improprio
© Wire Swiss GmbH. Tutti i diritti riservati. -
- - +Cambio di password di ${brand}

${brand_label_url}

Reimposta la tua password

Abbiamo ricevuto una richiesta di reimpostazione della password del tuo account ${brand}. Per creare una nuova password, fai clic sul pulsante qui sotto.

 
Reimposta password
 

Se non puoi fare clic sul pulsante, copia e incolla questo link nel tuo browser:

${url}

Se hai domande, per favore contattaci.

Politica della privacy e termini d'uso · Segnala Uso Scorretto
${copyright}. TUTTI I DIRITTI RISERVATI.

                                                           
\ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/it/user/email/password-reset.txt b/services/brig/deb/opt/brig/templates/it/user/email/password-reset.txt index 1c2e63ccb1e..3aa152a0db3 100644 --- a/services/brig/deb/opt/brig/templates/it/user/email/password-reset.txt +++ b/services/brig/deb/opt/brig/templates/it/user/email/password-reset.txt @@ -1,21 +1,21 @@ -Wire +[${brand_logo}] +${brand_label_url} [${brand_url}] -Ciao, +REIMPOSTA LA TUA PASSWORD +Abbiamo ricevuto una richiesta di reimpostazione della password del tuo account +${brand}. Per creare una nuova password, fai clic sul pulsante qui sotto. -Abbiamo ricevuto una richiesta per modificare la password per l'account di Wire. - -Per modificare la password, fai clic sul link qui sotto. +Reimposta password [${url}]Se non puoi fare clic sul pulsante, copia e incolla +questo link nel tuo browser: ${url} -Si prega di non rispondere a questo messaggio. - -Questo è un messaggio automatico e nessuno potrà leggere la tua risposta. -Se hai bisogno di aiuto, si prega di visitare https://support.wire.com - +Se hai domande, per favore contattaci [${support}]. -(c) Wire Swiss GmbH +-------------------------------------------------------------------------------- -Informativa sulla privacy | Riporta uso improprio +Politica della privacy e termini d'uso [${legal}] · Segnala Uso Scorretto +[${misuse}] +${copyright}. TUTTI I DIRITTI RISERVATI. \ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/it/user/email/team-activation-subject.txt b/services/brig/deb/opt/brig/templates/it/user/email/team-activation-subject.txt index 4934020198c..e1d8c21b701 100644 --- a/services/brig/deb/opt/brig/templates/it/user/email/team-activation-subject.txt +++ b/services/brig/deb/opt/brig/templates/it/user/email/team-activation-subject.txt @@ -1 +1 @@ -Il tuo account su Wire \ No newline at end of file +Profilo di ${brand} \ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/it/user/email/team-activation.html b/services/brig/deb/opt/brig/templates/it/user/email/team-activation.html index eb02eb099c2..0f6eeadb38b 100644 --- a/services/brig/deb/opt/brig/templates/it/user/email/team-activation.html +++ b/services/brig/deb/opt/brig/templates/it/user/email/team-activation.html @@ -1,121 +1 @@ - - - - - - - -
- - - - -
-
- - - - - - - - - - - - - - - - - -
- Wire - - wire.com -
-

- Il tuo nuovo account Wire -

-
-

- Un nuovo team su Wire è stato creato con l'indirizzo email ${email}. Ti preghiamo di verificare l'indirizzo email. -

-

- - VERIFICA - -

-

- Clicca sul pulsante qui sopra per verificare il tuo indirizzo. Non puoi utilizzare Wire fino a che non premi il pulsante. -

-

- Se non è possibile fare clic sul pulsante, usa questo link:
-

-

- ${url} -

-

- Se non hai richiesto tu questa modifica, puoi ignorare questa email o - - contattaci - . -

-
- Privacy· - Segnala abuso
Wire Swiss GmbH. Tutti i diritti riservati. -
-
-
- - +Profilo di ${brand}

${brand_label_url}

Il tuo nuovo profilo su ${brand}

Un nuovo team di ${brand} è stato creato con ${email}. Sei pregato di verificare la tua email.

 
Verifica
 

Se non puoi fare clic sul pulsante, copia e incolla questo link nel tuo browser:

${url}

Se hai domande, per favore contattaci.

Politica della privacy e termini d'uso · Segnala Uso Scorretto
${copyright}. TUTTI I DIRITTI RISERVATI.

                                                           
\ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/it/user/email/team-activation.txt b/services/brig/deb/opt/brig/templates/it/user/email/team-activation.txt index 437ad4e0bb8..83096c121e5 100644 --- a/services/brig/deb/opt/brig/templates/it/user/email/team-activation.txt +++ b/services/brig/deb/opt/brig/templates/it/user/email/team-activation.txt @@ -1,22 +1,21 @@ -Wire +[${brand_logo}] +${brand_label_url} [${brand_url}] -Ciao, - -Un nuovo team su Wire è stato creato con l'indirizzo email ${email}. Ti preghiamo di verificare l'indirizzo email. - -Apri il link qui sotto per confermare il tuo indirizzo. Non potrai usare Wire fino a che non avrai confermato. +IL TUO NUOVO PROFILO SU ${brand} +Un nuovo team di ${brand} è stato creato con ${email}. Sei pregato di verificare +la tua email. +Verifica [${url}]Se non puoi fare clic sul pulsante, copia e incolla questo link +nel tuo browser: ${url} -Si prega di non rispondere a questo messaggio. - -Se non sei stato tu a create un account Wire con questa e-mail, si prega di visitare https://support.wire.com - - +Se hai domande, per favore contattaci [${support}]. -(c) Wire Swiss GmbH +-------------------------------------------------------------------------------- -Informativa sulla privacy | Riporta uso improprio +Politica della privacy e termini d'uso [${legal}] · Segnala Uso Scorretto +[${misuse}] +${copyright}. TUTTI I DIRITTI RISERVATI. \ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/it/user/email/update-subject.txt b/services/brig/deb/opt/brig/templates/it/user/email/update-subject.txt index 362aa22a1f4..153308448f5 100644 --- a/services/brig/deb/opt/brig/templates/it/user/email/update-subject.txt +++ b/services/brig/deb/opt/brig/templates/it/user/email/update-subject.txt @@ -1 +1 @@ -Il tuo nuovo indirizzo email su Wire \ No newline at end of file +Il tuo nuovo indirizzo email su ${brand} \ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/it/user/email/update.html b/services/brig/deb/opt/brig/templates/it/user/email/update.html index 932dc544631..0685328ddb6 100644 --- a/services/brig/deb/opt/brig/templates/it/user/email/update.html +++ b/services/brig/deb/opt/brig/templates/it/user/email/update.html @@ -1,123 +1 @@ - - - - - - - -
- - - - - - - - - - - - - - - - - -
- - - wire.com -
-

- Ciao, -

- -

- ${email} è stato impostato come il tuo nuovo indirizzo email su Wire. Ti preghiamo di verificare l'indirizzo. -

-

- - CONFERMA - -

-

- Clicca sul pulsante qui sopra per verificare il tuo nuovo indirizzo email. -

-

- Se non è possibile fare clic sul pulsante, usa questo link:
-

-

- ${url} -

-

- Se non hai richiesto tu questa modifica, puoi ignorare questa email o - - contattaci - . -

-
- Informativa sulla privacy · Segnala uso improprio
© Wire Swiss GmbH. Tutti i diritti riservati. -
- - +Il tuo nuovo indirizzo email su ${brand}

${brand_label_url}

Verifica il tuo indirizzo e-mail

${email} è stato registrato come tuo nuovo indirizzo email su ${brand}. Clicca il pulsante sotto per verificare il tuo indirizzo.

 
Verifica
 

Se non puoi fare clic sul pulsante, copia e incolla questo link nel tuo browser:

${url}

Se hai domande, per favore contattaci.

Politica della privacy e termini d'uso · Segnala Uso Scorretto
${copyright}. TUTTI I DIRITTI RISERVATI.

                                                           
\ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/it/user/email/update.txt b/services/brig/deb/opt/brig/templates/it/user/email/update.txt index 92b8b8cb3fc..881ea68a8b0 100644 --- a/services/brig/deb/opt/brig/templates/it/user/email/update.txt +++ b/services/brig/deb/opt/brig/templates/it/user/email/update.txt @@ -1,22 +1,21 @@ -Wire +[${brand_logo}] +${brand_label_url} [${brand_url}] -Ciao, - -${email} è stato registrato come il tuo nuovo indirizzo email su Wire. Ti preghiamo di verificare l'indirizzo email. - -Apri il link qui sotto per confermare il tuo nuovo indirizzo. +VERIFICA IL TUO INDIRIZZO E-MAIL +${email} è stato registrato come tuo nuovo indirizzo email su ${brand}. Clicca +il pulsante sotto per verificare il tuo indirizzo. +Verifica [${url}]Se non puoi fare clic sul pulsante, copia e incolla questo link +nel tuo browser: ${url} -Si prega di non rispondere a questo messaggio. - -Se non hai richiesto questa modifica, puoi ignorare questa email o visita https://support.wire.com - - +Se hai domande, per favore contattaci [${support}]. -(c) Wire Swiss GmbH +-------------------------------------------------------------------------------- -Informativa sulla privacy | Riporta uso improprio +Politica della privacy e termini d'uso [${legal}] · Segnala Uso Scorretto +[${misuse}] +${copyright}. TUTTI I DIRITTI RISERVATI. \ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/it/user/email/verification-delete-team-subject.txt b/services/brig/deb/opt/brig/templates/it/user/email/verification-delete-team-subject.txt new file mode 100644 index 00000000000..5687c98820a --- /dev/null +++ b/services/brig/deb/opt/brig/templates/it/user/email/verification-delete-team-subject.txt @@ -0,0 +1 @@ +your ${brand} verification code is ${code} \ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/it/user/email/verification-delete-team.html b/services/brig/deb/opt/brig/templates/it/user/email/verification-delete-team.html new file mode 100644 index 00000000000..9d099da8265 --- /dev/null +++ b/services/brig/deb/opt/brig/templates/it/user/email/verification-delete-team.html @@ -0,0 +1 @@ +your ${brand} verification code is ${code}

${brand_label_url}

Verify team deletion

${email} was used to delete your ${brand} team. Enter this code to verify your email and delete the team.

 

${code}

 

Se hai domande, per favore contattaci.

Politica della privacy e termini d'uso · Segnala Uso Scorretto
${copyright}. TUTTI I DIRITTI RISERVATI.

                                                           
\ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/it/user/email/verification-delete-team.txt b/services/brig/deb/opt/brig/templates/it/user/email/verification-delete-team.txt new file mode 100644 index 00000000000..5293c564913 --- /dev/null +++ b/services/brig/deb/opt/brig/templates/it/user/email/verification-delete-team.txt @@ -0,0 +1,18 @@ +[${brand_logo}] + +${brand_label_url} [${brand_url}] + +VERIFY TEAM DELETION +${email} was used to delete your ${brand} team. Enter this code to verify your +email and delete the team. + +${code} + +Se hai domande, per favore contattaci [${support}]. + + +-------------------------------------------------------------------------------- + +Politica della privacy e termini d'uso [${legal}] · Segnala Uso Scorretto +[${misuse}] +${copyright}. TUTTI I DIRITTI RISERVATI. \ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/it/user/email/verification-login-subject.txt b/services/brig/deb/opt/brig/templates/it/user/email/verification-login-subject.txt new file mode 100644 index 00000000000..5687c98820a --- /dev/null +++ b/services/brig/deb/opt/brig/templates/it/user/email/verification-login-subject.txt @@ -0,0 +1 @@ +your ${brand} verification code is ${code} \ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/it/user/email/verification-login.html b/services/brig/deb/opt/brig/templates/it/user/email/verification-login.html new file mode 100644 index 00000000000..014585c62a7 --- /dev/null +++ b/services/brig/deb/opt/brig/templates/it/user/email/verification-login.html @@ -0,0 +1 @@ +your ${brand} verification code is ${code}

${brand_label_url}

Verify login

${email} was used to log in to your ${brand} account. Enter this code to verify your email and log in.

 

${code}

 

Se hai domande, per favore contattaci.

Politica della privacy e termini d'uso · Segnala Uso Scorretto
${copyright}. TUTTI I DIRITTI RISERVATI.

                                                           
\ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/it/user/email/verification-login.txt b/services/brig/deb/opt/brig/templates/it/user/email/verification-login.txt new file mode 100644 index 00000000000..2d7e2ec5b76 --- /dev/null +++ b/services/brig/deb/opt/brig/templates/it/user/email/verification-login.txt @@ -0,0 +1,18 @@ +[${brand_logo}] + +${brand_label_url} [${brand_url}] + +VERIFY LOGIN +${email} was used to log in to your ${brand} account. Enter this code to verify +your email and log in. + +${code} + +Se hai domande, per favore contattaci [${support}]. + + +-------------------------------------------------------------------------------- + +Politica della privacy e termini d'uso [${legal}] · Segnala Uso Scorretto +[${misuse}] +${copyright}. TUTTI I DIRITTI RISERVATI. \ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/it/user/email/verification-scim-token-subject.txt b/services/brig/deb/opt/brig/templates/it/user/email/verification-scim-token-subject.txt new file mode 100644 index 00000000000..5687c98820a --- /dev/null +++ b/services/brig/deb/opt/brig/templates/it/user/email/verification-scim-token-subject.txt @@ -0,0 +1 @@ +your ${brand} verification code is ${code} \ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/it/user/email/verification-scim-token.html b/services/brig/deb/opt/brig/templates/it/user/email/verification-scim-token.html new file mode 100644 index 00000000000..b2d7b090237 --- /dev/null +++ b/services/brig/deb/opt/brig/templates/it/user/email/verification-scim-token.html @@ -0,0 +1 @@ +your ${brand} verification code is ${code}

${brand_label_url}

Verify SCIM token creation

${email} was used to generate a SCIM token. Enter this code to verify your email and create the token.

 

${code}

 

Se hai domande, per favore contattaci.

Politica della privacy e termini d'uso · Segnala Uso Scorretto
${copyright}. TUTTI I DIRITTI RISERVATI.

                                                           
\ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/it/user/email/verification-scim-token.txt b/services/brig/deb/opt/brig/templates/it/user/email/verification-scim-token.txt new file mode 100644 index 00000000000..cf612bd7469 --- /dev/null +++ b/services/brig/deb/opt/brig/templates/it/user/email/verification-scim-token.txt @@ -0,0 +1,18 @@ +[${brand_logo}] + +${brand_label_url} [${brand_url}] + +VERIFY SCIM TOKEN CREATION +${email} was used to generate a SCIM token. Enter this code to verify your email +and create the token. + +${code} + +Se hai domande, per favore contattaci [${support}]. + + +-------------------------------------------------------------------------------- + +Politica della privacy e termini d'uso [${legal}] · Segnala Uso Scorretto +[${misuse}] +${copyright}. TUTTI I DIRITTI RISERVATI. \ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/it/user/email/verification-subject.txt b/services/brig/deb/opt/brig/templates/it/user/email/verification-subject.txt new file mode 100644 index 00000000000..5a3fa40b37d --- /dev/null +++ b/services/brig/deb/opt/brig/templates/it/user/email/verification-subject.txt @@ -0,0 +1 @@ +${code} è il tuo codice di verifica di ${brand} \ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/it/user/email/verification.html b/services/brig/deb/opt/brig/templates/it/user/email/verification.html index de0cfba18bb..3d3cbb53001 100644 --- a/services/brig/deb/opt/brig/templates/it/user/email/verification.html +++ b/services/brig/deb/opt/brig/templates/it/user/email/verification.html @@ -1,82 +1 @@ - - - - - - - -
- - - - -
-
- - - - - - - - - - - - - - - - - -
- Wire - - wire.com -
-

- Verifica il tuo indirizzo e-mail -

-
-

- ${email} è stato registrato su Wire. Inserisci questo codice per verificare il tuo indirizzo email e creare il tuo account. -

-

- ${code} -

-

- Se non hai richiesto tu questa modifica, puoi ignorare questa email o - - contattaci - . -

-
- Privacy· - Segnala abuso
Wire Swiss GmbH. Tutti i diritti riservati. -
-
-
- - +${code} è il tuo codice di verifica di ${brand}

${brand_label_url}

Verifica la tua email

${email} è stato usato per registrare su ${brand}. Inserisci questo codice per verificare la tua email e creare il tuo profilo.

 

${code}

 

Se hai domande, per favore contattaci.

Politica della privacy e termini d'uso · Segnala Uso Scorretto
${copyright}. TUTTI I DIRITTI RISERVATI.

                                                           
\ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/it/user/email/verification.txt b/services/brig/deb/opt/brig/templates/it/user/email/verification.txt index c99da10a394..11178f64c65 100644 --- a/services/brig/deb/opt/brig/templates/it/user/email/verification.txt +++ b/services/brig/deb/opt/brig/templates/it/user/email/verification.txt @@ -1,18 +1,18 @@ -Wire +[${brand_logo}] +${brand_label_url} [${brand_url}] -Ciao, - -${email} è stato registrato su Wire. Inserisci questo codice per verificare il tuo indirizzo email e creare il tuo account. +VERIFICA LA TUA EMAIL +${email} è stato usato per registrare su ${brand}. Inserisci questo codice per +verificare la tua email e creare il tuo profilo. ${code} -Si prega di non rispondere a questo messaggio. - -Se non sei stato tu a create un account Wire con questa e-mail, si prega di visitare https://support.wire.com - +Se hai domande, per favore contattaci [${support}]. -(c) Wire Swiss GmbH +-------------------------------------------------------------------------------- -Informativa sulla privacy | Riporta uso improprio +Politica della privacy e termini d'uso [${legal}] · Segnala Uso Scorretto +[${misuse}] +${copyright}. TUTTI I DIRITTI RISERVATI. \ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/it/user/sms/activation.txt b/services/brig/deb/opt/brig/templates/it/user/sms/activation.txt index 0c31f4db1a6..2f831a186d0 100644 --- a/services/brig/deb/opt/brig/templates/it/user/sms/activation.txt +++ b/services/brig/deb/opt/brig/templates/it/user/sms/activation.txt @@ -1,3 +1,3 @@ -Il tuo codice per Wire è ${code}. +Il codice del tuo ${brand} è ${code}. -Apri ${url} per verificare il tuo numero o inserisci manualmente il codice in Wire. +Apri ${url} per verificare il tuo numero. diff --git a/services/brig/deb/opt/brig/templates/it/user/sms/deletion.txt b/services/brig/deb/opt/brig/templates/it/user/sms/deletion.txt index 3af6fc6283c..954020d32c8 100644 --- a/services/brig/deb/opt/brig/templates/it/user/sms/deletion.txt +++ b/services/brig/deb/opt/brig/templates/it/user/sms/deletion.txt @@ -1,2 +1,2 @@ -Toccare per eliminare il tuo account di Wire. -${url} +Tocca per eliminare il tuo profilo di ${brand}. +${url} diff --git a/services/brig/deb/opt/brig/templates/it/user/sms/login.txt b/services/brig/deb/opt/brig/templates/it/user/sms/login.txt index 7813739db76..84a0b9861d0 100644 --- a/services/brig/deb/opt/brig/templates/it/user/sms/login.txt +++ b/services/brig/deb/opt/brig/templates/it/user/sms/login.txt @@ -1,3 +1,3 @@ -Il tuo codice di accesso Wire è ${code}. +Il tuo codice di accesso di ${brand} è ${code}. -Apri ${url} per effettuare l'accesso, oppure inserisci questo codice nell'applicazione Wire: ${code}. +Apri ${url} per accedere. diff --git a/services/brig/deb/opt/brig/templates/it/user/sms/password-reset.txt b/services/brig/deb/opt/brig/templates/it/user/sms/password-reset.txt index a9377271184..b9aa4d7a945 100644 --- a/services/brig/deb/opt/brig/templates/it/user/sms/password-reset.txt +++ b/services/brig/deb/opt/brig/templates/it/user/sms/password-reset.txt @@ -1,3 +1,3 @@ -Il codice di recupero password per Wire è ${code}. +Il tuo codice di recupero di ${brand} è ${code}. -Apri Wire e utilizza questo codice per reimpostare la password. \ No newline at end of file +Usa questo codice per completare il ripristino della password. diff --git a/services/brig/deb/opt/brig/templates/ja/user/call/activation.txt b/services/brig/deb/opt/brig/templates/ja/user/call/activation.txt new file mode 100644 index 00000000000..d62a4fa1c53 --- /dev/null +++ b/services/brig/deb/opt/brig/templates/ja/user/call/activation.txt @@ -0,0 +1 @@ +こんにちは、あなたのWire確認コードは、${code} です。 もう一度、あなたのコードは${code} です。 \ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/ja/user/call/login.txt b/services/brig/deb/opt/brig/templates/ja/user/call/login.txt new file mode 100644 index 00000000000..443ac057de1 --- /dev/null +++ b/services/brig/deb/opt/brig/templates/ja/user/call/login.txt @@ -0,0 +1 @@ +こんにちは、あなたのWire確認コードは、${code} です。 もう一度、あなたのコードは ${code} です。 \ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/ja/user/email/activation-subject.txt b/services/brig/deb/opt/brig/templates/ja/user/email/activation-subject.txt new file mode 100644 index 00000000000..fcd089dbc75 --- /dev/null +++ b/services/brig/deb/opt/brig/templates/ja/user/email/activation-subject.txt @@ -0,0 +1 @@ +あなたの ${brand} アカウント \ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/ja/user/email/activation.html b/services/brig/deb/opt/brig/templates/ja/user/email/activation.html new file mode 100644 index 00000000000..5628de34d87 --- /dev/null +++ b/services/brig/deb/opt/brig/templates/ja/user/email/activation.html @@ -0,0 +1 @@ +あなたの ${brand} アカウント

${brand_label_url}

メールアドレス認証

${email} は、${brand} への登録に使用されました。
ボタンをクリックしてメールアドレスの認証を行ってください。

 
認証
 

ボタンをクリックできない場合は、以下のリンクをブラウザにコピー＆ペーストして下さい。

${url}

ご不明な点がございましたら、 こちら から私たちにご連絡ください。

プライバシーポリシーと利用規約 · 不具合を報告する
${copyright}. ALL RIGHTS RESERVED.

                                                           
\ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/ja/user/email/activation.txt b/services/brig/deb/opt/brig/templates/ja/user/email/activation.txt new file mode 100644 index 00000000000..9b1e2f77f15 --- /dev/null +++ b/services/brig/deb/opt/brig/templates/ja/user/email/activation.txt @@ -0,0 +1,19 @@ +[${brand_logo}] + +${brand_label_url} [${brand_url}] + +メールアドレス認証 +${email} は、${brand} への登録に使用されました。 +ボタンをクリックしてメールアドレスの認証を行ってください。 + +認証 [${url}]ボタンをクリックできない場合は、以下のリンクをブラウザにコピー＆ペーストして下さい。 + +${url} + +ご不明な点がございましたら、 こちら [${support}] から私たちにご連絡ください。 + + +-------------------------------------------------------------------------------- + +プライバシーポリシーと利用規約 [${legal}] · 不具合を報告する [${misuse}] +${copyright}. ALL RIGHTS RESERVED. \ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/ja/user/email/deletion-subject.txt b/services/brig/deb/opt/brig/templates/ja/user/email/deletion-subject.txt new file mode 100644 index 00000000000..e030ffada01 --- /dev/null +++ b/services/brig/deb/opt/brig/templates/ja/user/email/deletion-subject.txt @@ -0,0 +1 @@ +アカウントを削除しますか？ \ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/ja/user/email/deletion.html b/services/brig/deb/opt/brig/templates/ja/user/email/deletion.html new file mode 100644 index 00000000000..72e2c8d9330 --- /dev/null +++ b/services/brig/deb/opt/brig/templates/ja/user/email/deletion.html @@ -0,0 +1 @@ +アカウントを削除しますか？

${brand_label_url}

アカウントを削除

あなたの ${brand} アカウントの削除リクエストを受け付けました。 あなたのすべての会話、コンテンツ、友人を削除するには10分以内に下記のリンクをクリックしてください。

 
アカウント削除
 

ボタンをクリックできない場合は、以下のリンクをブラウザにコピー＆ペーストして下さい。

${url}

あなたがこのリクエスト行っていない場合は、パスワードをリセットしてください。

ご不明な点がございましたら、 こちら から私たちにご連絡ください。

プライバシーポリシーと利用規約 · 不具合を報告する
${copyright}. ALL RIGHTS RESERVED.

                                                           
\ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/ja/user/email/deletion.txt b/services/brig/deb/opt/brig/templates/ja/user/email/deletion.txt new file mode 100644 index 00000000000..d11c0c14f8c --- /dev/null +++ b/services/brig/deb/opt/brig/templates/ja/user/email/deletion.txt @@ -0,0 +1,21 @@ +[${brand_logo}] + +${brand_label_url} [${brand_url}] + +アカウントを削除 +あなたの ${brand} アカウントの削除リクエストを受け付けました。 +あなたのすべての会話、コンテンツ、友人を削除するには10分以内に下記のリンクをクリックしてください。 + +アカウント削除 [${url}]ボタンをクリックできない場合は、以下のリンクをブラウザにコピー＆ペーストして下さい。 + +${url} + +あなたがこのリクエスト行っていない場合は、パスワードをリセット [${forgot}]してください。 + +ご不明な点がございましたら、 こちら [${support}] から私たちにご連絡ください。 + + +-------------------------------------------------------------------------------- + +プライバシーポリシーと利用規約 [${legal}] · 不具合を報告する [${misuse}] +${copyright}. ALL RIGHTS RESERVED. \ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/ja/user/email/new-client-subject.txt b/services/brig/deb/opt/brig/templates/ja/user/email/new-client-subject.txt new file mode 100644 index 00000000000..da91008b882 --- /dev/null +++ b/services/brig/deb/opt/brig/templates/ja/user/email/new-client-subject.txt @@ -0,0 +1 @@ +新しいデバイス \ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/ja/user/email/new-client.html b/services/brig/deb/opt/brig/templates/ja/user/email/new-client.html new file mode 100644 index 00000000000..24128ee1a17 --- /dev/null +++ b/services/brig/deb/opt/brig/templates/ja/user/email/new-client.html @@ -0,0 +1 @@ +新しいデバイス

${brand_label_url}

新しいデバイス

あなたの ${brand} アカウントが使用されました:

${date}

${model}

新しいデバイスに ${brand} がインストールされたか、既存のデバイスに再インストールされました。 この操作をあなたが行っていない場合は、 ${brand} の設定に移動し、デバイスを削除し、パスワードをリセットしてください。

ご不明な点がございましたら、 こちら から私たちにご連絡ください。

プライバシーポリシーと利用規約 · 不具合を報告する
${copyright}. ALL RIGHTS RESERVED.

                                                           
\ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/ja/user/email/new-client.txt b/services/brig/deb/opt/brig/templates/ja/user/email/new-client.txt new file mode 100644 index 00000000000..b2f1534c245 --- /dev/null +++ b/services/brig/deb/opt/brig/templates/ja/user/email/new-client.txt @@ -0,0 +1,21 @@ +[${brand_logo}] + +${brand_label_url} [${brand_url}] + +新しいデバイス +あなたの ${brand} アカウントが使用されました: + +${date} + +${model} + +新しいデバイスに ${brand} がインストールされたか、既存のデバイスに再インストールされました。 この操作をあなたが行っていない場合は、 ${brand} +の設定に移動し、デバイスを削除し、パスワードをリセット [${forgot}]してください。 + +ご不明な点がございましたら、 こちら [${support}] から私たちにご連絡ください。 + + +-------------------------------------------------------------------------------- + +プライバシーポリシーと利用規約 [${legal}] · 不具合を報告する [${misuse}] +${copyright}. ALL RIGHTS RESERVED. \ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/ja/user/email/password-reset-subject.txt b/services/brig/deb/opt/brig/templates/ja/user/email/password-reset-subject.txt new file mode 100644 index 00000000000..bf4a5a46ae3 --- /dev/null +++ b/services/brig/deb/opt/brig/templates/ja/user/email/password-reset-subject.txt @@ -0,0 +1 @@ +${brand} でのパスワードリセット \ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/ja/user/email/password-reset.html b/services/brig/deb/opt/brig/templates/ja/user/email/password-reset.html new file mode 100644 index 00000000000..eb0d59f2aa7 --- /dev/null +++ b/services/brig/deb/opt/brig/templates/ja/user/email/password-reset.html @@ -0,0 +1 @@ +${brand} でのパスワードリセット

${brand_label_url}

パスワードリセット

${brand} アカウントのパスワードをリセット要求を受け取りました。 新しいパスワードを作成するには、以下のボタンをクリックしてください。

 
パスワードリセット
 

ボタンをクリックできない場合は、以下のリンクをブラウザにコピー＆ペーストして下さい。

${url}

ご不明な点がございましたら、 こちら から私たちにご連絡ください。

プライバシーポリシーと利用規約 · 不具合を報告する
${copyright}. ALL RIGHTS RESERVED.

                                                           
\ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/ja/user/email/password-reset.txt b/services/brig/deb/opt/brig/templates/ja/user/email/password-reset.txt new file mode 100644 index 00000000000..0ffdc49b479 --- /dev/null +++ b/services/brig/deb/opt/brig/templates/ja/user/email/password-reset.txt @@ -0,0 +1,18 @@ +[${brand_logo}] + +${brand_label_url} [${brand_url}] + +パスワードリセット +${brand} アカウントのパスワードをリセット要求を受け取りました。 新しいパスワードを作成するには、以下のボタンをクリックしてください。 + +パスワードリセット [${url}]ボタンをクリックできない場合は、以下のリンクをブラウザにコピー＆ペーストして下さい。 + +${url} + +ご不明な点がございましたら、 こちら [${support}] から私たちにご連絡ください。 + + +-------------------------------------------------------------------------------- + +プライバシーポリシーと利用規約 [${legal}] · 不具合を報告する [${misuse}] +${copyright}. ALL RIGHTS RESERVED. \ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/ja/user/email/team-activation-subject.txt b/services/brig/deb/opt/brig/templates/ja/user/email/team-activation-subject.txt new file mode 100644 index 00000000000..a63d219cb43 --- /dev/null +++ b/services/brig/deb/opt/brig/templates/ja/user/email/team-activation-subject.txt @@ -0,0 +1 @@ +${brand} アカウント \ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/ja/user/email/team-activation.html b/services/brig/deb/opt/brig/templates/ja/user/email/team-activation.html new file mode 100644 index 00000000000..63c73884208 --- /dev/null +++ b/services/brig/deb/opt/brig/templates/ja/user/email/team-activation.html @@ -0,0 +1 @@ +${brand} アカウント

${brand_label_url}

あなたの新しい ${brand} アカウント

新しい ${brand} チーム が、 ${email} によって作成されました。 メールアドレスの認証をお願いします。

 
認証
 

ボタンをクリックできない場合は、以下のリンクをブラウザにコピー＆ペーストして下さい。

${url}

ご不明な点がございましたら、 こちら から私たちにご連絡ください。

プライバシーポリシーと利用規約 · 不具合を報告する
${copyright}. ALL RIGHTS RESERVED.

                                                           
\ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/ja/user/email/team-activation.txt b/services/brig/deb/opt/brig/templates/ja/user/email/team-activation.txt new file mode 100644 index 00000000000..89248d20a57 --- /dev/null +++ b/services/brig/deb/opt/brig/templates/ja/user/email/team-activation.txt @@ -0,0 +1,18 @@ +[${brand_logo}] + +${brand_label_url} [${brand_url}] + +あなたの新しい ${brand} アカウント +新しい ${brand} チーム が、 ${email} によって作成されました。 メールアドレスの認証をお願いします。 + +認証 [${url}]ボタンをクリックできない場合は、以下のリンクをブラウザにコピー＆ペーストして下さい。 + +${url} + +ご不明な点がございましたら、 こちら [${support}] から私たちにご連絡ください。 + + +-------------------------------------------------------------------------------- + +プライバシーポリシーと利用規約 [${legal}] · 不具合を報告する [${misuse}] +${copyright}. ALL RIGHTS RESERVED. \ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/ja/user/email/update-subject.txt b/services/brig/deb/opt/brig/templates/ja/user/email/update-subject.txt new file mode 100644 index 00000000000..24791817316 --- /dev/null +++ b/services/brig/deb/opt/brig/templates/ja/user/email/update-subject.txt @@ -0,0 +1 @@ +${brand} での新しいメールアドレス \ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/ja/user/email/update.html b/services/brig/deb/opt/brig/templates/ja/user/email/update.html new file mode 100644 index 00000000000..8a0b25f9a3f --- /dev/null +++ b/services/brig/deb/opt/brig/templates/ja/user/email/update.html @@ -0,0 +1 @@ +${brand} での新しいメールアドレス

${brand_label_url}

メールアドレス認証

${email} は、 ${brand} で新しいメールアドレスとして登録されました。 新しいメールアドレスを認証するために下のボタンをクリックしてください。

 
認証
 

ボタンをクリックできない場合は、以下のリンクをブラウザにコピー＆ペーストして下さい。

${url}

ご不明な点がございましたら、 こちら から私たちにご連絡ください。

プライバシーポリシーと利用規約 · 不具合を報告する
${copyright}. ALL RIGHTS RESERVED.

                                                           
\ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/ja/user/email/update.txt b/services/brig/deb/opt/brig/templates/ja/user/email/update.txt new file mode 100644 index 00000000000..bb5992939f7 --- /dev/null +++ b/services/brig/deb/opt/brig/templates/ja/user/email/update.txt @@ -0,0 +1,18 @@ +[${brand_logo}] + +${brand_label_url} [${brand_url}] + +メールアドレス認証 +${email} は、 ${brand} で新しいメールアドレスとして登録されました。 新しいメールアドレスを認証するために下のボタンをクリックしてください。 + +認証 [${url}]ボタンをクリックできない場合は、以下のリンクをブラウザにコピー＆ペーストして下さい。 + +${url} + +ご不明な点がございましたら、 こちら [${support}] から私たちにご連絡ください。 + + +-------------------------------------------------------------------------------- + +プライバシーポリシーと利用規約 [${legal}] · 不具合を報告する [${misuse}] +${copyright}. ALL RIGHTS RESERVED. \ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/ja/user/email/verification-delete-team-subject.txt b/services/brig/deb/opt/brig/templates/ja/user/email/verification-delete-team-subject.txt new file mode 100644 index 00000000000..5687c98820a --- /dev/null +++ b/services/brig/deb/opt/brig/templates/ja/user/email/verification-delete-team-subject.txt @@ -0,0 +1 @@ +your ${brand} verification code is ${code} \ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/ja/user/email/verification-delete-team.html b/services/brig/deb/opt/brig/templates/ja/user/email/verification-delete-team.html new file mode 100644 index 00000000000..9a9c81ac516 --- /dev/null +++ b/services/brig/deb/opt/brig/templates/ja/user/email/verification-delete-team.html @@ -0,0 +1 @@ +your ${brand} verification code is ${code}

${brand_label_url}

Verify team deletion

${email} was used to delete your ${brand} team. Enter this code to verify your email and delete the team.

 

${code}

 

ご不明な点がございましたら、 こちら から私たちにご連絡ください。

プライバシーポリシーと利用規約 · 不具合を報告する
${copyright}. ALL RIGHTS RESERVED.

                                                           
\ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/ja/user/email/verification-delete-team.txt b/services/brig/deb/opt/brig/templates/ja/user/email/verification-delete-team.txt new file mode 100644 index 00000000000..6f673d386d8 --- /dev/null +++ b/services/brig/deb/opt/brig/templates/ja/user/email/verification-delete-team.txt @@ -0,0 +1,17 @@ +[${brand_logo}] + +${brand_label_url} [${brand_url}] + +VERIFY TEAM DELETION +${email} was used to delete your ${brand} team. Enter this code to verify your +email and delete the team. + +${code} + +ご不明な点がございましたら、 こちら [${support}] から私たちにご連絡ください。 + + +-------------------------------------------------------------------------------- + +プライバシーポリシーと利用規約 [${legal}] · 不具合を報告する [${misuse}] +${copyright}. ALL RIGHTS RESERVED. \ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/ja/user/email/verification-login-subject.txt b/services/brig/deb/opt/brig/templates/ja/user/email/verification-login-subject.txt new file mode 100644 index 00000000000..5687c98820a --- /dev/null +++ b/services/brig/deb/opt/brig/templates/ja/user/email/verification-login-subject.txt @@ -0,0 +1 @@ +your ${brand} verification code is ${code} \ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/ja/user/email/verification-login.html b/services/brig/deb/opt/brig/templates/ja/user/email/verification-login.html new file mode 100644 index 00000000000..48333dcccb1 --- /dev/null +++ b/services/brig/deb/opt/brig/templates/ja/user/email/verification-login.html @@ -0,0 +1 @@ +your ${brand} verification code is ${code}

${brand_label_url}

Verify login

${email} was used to log in to your ${brand} account. Enter this code to verify your email and log in.

 

${code}

 

ご不明な点がございましたら、 こちら から私たちにご連絡ください。

プライバシーポリシーと利用規約 · 不具合を報告する
${copyright}. ALL RIGHTS RESERVED.

                                                           
\ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/ja/user/email/verification-login.txt b/services/brig/deb/opt/brig/templates/ja/user/email/verification-login.txt new file mode 100644 index 00000000000..7ae51ead2c9 --- /dev/null +++ b/services/brig/deb/opt/brig/templates/ja/user/email/verification-login.txt @@ -0,0 +1,17 @@ +[${brand_logo}] + +${brand_label_url} [${brand_url}] + +VERIFY LOGIN +${email} was used to log in to your ${brand} account. Enter this code to verify +your email and log in. + +${code} + +ご不明な点がございましたら、 こちら [${support}] から私たちにご連絡ください。 + + +-------------------------------------------------------------------------------- + +プライバシーポリシーと利用規約 [${legal}] · 不具合を報告する [${misuse}] +${copyright}. ALL RIGHTS RESERVED. \ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/ja/user/email/verification-scim-token-subject.txt b/services/brig/deb/opt/brig/templates/ja/user/email/verification-scim-token-subject.txt new file mode 100644 index 00000000000..5687c98820a --- /dev/null +++ b/services/brig/deb/opt/brig/templates/ja/user/email/verification-scim-token-subject.txt @@ -0,0 +1 @@ +your ${brand} verification code is ${code} \ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/ja/user/email/verification-scim-token.html b/services/brig/deb/opt/brig/templates/ja/user/email/verification-scim-token.html new file mode 100644 index 00000000000..25b1ba5e8a2 --- /dev/null +++ b/services/brig/deb/opt/brig/templates/ja/user/email/verification-scim-token.html @@ -0,0 +1 @@ +your ${brand} verification code is ${code}

${brand_label_url}

Verify SCIM token creation

${email} was used to generate a SCIM token. Enter this code to verify your email and create the token.

 

${code}

 

ご不明な点がございましたら、 こちら から私たちにご連絡ください。

プライバシーポリシーと利用規約 · 不具合を報告する
${copyright}. ALL RIGHTS RESERVED.

                                                           
\ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/ja/user/email/verification-scim-token.txt b/services/brig/deb/opt/brig/templates/ja/user/email/verification-scim-token.txt new file mode 100644 index 00000000000..4dca3b84b5e --- /dev/null +++ b/services/brig/deb/opt/brig/templates/ja/user/email/verification-scim-token.txt @@ -0,0 +1,17 @@ +[${brand_logo}] + +${brand_label_url} [${brand_url}] + +VERIFY SCIM TOKEN CREATION +${email} was used to generate a SCIM token. Enter this code to verify your email +and create the token. + +${code} + +ご不明な点がございましたら、 こちら [${support}] から私たちにご連絡ください。 + + +-------------------------------------------------------------------------------- + +プライバシーポリシーと利用規約 [${legal}] · 不具合を報告する [${misuse}] +${copyright}. ALL RIGHTS RESERVED. \ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/ja/user/email/verification-subject.txt b/services/brig/deb/opt/brig/templates/ja/user/email/verification-subject.txt new file mode 100644 index 00000000000..5120622e6d1 --- /dev/null +++ b/services/brig/deb/opt/brig/templates/ja/user/email/verification-subject.txt @@ -0,0 +1 @@ +あなたの ${brand} の認証コードは ${code} です \ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/ja/user/email/verification.html b/services/brig/deb/opt/brig/templates/ja/user/email/verification.html new file mode 100644 index 00000000000..5e1a1781025 --- /dev/null +++ b/services/brig/deb/opt/brig/templates/ja/user/email/verification.html @@ -0,0 +1 @@ +あなたの ${brand} の認証コードは ${code} です

${brand_label_url}

メールアドレス認証

${email} が ${brand} に登録するために使用されました。 下記コードを入力することでメールアドレスを認証し、アカウントを作成します。

 

${code}

 

ご不明な点がございましたら、 こちら から私たちにご連絡ください。

プライバシーポリシーと利用規約 · 不具合を報告する
${copyright}. ALL RIGHTS RESERVED.

                                                           
\ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/ja/user/email/verification.txt b/services/brig/deb/opt/brig/templates/ja/user/email/verification.txt new file mode 100644 index 00000000000..9758e4a82c4 --- /dev/null +++ b/services/brig/deb/opt/brig/templates/ja/user/email/verification.txt @@ -0,0 +1,16 @@ +[${brand_logo}] + +${brand_label_url} [${brand_url}] + +メールアドレス認証 +${email} が ${brand} に登録するために使用されました。 下記コードを入力することでメールアドレスを認証し、アカウントを作成します。 + +${code} + +ご不明な点がございましたら、 こちら [${support}] から私たちにご連絡ください。 + + +-------------------------------------------------------------------------------- + +プライバシーポリシーと利用規約 [${legal}] · 不具合を報告する [${misuse}] +${copyright}. ALL RIGHTS RESERVED. \ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/ja/user/sms/activation.txt b/services/brig/deb/opt/brig/templates/ja/user/sms/activation.txt new file mode 100644 index 00000000000..5b27432624a --- /dev/null +++ b/services/brig/deb/opt/brig/templates/ja/user/sms/activation.txt @@ -0,0 +1,3 @@ +あなたの ${brand} の ログインコードは ${code} です + +${url} を開いて、あなたの番号を認証してください。 diff --git a/services/brig/deb/opt/brig/templates/ja/user/sms/deletion.txt b/services/brig/deb/opt/brig/templates/ja/user/sms/deletion.txt new file mode 100644 index 00000000000..f552addbd5c --- /dev/null +++ b/services/brig/deb/opt/brig/templates/ja/user/sms/deletion.txt @@ -0,0 +1,2 @@ +タップして、あなたの ${brand} のアカウントを削除します +${url} diff --git a/services/brig/deb/opt/brig/templates/ja/user/sms/login.txt b/services/brig/deb/opt/brig/templates/ja/user/sms/login.txt new file mode 100644 index 00000000000..ac0ec8b47d1 --- /dev/null +++ b/services/brig/deb/opt/brig/templates/ja/user/sms/login.txt @@ -0,0 +1,3 @@ +あなたの ${brand} ログインコードは ${code} です + +${url} を開いて、ログインしてください。 diff --git a/services/brig/deb/opt/brig/templates/ja/user/sms/password-reset.txt b/services/brig/deb/opt/brig/templates/ja/user/sms/password-reset.txt new file mode 100644 index 00000000000..9476d182cb1 --- /dev/null +++ b/services/brig/deb/opt/brig/templates/ja/user/sms/password-reset.txt @@ -0,0 +1,3 @@ +あなたの ${brand} の リカバリーコードは ${code} です。 + +このコードを使ってパスワードのリセットを完了してください。 diff --git a/services/brig/deb/opt/brig/templates/lt/user/email/activation.html b/services/brig/deb/opt/brig/templates/lt/user/email/activation.html index 59e25e0789b..1fb608768bc 100644 --- a/services/brig/deb/opt/brig/templates/lt/user/email/activation.html +++ b/services/brig/deb/opt/brig/templates/lt/user/email/activation.html @@ -1 +1 @@ -Jūsų „${brand}“ paskyra

${brand_label_url}

Patvirtinkite savo el. paštą

${email} buvo panaudotas, registruojantis „${brand}“.
Norėdami patvirtinti savo adresą, spustelėkite mygtuką.

 
Patvirtinti
 

Jeigu negalite spustelėti ant mygtuko, nukopijuokite ir įdėkite šią nuorodą į savo naršyklę:

${url}

Jei turite klausimų, susisiekite su mumis.

Privatumo politika ir naudojimosi sąlygos · Pranešti apie piktnaudžiavimą
${copyright}. VISOS TEISĖS SAUGOMOS.

                                                           
\ No newline at end of file +Jūsų „${brand}“ paskyra

${brand_label_url}

Patvirtinkite savo el. paštą

${email} buvo panaudotas, registruojantis „${brand}“.
Norėdami patvirtinti savo adresą, spustelėkite mygtuką.

 
Patvirtinti
 

Jeigu negalite spustelėti ant mygtuko, nukopijuokite ir įdėkite šią nuorodą į savo naršyklę:

${url}

Jei turite klausimų, susisiekite su mumis.

Privatumo politika ir naudojimosi sąlygos · Pranešti apie piktnaudžiavimą
${copyright}. VISOS TEISĖS SAUGOMOS.

                                                           
\ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/lt/user/email/deletion.html b/services/brig/deb/opt/brig/templates/lt/user/email/deletion.html index 44e0623b218..21df982477e 100644 --- a/services/brig/deb/opt/brig/templates/lt/user/email/deletion.html +++ b/services/brig/deb/opt/brig/templates/lt/user/email/deletion.html @@ -1 +1 @@ -Ištrinti paskyrą?

${brand_label_url}

Ištrinti jūsų paskyrą

Mes gavome užklausą ištrinti jūsų ${brand} paskyrą. Norėdami ištrinti visus savo pokalbius, visą turinį ir ryšius, 10 minučių bėgyje spustelėkite žemiau esantį mygtuką.

 
Ištrinti paskyrą
 

Jeigu negalite spustelėti ant mygtuko, nukopijuokite ir įdėkite šią nuorodą į savo naršyklę:

${url}

Jeigu jūs nebuvote to užklausę, atstatykite savo slaptažodį.

Jei turite klausimų, susisiekite su mumis.

Privatumo politika ir naudojimosi sąlygos · Pranešti apie piktnaudžiavimą
${copyright}. VISOS TEISĖS SAUGOMOS.

                                                           
\ No newline at end of file +Ištrinti paskyrą?

${brand_label_url}

Ištrinti jūsų paskyrą

Mes gavome užklausą ištrinti jūsų ${brand} paskyrą. Norėdami ištrinti visus savo pokalbius, visą turinį ir ryšius, 10 minučių bėgyje spustelėkite žemiau esantį mygtuką.

 
Ištrinti paskyrą
 

Jeigu negalite spustelėti ant mygtuko, nukopijuokite ir įdėkite šią nuorodą į savo naršyklę:

${url}

Jeigu jūs nebuvote to užklausę, atstatykite savo slaptažodį.

Jei turite klausimų, susisiekite su mumis.

Privatumo politika ir naudojimosi sąlygos · Pranešti apie piktnaudžiavimą
${copyright}. VISOS TEISĖS SAUGOMOS.

                                                           
\ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/lt/user/email/new-client.html b/services/brig/deb/opt/brig/templates/lt/user/email/new-client.html index ba553e5075a..ca0b70954a3 100644 --- a/services/brig/deb/opt/brig/templates/lt/user/email/new-client.html +++ b/services/brig/deb/opt/brig/templates/lt/user/email/new-client.html @@ -1 +1 @@ -Naujas įrenginys

${brand_label_url}

Naujas įrenginys

Jūsų „${brand}“ paskyra buvo naudota:

${date}

${model}

Tikriausiai įdiegėte „${brand}“ naujame įrenginyje arba įdiegėte iš naujo esančiame įrenginyje. Jei to nedarėte, eikit į „${brand}“ nustatymus, pašalinkite įrenginį ir pakeiskite savo slaptažodį.

Jei turite klausimų, susisiekite su mumis.

Privatumo politika ir naudojimosi sąlygos · Pranešti apie piktnaudžiavimą
${copyright}. VISOS TEISĖS SAUGOMOS.

                                                           
\ No newline at end of file +Naujas įrenginys

${brand_label_url}

Naujas įrenginys

Jūsų „${brand}“ paskyra buvo naudota:

${date}

${model}

Tikriausiai įdiegėte „${brand}“ naujame įrenginyje arba įdiegėte iš naujo esančiame įrenginyje. Jei to nedarėte, eikit į „${brand}“ nustatymus, pašalinkite įrenginį ir pakeiskite savo slaptažodį.

Jei turite klausimų, susisiekite su mumis.

Privatumo politika ir naudojimosi sąlygos · Pranešti apie piktnaudžiavimą
${copyright}. VISOS TEISĖS SAUGOMOS.

                                                           
\ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/lt/user/email/password-reset.html b/services/brig/deb/opt/brig/templates/lt/user/email/password-reset.html index a0d060b3307..1345946ca57 100644 --- a/services/brig/deb/opt/brig/templates/lt/user/email/password-reset.html +++ b/services/brig/deb/opt/brig/templates/lt/user/email/password-reset.html @@ -1 +1 @@ -„${brand}“ slaptažodžio pakeitimas

${brand_label_url}

Atstatyti jūsų slaptažodį

Gavome užklausą atstatyti jūsų ${brand} paskyros slaptažodį. Norėdami susikurti naują slaptažodį, spustelėkite mygtuką žemiau.

 
Atstatyti slaptažodį
 

Jeigu negalite spustelėti ant mygtuko, nukopijuokite ir įdėkite šią nuorodą į savo naršyklę:

${url}

Jei turite klausimų, susisiekite su mumis.

Privatumo politika ir naudojimosi sąlygos · Pranešti apie piktnaudžiavimą
${copyright}. VISOS TEISĖS SAUGOMOS.

                                                           
\ No newline at end of file +„${brand}“ slaptažodžio pakeitimas

${brand_label_url}

Atstatyti jūsų slaptažodį

Gavome užklausą atstatyti jūsų ${brand} paskyros slaptažodį. Norėdami susikurti naują slaptažodį, spustelėkite mygtuką žemiau.

 
Atstatyti slaptažodį
 

Jeigu negalite spustelėti ant mygtuko, nukopijuokite ir įdėkite šią nuorodą į savo naršyklę:

${url}

Jei turite klausimų, susisiekite su mumis.

Privatumo politika ir naudojimosi sąlygos · Pranešti apie piktnaudžiavimą
${copyright}. VISOS TEISĖS SAUGOMOS.

                                                           
\ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/lt/user/email/team-activation.html b/services/brig/deb/opt/brig/templates/lt/user/email/team-activation.html index d4b08309330..66def145ce8 100644 --- a/services/brig/deb/opt/brig/templates/lt/user/email/team-activation.html +++ b/services/brig/deb/opt/brig/templates/lt/user/email/team-activation.html @@ -1 +1 @@ -„${brand}“ paskyra

${brand_label_url}

Jūsų nauja „${brand}“ paskyra

Naudojant ${email}, buvo sukurta nauja „${brand}“ komanda. Patvirtinkite savo el. paštą.

 
Patvirtinti
 

Jeigu negalite spustelėti ant mygtuko, nukopijuokite ir įdėkite šią nuorodą į savo naršyklę:

${url}

Jei turite klausimų, susisiekite su mumis.

Privatumo politika ir naudojimosi sąlygos · Pranešti apie piktnaudžiavimą
${copyright}. VISOS TEISĖS SAUGOMOS.

                                                           
\ No newline at end of file +„${brand}“ paskyra

${brand_label_url}

Jūsų nauja „${brand}“ paskyra

Naudojant ${email}, buvo sukurta nauja „${brand}“ komanda. Patvirtinkite savo el. paštą.

 
Patvirtinti
 

Jeigu negalite spustelėti ant mygtuko, nukopijuokite ir įdėkite šią nuorodą į savo naršyklę:

${url}

Jei turite klausimų, susisiekite su mumis.

Privatumo politika ir naudojimosi sąlygos · Pranešti apie piktnaudžiavimą
${copyright}. VISOS TEISĖS SAUGOMOS.

                                                           
\ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/lt/user/email/update.html b/services/brig/deb/opt/brig/templates/lt/user/email/update.html index 481a59e184c..e7bc8d4a286 100644 --- a/services/brig/deb/opt/brig/templates/lt/user/email/update.html +++ b/services/brig/deb/opt/brig/templates/lt/user/email/update.html @@ -1 +1 @@ -Jūsų naujas „${brand}“ el. pašto adresas

${brand_label_url}

Patvirtinkite savo el. paštą

${email} buvo užregistruotas kaip naujas „${brand}“ el. pašto adresas. Norėdami patvirtinti savo adresą, spustelėkite mygtuką žemiau.

 
Patvirtinti
 

Jeigu negalite spustelėti ant mygtuko, nukopijuokite ir įdėkite šią nuorodą į savo naršyklę:

${url}

Jei turite klausimų, susisiekite su mumis.

Privatumo politika ir naudojimosi sąlygos · Pranešti apie piktnaudžiavimą
${copyright}. VISOS TEISĖS SAUGOMOS.

                                                           
\ No newline at end of file +Jūsų naujas „${brand}“ el. pašto adresas

${brand_label_url}

Patvirtinkite savo el. paštą

${email} buvo užregistruotas kaip naujas „${brand}“ el. pašto adresas. Norėdami patvirtinti savo adresą, spustelėkite mygtuką žemiau.

 
Patvirtinti
 

Jeigu negalite spustelėti ant mygtuko, nukopijuokite ir įdėkite šią nuorodą į savo naršyklę:

${url}

Jei turite klausimų, susisiekite su mumis.

Privatumo politika ir naudojimosi sąlygos · Pranešti apie piktnaudžiavimą
${copyright}. VISOS TEISĖS SAUGOMOS.

                                                           
\ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/lt/user/email/verification-delete-team.html b/services/brig/deb/opt/brig/templates/lt/user/email/verification-delete-team.html index 8ea472834af..981cb4403ad 100644 --- a/services/brig/deb/opt/brig/templates/lt/user/email/verification-delete-team.html +++ b/services/brig/deb/opt/brig/templates/lt/user/email/verification-delete-team.html @@ -1 +1 @@ -your ${brand} verification code is ${code}

${brand_label_url}

Verify team deletion

${email} was used to delete your ${brand} team. Enter this code to verify your email and delete the team.

 

${code}

 

Jei turite klausimų, susisiekite su mumis.

Privatumo politika ir naudojimosi sąlygos · Pranešti apie piktnaudžiavimą
${copyright}. VISOS TEISĖS SAUGOMOS.

                                                           
\ No newline at end of file +your ${brand} verification code is ${code}

${brand_label_url}

Verify team deletion

${email} was used to delete your ${brand} team. Enter this code to verify your email and delete the team.

 

${code}

 

Jei turite klausimų, susisiekite su mumis.

Privatumo politika ir naudojimosi sąlygos · Pranešti apie piktnaudžiavimą
${copyright}. VISOS TEISĖS SAUGOMOS.

                                                           
\ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/lt/user/email/verification-login.html b/services/brig/deb/opt/brig/templates/lt/user/email/verification-login.html index 53861c0b635..d43700a8b30 100644 --- a/services/brig/deb/opt/brig/templates/lt/user/email/verification-login.html +++ b/services/brig/deb/opt/brig/templates/lt/user/email/verification-login.html @@ -1 +1 @@ -your ${brand} verification code is ${code}

${brand_label_url}

Verify login

${email} was used to log in to your ${brand} account. Enter this code to verify your email and log in.

 

${code}

 

Jei turite klausimų, susisiekite su mumis.

Privatumo politika ir naudojimosi sąlygos · Pranešti apie piktnaudžiavimą
${copyright}. VISOS TEISĖS SAUGOMOS.

                                                           
\ No newline at end of file +your ${brand} verification code is ${code}

${brand_label_url}

Verify login

${email} was used to log in to your ${brand} account. Enter this code to verify your email and log in.

 

${code}

 

Jei turite klausimų, susisiekite su mumis.

Privatumo politika ir naudojimosi sąlygos · Pranešti apie piktnaudžiavimą
${copyright}. VISOS TEISĖS SAUGOMOS.

                                                           
\ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/lt/user/email/verification-scim-token.html b/services/brig/deb/opt/brig/templates/lt/user/email/verification-scim-token.html index d3efac395db..69397437f15 100644 --- a/services/brig/deb/opt/brig/templates/lt/user/email/verification-scim-token.html +++ b/services/brig/deb/opt/brig/templates/lt/user/email/verification-scim-token.html @@ -1 +1 @@ -your ${brand} verification code is ${code}

${brand_label_url}

Verify SCIM token creation

${email} was used to generate a SCIM token. Enter this code to verify your email and create the token.

 

${code}

 

Jei turite klausimų, susisiekite su mumis.

Privatumo politika ir naudojimosi sąlygos · Pranešti apie piktnaudžiavimą
${copyright}. VISOS TEISĖS SAUGOMOS.

                                                           
\ No newline at end of file +your ${brand} verification code is ${code}

${brand_label_url}

Verify SCIM token creation

${email} was used to generate a SCIM token. Enter this code to verify your email and create the token.

 

${code}

 

Jei turite klausimų, susisiekite su mumis.

Privatumo politika ir naudojimosi sąlygos · Pranešti apie piktnaudžiavimą
${copyright}. VISOS TEISĖS SAUGOMOS.

                                                           
\ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/lt/user/email/verification.html b/services/brig/deb/opt/brig/templates/lt/user/email/verification.html index 06ed33b5c3b..4a934004504 100644 --- a/services/brig/deb/opt/brig/templates/lt/user/email/verification.html +++ b/services/brig/deb/opt/brig/templates/lt/user/email/verification.html @@ -1 +1 @@ -${code} is your ${brand} verification code

${brand_label_url}

Patvirtinkite savo el. paštą

${email} buvo užregistruotas „${brand}“ sistemoje. Norėdami patvirtinti savo el. paštą ir susikurti paskyrą, įveskite šį kodą.

 

${code}

 

Jei turite klausimų, susisiekite su mumis.

Privatumo politika ir naudojimosi sąlygos · Pranešti apie piktnaudžiavimą
${copyright}. VISOS TEISĖS SAUGOMOS.

                                                           
\ No newline at end of file +${code} is your ${brand} verification code

${brand_label_url}

Patvirtinkite savo el. paštą

${email} buvo užregistruotas „${brand}“ sistemoje. Norėdami patvirtinti savo el. paštą ir susikurti paskyrą, įveskite šį kodą.

 

${code}

 

Jei turite klausimų, susisiekite su mumis.

Privatumo politika ir naudojimosi sąlygos · Pranešti apie piktnaudžiavimą
${copyright}. VISOS TEISĖS SAUGOMOS.

                                                           
\ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/pl/user/call/activation.txt b/services/brig/deb/opt/brig/templates/pl/user/call/activation.txt new file mode 100644 index 00000000000..8b52566e1ed --- /dev/null +++ b/services/brig/deb/opt/brig/templates/pl/user/call/activation.txt @@ -0,0 +1 @@ +Witaj, Twój kod weryfikacyjny Wire to: ${code}. Jeszcze raz twój kod to: ${code} \ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/pl/user/call/login.txt b/services/brig/deb/opt/brig/templates/pl/user/call/login.txt new file mode 100644 index 00000000000..b2d8c07e3b3 --- /dev/null +++ b/services/brig/deb/opt/brig/templates/pl/user/call/login.txt @@ -0,0 +1 @@ +Witaj, Twój kod logowania Wire to: ${code}. Jeszcze raz twój kod to: ${code} \ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/pl/user/email/activation-subject.txt b/services/brig/deb/opt/brig/templates/pl/user/email/activation-subject.txt new file mode 100644 index 00000000000..4bc57a10ed6 --- /dev/null +++ b/services/brig/deb/opt/brig/templates/pl/user/email/activation-subject.txt @@ -0,0 +1 @@ +Twoje konto ${brand} \ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/pl/user/email/activation.html b/services/brig/deb/opt/brig/templates/pl/user/email/activation.html new file mode 100644 index 00000000000..d264b4c23f5 --- /dev/null +++ b/services/brig/deb/opt/brig/templates/pl/user/email/activation.html @@ -0,0 +1 @@ +Twoje konto ${brand}

${brand_label_url}

Potwierdź swój adres email

${email} został użyty do rejestracji ${brand}.
Kliknij przycisk, aby zweryfikować swój adres.

 
Zweryfikuj
 

Jeśli nie możesz kliknąć przycisku, skopiuj i wklej ten link do swojej przeglądarki:

${url}

Jeśli masz jakieś pytania, prosimy skontaktuj się z nami.

Polityka prywatności i warunki użytkowania · Zgłoś niewłaściwe użycie
${copyright}. WSZELKIE PRAWA ZASTRZEŻONE.

                                                           
\ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/pl/user/email/activation.txt b/services/brig/deb/opt/brig/templates/pl/user/email/activation.txt new file mode 100644 index 00000000000..3921797a145 --- /dev/null +++ b/services/brig/deb/opt/brig/templates/pl/user/email/activation.txt @@ -0,0 +1,21 @@ +[${brand_logo}] + +${brand_label_url} [${brand_url}] + +POTWIERDŹ SWÓJ ADRES EMAIL +${email} został użyty do rejestracji ${brand}. +Kliknij przycisk, aby zweryfikować swój adres. + +Zweryfikuj [${url}]Jeśli nie możesz kliknąć przycisku, skopiuj i wklej ten link +do swojej przeglądarki: + +${url} + +Jeśli masz jakieś pytania, prosimy skontaktuj się z nami [${support}]. + + +-------------------------------------------------------------------------------- + +Polityka prywatności i warunki użytkowania [${legal}] · Zgłoś niewłaściwe użycie +[${misuse}] +${copyright}. WSZELKIE PRAWA ZASTRZEŻONE. \ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/pl/user/email/deletion-subject.txt b/services/brig/deb/opt/brig/templates/pl/user/email/deletion-subject.txt new file mode 100644 index 00000000000..104d8881c50 --- /dev/null +++ b/services/brig/deb/opt/brig/templates/pl/user/email/deletion-subject.txt @@ -0,0 +1 @@ +Usunąć konto? \ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/pl/user/email/deletion.html b/services/brig/deb/opt/brig/templates/pl/user/email/deletion.html new file mode 100644 index 00000000000..76459d62cb6 --- /dev/null +++ b/services/brig/deb/opt/brig/templates/pl/user/email/deletion.html @@ -0,0 +1 @@ +Usunąć konto?

${brand_label_url}

Usuń swoje konto

Otrzymaliśmy prośbę o usunięcie konta ${brand}. Kliknij przycisk poniżej w ciągu 10 minut, aby usunąć wszystkie konwersacje, treści i połączenia.

 
Usuń konto
 

Jeśli nie możesz kliknąć przycisku, skopiuj i wklej ten link do swojej przeglądarki:

${url}

Jeśli nie poprosiłeś o to, zresetuj swoje hasło.

Jeśli masz jakieś pytania, prosimy skontaktuj się z nami.

Polityka prywatności i warunki użytkowania · Zgłoś niewłaściwe użycie
${copyright}. WSZELKIE PRAWA ZASTRZEŻONE.

                                                           
\ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/pl/user/email/deletion.txt b/services/brig/deb/opt/brig/templates/pl/user/email/deletion.txt new file mode 100644 index 00000000000..33a4f532af8 --- /dev/null +++ b/services/brig/deb/opt/brig/templates/pl/user/email/deletion.txt @@ -0,0 +1,23 @@ +[${brand_logo}] + +${brand_label_url} [${brand_url}] + +USUŃ SWOJE KONTO +Otrzymaliśmy prośbę o usunięcie konta ${brand}. Kliknij przycisk poniżej w ciągu +10 minut, aby usunąć wszystkie konwersacje, treści i połączenia. + +Usuń konto [${url}]Jeśli nie możesz kliknąć przycisku, skopiuj i wklej ten link +do swojej przeglądarki: + +${url} + +Jeśli nie poprosiłeś o to, zresetuj swoje hasło [${forgot}]. + +Jeśli masz jakieś pytania, prosimy skontaktuj się z nami [${support}]. + + +-------------------------------------------------------------------------------- + +Polityka prywatności i warunki użytkowania [${legal}] · Zgłoś niewłaściwe użycie +[${misuse}] +${copyright}. WSZELKIE PRAWA ZASTRZEŻONE. \ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/pl/user/email/new-client-subject.txt b/services/brig/deb/opt/brig/templates/pl/user/email/new-client-subject.txt new file mode 100644 index 00000000000..01f2fc441ad --- /dev/null +++ b/services/brig/deb/opt/brig/templates/pl/user/email/new-client-subject.txt @@ -0,0 +1 @@ +Nowe urządzenie \ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/pl/user/email/new-client.html b/services/brig/deb/opt/brig/templates/pl/user/email/new-client.html new file mode 100644 index 00000000000..f0064d61ba6 --- /dev/null +++ b/services/brig/deb/opt/brig/templates/pl/user/email/new-client.html @@ -0,0 +1 @@ +Nowe urządzenie

${brand_label_url}

Nowe urządzenie

Twoje konto ${brand} zostało użyte dnia:

${date}

${model}

Możesz zainstalować ${brand} na nowym urządzeniu lub zainstalować go ponownie na istniejącym. Jeśli tak nie było, przejdź do Ustawień ${brand}, usuń urządzenie i zresetuj hasło.

Jeśli masz jakieś pytania, prosimy skontaktuj się z nami.

Polityka prywatności i warunki użytkowania · Zgłoś niewłaściwe użycie
${copyright}. WSZELKIE PRAWA ZASTRZEŻONE.

                                                           
\ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/pl/user/email/new-client.txt b/services/brig/deb/opt/brig/templates/pl/user/email/new-client.txt new file mode 100644 index 00000000000..1d7bd177e11 --- /dev/null +++ b/services/brig/deb/opt/brig/templates/pl/user/email/new-client.txt @@ -0,0 +1,23 @@ +[${brand_logo}] + +${brand_label_url} [${brand_url}] + +NOWE URZĄDZENIE +Twoje konto ${brand} zostało użyte dnia: + +${date} + +${model} + +Możesz zainstalować ${brand} na nowym urządzeniu lub zainstalować go ponownie na +istniejącym. Jeśli tak nie było, przejdź do Ustawień ${brand}, usuń urządzenie i +zresetuj hasło [${forgot}]. + +Jeśli masz jakieś pytania, prosimy skontaktuj się z nami [${support}]. + + +-------------------------------------------------------------------------------- + +Polityka prywatności i warunki użytkowania [${legal}] · Zgłoś niewłaściwe użycie +[${misuse}] +${copyright}. WSZELKIE PRAWA ZASTRZEŻONE. \ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/pl/user/email/password-reset-subject.txt b/services/brig/deb/opt/brig/templates/pl/user/email/password-reset-subject.txt new file mode 100644 index 00000000000..98ef3d18238 --- /dev/null +++ b/services/brig/deb/opt/brig/templates/pl/user/email/password-reset-subject.txt @@ -0,0 +1 @@ +Zmiana hasła w ${brand} \ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/pl/user/email/password-reset.html b/services/brig/deb/opt/brig/templates/pl/user/email/password-reset.html new file mode 100644 index 00000000000..139c47eb9ea --- /dev/null +++ b/services/brig/deb/opt/brig/templates/pl/user/email/password-reset.html @@ -0,0 +1 @@ +Zmiana hasła w ${brand}

${brand_label_url}

Zresetuj hasło

Otrzymaliśmy prośbę o zresetowanie hasła do Twojego konta ${brand}. Aby utworzyć nowe hasło, kliknij poniższy przycisk.

 
Zresetuj hasło
 

Jeśli nie możesz kliknąć przycisku, skopiuj i wklej ten link do swojej przeglądarki:

${url}

Jeśli masz jakieś pytania, prosimy skontaktuj się z nami.

Polityka prywatności i warunki użytkowania · Zgłoś niewłaściwe użycie
${copyright}. WSZELKIE PRAWA ZASTRZEŻONE.

                                                           
\ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/pl/user/email/password-reset.txt b/services/brig/deb/opt/brig/templates/pl/user/email/password-reset.txt new file mode 100644 index 00000000000..780fb104cc0 --- /dev/null +++ b/services/brig/deb/opt/brig/templates/pl/user/email/password-reset.txt @@ -0,0 +1,21 @@ +[${brand_logo}] + +${brand_label_url} [${brand_url}] + +ZRESETUJ HASŁO +Otrzymaliśmy prośbę o zresetowanie hasła do Twojego konta ${brand}. Aby utworzyć +nowe hasło, kliknij poniższy przycisk. + +Zresetuj hasło [${url}]Jeśli nie możesz kliknąć przycisku, skopiuj i wklej ten +link do swojej przeglądarki: + +${url} + +Jeśli masz jakieś pytania, prosimy skontaktuj się z nami [${support}]. + + +-------------------------------------------------------------------------------- + +Polityka prywatności i warunki użytkowania [${legal}] · Zgłoś niewłaściwe użycie +[${misuse}] +${copyright}. WSZELKIE PRAWA ZASTRZEŻONE. \ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/pl/user/email/team-activation-subject.txt b/services/brig/deb/opt/brig/templates/pl/user/email/team-activation-subject.txt new file mode 100644 index 00000000000..79fabd2adb9 --- /dev/null +++ b/services/brig/deb/opt/brig/templates/pl/user/email/team-activation-subject.txt @@ -0,0 +1 @@ +Konto ${brand} \ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/pl/user/email/team-activation.html b/services/brig/deb/opt/brig/templates/pl/user/email/team-activation.html new file mode 100644 index 00000000000..067c12da167 --- /dev/null +++ b/services/brig/deb/opt/brig/templates/pl/user/email/team-activation.html @@ -0,0 +1 @@ +Konto ${brand}

${brand_label_url}

Twoje nowe konto na ${brand}

Nowy zespół ${brand} został utworzony z ${email}. Prosimy, zweryfikuj swój adres email.

 
Zweryfikuj
 

Jeśli nie możesz kliknąć przycisku, skopiuj i wklej ten link do swojej przeglądarki:

${url}

Jeśli masz jakieś pytania, prosimy skontaktuj się z nami.

Polityka prywatności i warunki użytkowania · Zgłoś niewłaściwe użycie
${copyright}. WSZELKIE PRAWA ZASTRZEŻONE.

                                                           
\ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/pl/user/email/team-activation.txt b/services/brig/deb/opt/brig/templates/pl/user/email/team-activation.txt new file mode 100644 index 00000000000..f1054d62cfa --- /dev/null +++ b/services/brig/deb/opt/brig/templates/pl/user/email/team-activation.txt @@ -0,0 +1,21 @@ +[${brand_logo}] + +${brand_label_url} [${brand_url}] + +TWOJE NOWE KONTO NA ${BRAND} +Nowy zespół ${brand} został utworzony z ${email}. Prosimy, zweryfikuj swój adres +email. + +Zweryfikuj [${url}]Jeśli nie możesz kliknąć przycisku, skopiuj i wklej ten link +do swojej przeglądarki: + +${url} + +Jeśli masz jakieś pytania, prosimy skontaktuj się z nami [${support}]. + + +-------------------------------------------------------------------------------- + +Polityka prywatności i warunki użytkowania [${legal}] · Zgłoś niewłaściwe użycie +[${misuse}] +${copyright}. WSZELKIE PRAWA ZASTRZEŻONE. \ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/pl/user/email/update-subject.txt b/services/brig/deb/opt/brig/templates/pl/user/email/update-subject.txt new file mode 100644 index 00000000000..719299d9623 --- /dev/null +++ b/services/brig/deb/opt/brig/templates/pl/user/email/update-subject.txt @@ -0,0 +1 @@ +Twój nowy adres e-mail na ${brand} \ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/pl/user/email/update.html b/services/brig/deb/opt/brig/templates/pl/user/email/update.html new file mode 100644 index 00000000000..8a0a1d35d99 --- /dev/null +++ b/services/brig/deb/opt/brig/templates/pl/user/email/update.html @@ -0,0 +1 @@ +Twój nowy adres e-mail na ${brand}

${brand_label_url}

Potwierdź swój adres email

${email} został zarejestrowany jako Twój nowy adres e-mail na ${brand}. Kliknij poniższy przycisk, aby zweryfikować swój adres.

 
Zweryfikuj
 

Jeśli nie możesz kliknąć przycisku, skopiuj i wklej ten link do swojej przeglądarki:

${url}

Jeśli masz jakieś pytania, prosimy skontaktuj się z nami.

Polityka prywatności i warunki użytkowania · Zgłoś niewłaściwe użycie
${copyright}. WSZELKIE PRAWA ZASTRZEŻONE.

                                                           
\ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/pl/user/email/update.txt b/services/brig/deb/opt/brig/templates/pl/user/email/update.txt new file mode 100644 index 00000000000..63e46b58a26 --- /dev/null +++ b/services/brig/deb/opt/brig/templates/pl/user/email/update.txt @@ -0,0 +1,21 @@ +[${brand_logo}] + +${brand_label_url} [${brand_url}] + +POTWIERDŹ SWÓJ ADRES EMAIL +${email} został zarejestrowany jako Twój nowy adres e-mail na ${brand}. Kliknij +poniższy przycisk, aby zweryfikować swój adres. + +Zweryfikuj [${url}]Jeśli nie możesz kliknąć przycisku, skopiuj i wklej ten link +do swojej przeglądarki: + +${url} + +Jeśli masz jakieś pytania, prosimy skontaktuj się z nami [${support}]. + + +-------------------------------------------------------------------------------- + +Polityka prywatności i warunki użytkowania [${legal}] · Zgłoś niewłaściwe użycie +[${misuse}] +${copyright}. WSZELKIE PRAWA ZASTRZEŻONE. \ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/pl/user/email/verification-delete-team-subject.txt b/services/brig/deb/opt/brig/templates/pl/user/email/verification-delete-team-subject.txt new file mode 100644 index 00000000000..5687c98820a --- /dev/null +++ b/services/brig/deb/opt/brig/templates/pl/user/email/verification-delete-team-subject.txt @@ -0,0 +1 @@ +your ${brand} verification code is ${code} \ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/pl/user/email/verification-delete-team.html b/services/brig/deb/opt/brig/templates/pl/user/email/verification-delete-team.html new file mode 100644 index 00000000000..41249f6efb8 --- /dev/null +++ b/services/brig/deb/opt/brig/templates/pl/user/email/verification-delete-team.html @@ -0,0 +1 @@ +your ${brand} verification code is ${code}

${brand_label_url}

Verify team deletion

${email} was used to delete your ${brand} team. Enter this code to verify your email and delete the team.

 

${code}

 

Jeśli masz jakieś pytania, prosimy skontaktuj się z nami.

Polityka prywatności i warunki użytkowania · Zgłoś niewłaściwe użycie
${copyright}. WSZELKIE PRAWA ZASTRZEŻONE.

                                                           
\ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/pl/user/email/verification-delete-team.txt b/services/brig/deb/opt/brig/templates/pl/user/email/verification-delete-team.txt new file mode 100644 index 00000000000..5083b37be80 --- /dev/null +++ b/services/brig/deb/opt/brig/templates/pl/user/email/verification-delete-team.txt @@ -0,0 +1,18 @@ +[${brand_logo}] + +${brand_label_url} [${brand_url}] + +VERIFY TEAM DELETION +${email} was used to delete your ${brand} team. Enter this code to verify your +email and delete the team. + +${code} + +Jeśli masz jakieś pytania, prosimy skontaktuj się z nami [${support}]. + + +-------------------------------------------------------------------------------- + +Polityka prywatności i warunki użytkowania [${legal}] · Zgłoś niewłaściwe użycie +[${misuse}] +${copyright}. WSZELKIE PRAWA ZASTRZEŻONE. \ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/pl/user/email/verification-login-subject.txt b/services/brig/deb/opt/brig/templates/pl/user/email/verification-login-subject.txt new file mode 100644 index 00000000000..5687c98820a --- /dev/null +++ b/services/brig/deb/opt/brig/templates/pl/user/email/verification-login-subject.txt @@ -0,0 +1 @@ +your ${brand} verification code is ${code} \ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/pl/user/email/verification-login.html b/services/brig/deb/opt/brig/templates/pl/user/email/verification-login.html new file mode 100644 index 00000000000..f76ed3ab0e1 --- /dev/null +++ b/services/brig/deb/opt/brig/templates/pl/user/email/verification-login.html @@ -0,0 +1 @@ +your ${brand} verification code is ${code}

${brand_label_url}

Verify login

${email} was used to log in to your ${brand} account. Enter this code to verify your email and log in.

 

${code}

 

Jeśli masz jakieś pytania, prosimy skontaktuj się z nami.

Polityka prywatności i warunki użytkowania · Zgłoś niewłaściwe użycie
${copyright}. WSZELKIE PRAWA ZASTRZEŻONE.

                                                           
\ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/pl/user/email/verification-login.txt b/services/brig/deb/opt/brig/templates/pl/user/email/verification-login.txt new file mode 100644 index 00000000000..a3fb260d38e --- /dev/null +++ b/services/brig/deb/opt/brig/templates/pl/user/email/verification-login.txt @@ -0,0 +1,18 @@ +[${brand_logo}] + +${brand_label_url} [${brand_url}] + +VERIFY LOGIN +${email} was used to log in to your ${brand} account. Enter this code to verify +your email and log in. + +${code} + +Jeśli masz jakieś pytania, prosimy skontaktuj się z nami [${support}]. + + +-------------------------------------------------------------------------------- + +Polityka prywatności i warunki użytkowania [${legal}] · Zgłoś niewłaściwe użycie +[${misuse}] +${copyright}. WSZELKIE PRAWA ZASTRZEŻONE. \ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/pl/user/email/verification-scim-token-subject.txt b/services/brig/deb/opt/brig/templates/pl/user/email/verification-scim-token-subject.txt new file mode 100644 index 00000000000..5687c98820a --- /dev/null +++ b/services/brig/deb/opt/brig/templates/pl/user/email/verification-scim-token-subject.txt @@ -0,0 +1 @@ +your ${brand} verification code is ${code} \ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/pl/user/email/verification-scim-token.html b/services/brig/deb/opt/brig/templates/pl/user/email/verification-scim-token.html new file mode 100644 index 00000000000..2692de19628 --- /dev/null +++ b/services/brig/deb/opt/brig/templates/pl/user/email/verification-scim-token.html @@ -0,0 +1 @@ +your ${brand} verification code is ${code}

${brand_label_url}

Verify SCIM token creation

${email} was used to generate a SCIM token. Enter this code to verify your email and create the token.

 

${code}

 

Jeśli masz jakieś pytania, prosimy skontaktuj się z nami.

Polityka prywatności i warunki użytkowania · Zgłoś niewłaściwe użycie
${copyright}. WSZELKIE PRAWA ZASTRZEŻONE.

                                                           
\ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/pl/user/email/verification-scim-token.txt b/services/brig/deb/opt/brig/templates/pl/user/email/verification-scim-token.txt new file mode 100644 index 00000000000..2e71ea22393 --- /dev/null +++ b/services/brig/deb/opt/brig/templates/pl/user/email/verification-scim-token.txt @@ -0,0 +1,18 @@ +[${brand_logo}] + +${brand_label_url} [${brand_url}] + +VERIFY SCIM TOKEN CREATION +${email} was used to generate a SCIM token. Enter this code to verify your email +and create the token. + +${code} + +Jeśli masz jakieś pytania, prosimy skontaktuj się z nami [${support}]. + + +-------------------------------------------------------------------------------- + +Polityka prywatności i warunki użytkowania [${legal}] · Zgłoś niewłaściwe użycie +[${misuse}] +${copyright}. WSZELKIE PRAWA ZASTRZEŻONE. \ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/pl/user/email/verification-subject.txt b/services/brig/deb/opt/brig/templates/pl/user/email/verification-subject.txt new file mode 100644 index 00000000000..0f7cfb2744c --- /dev/null +++ b/services/brig/deb/opt/brig/templates/pl/user/email/verification-subject.txt @@ -0,0 +1 @@ +${code} to twój kod weryfikacyjny ${brand} \ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/pl/user/email/verification.html b/services/brig/deb/opt/brig/templates/pl/user/email/verification.html new file mode 100644 index 00000000000..5e669a1b58d --- /dev/null +++ b/services/brig/deb/opt/brig/templates/pl/user/email/verification.html @@ -0,0 +1 @@ +${code} to twój kod weryfikacyjny ${brand}

${brand_label_url}

Potwierdź swój adres email

${email} został użyty do rejestracji ${brand}. Wprowadź ten kod, aby zweryfikować swój adres e-mail i utworzyć konto.

 

${code}

 

Jeśli masz jakieś pytania, prosimy skontaktuj się z nami.

Polityka prywatności i warunki użytkowania · Zgłoś niewłaściwe użycie
${copyright}. WSZELKIE PRAWA ZASTRZEŻONE.

                                                           
\ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/pl/user/email/verification.txt b/services/brig/deb/opt/brig/templates/pl/user/email/verification.txt new file mode 100644 index 00000000000..3a229ff4e6d --- /dev/null +++ b/services/brig/deb/opt/brig/templates/pl/user/email/verification.txt @@ -0,0 +1,18 @@ +[${brand_logo}] + +${brand_label_url} [${brand_url}] + +POTWIERDŹ SWÓJ ADRES EMAIL +${email} został użyty do rejestracji ${brand}. Wprowadź ten kod, aby +zweryfikować swój adres e-mail i utworzyć konto. + +${code} + +Jeśli masz jakieś pytania, prosimy skontaktuj się z nami [${support}]. + + +-------------------------------------------------------------------------------- + +Polityka prywatności i warunki użytkowania [${legal}] · Zgłoś niewłaściwe użycie +[${misuse}] +${copyright}. WSZELKIE PRAWA ZASTRZEŻONE. \ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/pl/user/sms/activation.txt b/services/brig/deb/opt/brig/templates/pl/user/sms/activation.txt new file mode 100644 index 00000000000..7fc97d25b1c --- /dev/null +++ b/services/brig/deb/opt/brig/templates/pl/user/sms/activation.txt @@ -0,0 +1,3 @@ +Twój kod ${brand} to ${code}. + +Otwórz ${url} aby zweryfikować swój numer. diff --git a/services/brig/deb/opt/brig/templates/pl/user/sms/deletion.txt b/services/brig/deb/opt/brig/templates/pl/user/sms/deletion.txt new file mode 100644 index 00000000000..97abae34dde --- /dev/null +++ b/services/brig/deb/opt/brig/templates/pl/user/sms/deletion.txt @@ -0,0 +1,2 @@ +Dotknij, aby usunąć swoje konto ${brand}. +${url} diff --git a/services/brig/deb/opt/brig/templates/pl/user/sms/login.txt b/services/brig/deb/opt/brig/templates/pl/user/sms/login.txt new file mode 100644 index 00000000000..f3b86d6a962 --- /dev/null +++ b/services/brig/deb/opt/brig/templates/pl/user/sms/login.txt @@ -0,0 +1,3 @@ +Twój kod logowania ${brand} to ${code}. + +Otwórz ${url} aby się zalogować. diff --git a/services/brig/deb/opt/brig/templates/pl/user/sms/password-reset.txt b/services/brig/deb/opt/brig/templates/pl/user/sms/password-reset.txt new file mode 100644 index 00000000000..046e6e86c5c --- /dev/null +++ b/services/brig/deb/opt/brig/templates/pl/user/sms/password-reset.txt @@ -0,0 +1,3 @@ +Twój kod odzyskiwania ${brand} to ${code}. + +Użyj tego kodu, aby ukończyć resetowanie hasła. diff --git a/services/brig/deb/opt/brig/templates/pt/user/call/activation.txt b/services/brig/deb/opt/brig/templates/pt/user/call/activation.txt new file mode 100644 index 00000000000..9198dbdff87 --- /dev/null +++ b/services/brig/deb/opt/brig/templates/pt/user/call/activation.txt @@ -0,0 +1 @@ +Olá, seu código de verificação do Wire é: ${code}. Novamente, seu código é: ${code} \ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/pt/user/call/login.txt b/services/brig/deb/opt/brig/templates/pt/user/call/login.txt new file mode 100644 index 00000000000..7da656975eb --- /dev/null +++ b/services/brig/deb/opt/brig/templates/pt/user/call/login.txt @@ -0,0 +1 @@ +Olá, seu código de login do Wire é: ${code}. Novamente, seu código é: ${code} \ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/pt/user/email/activation-subject.txt b/services/brig/deb/opt/brig/templates/pt/user/email/activation-subject.txt new file mode 100644 index 00000000000..1a7676c99fa --- /dev/null +++ b/services/brig/deb/opt/brig/templates/pt/user/email/activation-subject.txt @@ -0,0 +1 @@ +Sua Conta ${brand} \ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/pt/user/email/activation.html b/services/brig/deb/opt/brig/templates/pt/user/email/activation.html new file mode 100644 index 00000000000..ea3081ffced --- /dev/null +++ b/services/brig/deb/opt/brig/templates/pt/user/email/activation.html @@ -0,0 +1 @@ +Sua Conta ${brand}

${brand_label_url}

Verifique seu e-mail

${email} foi usado para se registrar no ${brand}.
Clique no botão para verificar seu e-mail.

 
Verificar
 

Se você não conseguir clicar no botão, copie e cole este link no seu navegador:

${url}

Se você tiver alguma dúvida, por favor, entre em contato conosco.

Política de privacidade e termos de uso · Reportar uso indevido
${copyright}. TODOS OS DIREITOS RESERVADOS.

                                                           
\ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/pt/user/email/activation.txt b/services/brig/deb/opt/brig/templates/pt/user/email/activation.txt new file mode 100644 index 00000000000..ada1772adab --- /dev/null +++ b/services/brig/deb/opt/brig/templates/pt/user/email/activation.txt @@ -0,0 +1,21 @@ +[${brand_logo}] + +${brand_label_url} [${brand_url}] + +VERIFIQUE SEU E-MAIL +${email} foi usado para se registrar no ${brand}. +Clique no botão para verificar seu e-mail. + +Verificar [${url}]Se você não conseguir clicar no botão, copie e cole este link +no seu navegador: + +${url} + +Se você tiver alguma dúvida, por favor, entre em contato conosco [${support}]. + + +-------------------------------------------------------------------------------- + +Política de privacidade e termos de uso [${legal}] · Reportar uso indevido +[${misuse}] +${copyright}. TODOS OS DIREITOS RESERVADOS. \ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/pt/user/email/deletion-subject.txt b/services/brig/deb/opt/brig/templates/pt/user/email/deletion-subject.txt new file mode 100644 index 00000000000..4fa7c98ccd1 --- /dev/null +++ b/services/brig/deb/opt/brig/templates/pt/user/email/deletion-subject.txt @@ -0,0 +1 @@ +Excluir conta? \ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/pt/user/email/deletion.html b/services/brig/deb/opt/brig/templates/pt/user/email/deletion.html new file mode 100644 index 00000000000..a9fd902f42a --- /dev/null +++ b/services/brig/deb/opt/brig/templates/pt/user/email/deletion.html @@ -0,0 +1 @@ +Excluir conta?

${brand_label_url}

Excluir sua conta

Nós recebemos uma solicitação para excluir sua conta ${brand}. Clique no botão abaixo em até 10 minutos para excluir todas as suas conversas, conteúdo e conexões.

 
Excluir conta
 

Se você não conseguir clicar no botão, copie e cole este link no seu navegador:

${url}

Se você não solicitou isso, redefina sua senha.

Se você tiver alguma dúvida, por favor, entre em contato conosco.

Política de privacidade e termos de uso · Reportar uso indevido
${copyright}. TODOS OS DIREITOS RESERVADOS.

                                                           
\ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/pt/user/email/deletion.txt b/services/brig/deb/opt/brig/templates/pt/user/email/deletion.txt new file mode 100644 index 00000000000..2b9dab30e3b --- /dev/null +++ b/services/brig/deb/opt/brig/templates/pt/user/email/deletion.txt @@ -0,0 +1,24 @@ +[${brand_logo}] + +${brand_label_url} [${brand_url}] + +EXCLUIR SUA CONTA +Nós recebemos uma solicitação para excluir sua conta ${brand}. Clique no botão +abaixo em até 10 minutos para excluir todas as suas conversas, conteúdo e +conexões. + +Excluir conta [${url}]Se você não conseguir clicar no botão, copie e cole este +link no seu navegador: + +${url} + +Se você não solicitou isso, redefina sua senha [${forgot}]. + +Se você tiver alguma dúvida, por favor, entre em contato conosco [${support}]. + + +-------------------------------------------------------------------------------- + +Política de privacidade e termos de uso [${legal}] · Reportar uso indevido +[${misuse}] +${copyright}. TODOS OS DIREITOS RESERVADOS. \ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/pt/user/email/new-client-subject.txt b/services/brig/deb/opt/brig/templates/pt/user/email/new-client-subject.txt new file mode 100644 index 00000000000..3681f044050 --- /dev/null +++ b/services/brig/deb/opt/brig/templates/pt/user/email/new-client-subject.txt @@ -0,0 +1 @@ +Novo dispositivo \ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/pt/user/email/new-client.html b/services/brig/deb/opt/brig/templates/pt/user/email/new-client.html new file mode 100644 index 00000000000..7d7308b7f3f --- /dev/null +++ b/services/brig/deb/opt/brig/templates/pt/user/email/new-client.html @@ -0,0 +1 @@ +Novo dispositivo

${brand_label_url}

Novo dispositivo

Sua conta ${brand} foi usada em:

${date}

${model}

Você pode ter instalado o ${brand} em um dispositivo novo ou instalado novamente em um já existente. Se não foi esse o caso, vá nas Configurações de ${brand}, remova o dispositivo e redefina sua senha.

Se você tiver alguma dúvida, por favor, entre em contato conosco.

Política de privacidade e termos de uso · Reportar uso indevido
${copyright}. TODOS OS DIREITOS RESERVADOS.

                                                           
\ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/pt/user/email/new-client.txt b/services/brig/deb/opt/brig/templates/pt/user/email/new-client.txt new file mode 100644 index 00000000000..69670319527 --- /dev/null +++ b/services/brig/deb/opt/brig/templates/pt/user/email/new-client.txt @@ -0,0 +1,23 @@ +[${brand_logo}] + +${brand_label_url} [${brand_url}] + +NOVO DISPOSITIVO +Sua conta ${brand} foi usada em: + +${date} + +${model} + +Você pode ter instalado o ${brand} em um dispositivo novo ou instalado novamente +em um já existente. Se não foi esse o caso, vá nas Configurações de ${brand}, +remova o dispositivo e redefina sua senha [${forgot}]. + +Se você tiver alguma dúvida, por favor, entre em contato conosco [${support}]. + + +-------------------------------------------------------------------------------- + +Política de privacidade e termos de uso [${legal}] · Reportar uso indevido +[${misuse}] +${copyright}. TODOS OS DIREITOS RESERVADOS. \ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/pt/user/email/password-reset-subject.txt b/services/brig/deb/opt/brig/templates/pt/user/email/password-reset-subject.txt new file mode 100644 index 00000000000..6c6f2407ee6 --- /dev/null +++ b/services/brig/deb/opt/brig/templates/pt/user/email/password-reset-subject.txt @@ -0,0 +1 @@ +Mudança de Senha no ${brand} \ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/pt/user/email/password-reset.html b/services/brig/deb/opt/brig/templates/pt/user/email/password-reset.html new file mode 100644 index 00000000000..1066973603f --- /dev/null +++ b/services/brig/deb/opt/brig/templates/pt/user/email/password-reset.html @@ -0,0 +1 @@ +Mudança de Senha no ${brand}

${brand_label_url}

Redefinir sua senha

Recebemos uma solicitação para redefinir a senha de sua conta ${brand}. Para criar uma nova senha, clique no botão abaixo.

 
Redefinir senha
 

Se você não conseguir clicar no botão, copie e cole este link no seu navegador:

${url}

Se você tiver alguma dúvida, por favor, entre em contato conosco.

Política de privacidade e termos de uso · Reportar uso indevido
${copyright}. TODOS OS DIREITOS RESERVADOS.

                                                           
\ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/pt/user/email/password-reset.txt b/services/brig/deb/opt/brig/templates/pt/user/email/password-reset.txt new file mode 100644 index 00000000000..ce009cf1502 --- /dev/null +++ b/services/brig/deb/opt/brig/templates/pt/user/email/password-reset.txt @@ -0,0 +1,21 @@ +[${brand_logo}] + +${brand_label_url} [${brand_url}] + +REDEFINIR SUA SENHA +Recebemos uma solicitação para redefinir a senha de sua conta ${brand}. Para +criar uma nova senha, clique no botão abaixo. + +Redefinir senha [${url}]Se você não conseguir clicar no botão, copie e cole este +link no seu navegador: + +${url} + +Se você tiver alguma dúvida, por favor, entre em contato conosco [${support}]. + + +-------------------------------------------------------------------------------- + +Política de privacidade e termos de uso [${legal}] · Reportar uso indevido +[${misuse}] +${copyright}. TODOS OS DIREITOS RESERVADOS. \ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/pt/user/email/team-activation-subject.txt b/services/brig/deb/opt/brig/templates/pt/user/email/team-activation-subject.txt new file mode 100644 index 00000000000..464c16e3ac9 --- /dev/null +++ b/services/brig/deb/opt/brig/templates/pt/user/email/team-activation-subject.txt @@ -0,0 +1 @@ +Conta ${brand} \ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/pt/user/email/team-activation.html b/services/brig/deb/opt/brig/templates/pt/user/email/team-activation.html new file mode 100644 index 00000000000..acc4378363a --- /dev/null +++ b/services/brig/deb/opt/brig/templates/pt/user/email/team-activation.html @@ -0,0 +1 @@ +Conta ${brand}

${brand_label_url}

Sua nova conta em ${brand}

Um nova conta na equipe ${brand} foi criada com ${email}. Por favor, verifique seu e-mail.

 
Verificar
 

Se você não conseguir clicar no botão, copie e cole este link no seu navegador:

${url}

Se você tiver alguma dúvida, por favor, entre em contato conosco.

Política de privacidade e termos de uso · Reportar uso indevido
${copyright}. TODOS OS DIREITOS RESERVADOS.

                                                           
\ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/pt/user/email/team-activation.txt b/services/brig/deb/opt/brig/templates/pt/user/email/team-activation.txt new file mode 100644 index 00000000000..876e24f88b5 --- /dev/null +++ b/services/brig/deb/opt/brig/templates/pt/user/email/team-activation.txt @@ -0,0 +1,21 @@ +[${brand_logo}] + +${brand_label_url} [${brand_url}] + +SUA NOVA CONTA EM ${BRAND} +Um nova conta na equipe ${brand} foi criada com ${email}. Por favor, verifique +seu e-mail. + +Verificar [${url}]Se você não conseguir clicar no botão, copie e cole este link +no seu navegador: + +${url} + +Se você tiver alguma dúvida, por favor, entre em contato conosco [${support}]. + + +-------------------------------------------------------------------------------- + +Política de privacidade e termos de uso [${legal}] · Reportar uso indevido +[${misuse}] +${copyright}. TODOS OS DIREITOS RESERVADOS. \ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/pt/user/email/update-subject.txt b/services/brig/deb/opt/brig/templates/pt/user/email/update-subject.txt new file mode 100644 index 00000000000..104b19d1ed7 --- /dev/null +++ b/services/brig/deb/opt/brig/templates/pt/user/email/update-subject.txt @@ -0,0 +1 @@ +Seu novo endereço de email no ${brand} \ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/pt/user/email/update.html b/services/brig/deb/opt/brig/templates/pt/user/email/update.html new file mode 100644 index 00000000000..60c2d425e94 --- /dev/null +++ b/services/brig/deb/opt/brig/templates/pt/user/email/update.html @@ -0,0 +1 @@ +Seu novo endereço de email no ${brand}

${brand_label_url}

Confirme o seu e-mail

${email} foi registrado como seu novo endereço de e-mail no ${brand}. Clique no botão para confirmar seu endereço de e-mail.

 
Verificar
 

Se você não conseguir clicar no botão, copie e cole este link no seu navegador:

${url}

Se você tiver alguma dúvida, por favor, entre em contato conosco.

Política de privacidade e termos de uso · Reportar uso indevido
${copyright}. TODOS OS DIREITOS RESERVADOS.

                                                           
\ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/pt/user/email/update.txt b/services/brig/deb/opt/brig/templates/pt/user/email/update.txt new file mode 100644 index 00000000000..ea858533a49 --- /dev/null +++ b/services/brig/deb/opt/brig/templates/pt/user/email/update.txt @@ -0,0 +1,21 @@ +[${brand_logo}] + +${brand_label_url} [${brand_url}] + +CONFIRME O SEU E-MAIL +${email} foi registrado como seu novo endereço de e-mail no ${brand}. Clique no +botão para confirmar seu endereço de e-mail. + +Verificar [${url}]Se você não conseguir clicar no botão, copie e cole este link +no seu navegador: + +${url} + +Se você tiver alguma dúvida, por favor, entre em contato conosco [${support}]. + + +-------------------------------------------------------------------------------- + +Política de privacidade e termos de uso [${legal}] · Reportar uso indevido +[${misuse}] +${copyright}. TODOS OS DIREITOS RESERVADOS. \ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/pt/user/email/verification-delete-team-subject.txt b/services/brig/deb/opt/brig/templates/pt/user/email/verification-delete-team-subject.txt new file mode 100644 index 00000000000..d40987b30b7 --- /dev/null +++ b/services/brig/deb/opt/brig/templates/pt/user/email/verification-delete-team-subject.txt @@ -0,0 +1 @@ +Seu código de verificação do ${brand} é ${code} \ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/pt/user/email/verification-delete-team.html b/services/brig/deb/opt/brig/templates/pt/user/email/verification-delete-team.html new file mode 100644 index 00000000000..c7666c1f0d7 --- /dev/null +++ b/services/brig/deb/opt/brig/templates/pt/user/email/verification-delete-team.html @@ -0,0 +1 @@ +Seu código de verificação do ${brand} é ${code}

${brand_label_url}

Verificar exclusão da equipe

${email} foi usado para excluir sua equipe do ${brand}. Insira este código para verificar seu e-mail e excluir a equipe.

 

${code}

 

Se você tiver alguma dúvida, por favor, entre em contato conosco.

Política de privacidade e termos de uso · Reportar uso indevido
${copyright}. TODOS OS DIREITOS RESERVADOS.

                                                           
\ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/pt/user/email/verification-delete-team.txt b/services/brig/deb/opt/brig/templates/pt/user/email/verification-delete-team.txt new file mode 100644 index 00000000000..820aa9824d1 --- /dev/null +++ b/services/brig/deb/opt/brig/templates/pt/user/email/verification-delete-team.txt @@ -0,0 +1,18 @@ +[${brand_logo}] + +${brand_label_url} [${brand_url}] + +VERIFICAR EXCLUSÃO DA EQUIPE +${email} foi usado para excluir sua equipe do ${brand}. Insira este código para +verificar seu e-mail e excluir a equipe. + +${code} + +Se você tiver alguma dúvida, por favor, entre em contato conosco [${support}]. + + +-------------------------------------------------------------------------------- + +Política de privacidade e termos de uso [${legal}] · Reportar uso indevido +[${misuse}] +${copyright}. TODOS OS DIREITOS RESERVADOS. \ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/pt/user/email/verification-login-subject.txt b/services/brig/deb/opt/brig/templates/pt/user/email/verification-login-subject.txt new file mode 100644 index 00000000000..d40987b30b7 --- /dev/null +++ b/services/brig/deb/opt/brig/templates/pt/user/email/verification-login-subject.txt @@ -0,0 +1 @@ +Seu código de verificação do ${brand} é ${code} \ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/pt/user/email/verification-login.html b/services/brig/deb/opt/brig/templates/pt/user/email/verification-login.html new file mode 100644 index 00000000000..c3f39e27cd5 --- /dev/null +++ b/services/brig/deb/opt/brig/templates/pt/user/email/verification-login.html @@ -0,0 +1 @@ +Seu código de verificação do ${brand} é ${code}

${brand_label_url}

Verificar login

${email} foi usado para iniciar sessão em sua conta do ${brand}. Insira este código para verificar seu e-mail e iniciar sessão.

 

${code}

 

Se você tiver alguma dúvida, por favor, entre em contato conosco.

Política de privacidade e termos de uso · Reportar uso indevido
${copyright}. TODOS OS DIREITOS RESERVADOS.

                                                           
\ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/pt/user/email/verification-login.txt b/services/brig/deb/opt/brig/templates/pt/user/email/verification-login.txt new file mode 100644 index 00000000000..6d78124dea2 --- /dev/null +++ b/services/brig/deb/opt/brig/templates/pt/user/email/verification-login.txt @@ -0,0 +1,18 @@ +[${brand_logo}] + +${brand_label_url} [${brand_url}] + +VERIFICAR LOGIN +${email} foi usado para iniciar sessão em sua conta do ${brand}. Insira este +código para verificar seu e-mail e iniciar sessão. + +${code} + +Se você tiver alguma dúvida, por favor, entre em contato conosco [${support}]. + + +-------------------------------------------------------------------------------- + +Política de privacidade e termos de uso [${legal}] · Reportar uso indevido +[${misuse}] +${copyright}. TODOS OS DIREITOS RESERVADOS. \ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/pt/user/email/verification-scim-token-subject.txt b/services/brig/deb/opt/brig/templates/pt/user/email/verification-scim-token-subject.txt new file mode 100644 index 00000000000..d40987b30b7 --- /dev/null +++ b/services/brig/deb/opt/brig/templates/pt/user/email/verification-scim-token-subject.txt @@ -0,0 +1 @@ +Seu código de verificação do ${brand} é ${code} \ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/pt/user/email/verification-scim-token.html b/services/brig/deb/opt/brig/templates/pt/user/email/verification-scim-token.html new file mode 100644 index 00000000000..dc89990c0a6 --- /dev/null +++ b/services/brig/deb/opt/brig/templates/pt/user/email/verification-scim-token.html @@ -0,0 +1 @@ +Seu código de verificação do ${brand} é ${code}

${brand_label_url}

Verificar criação do token SCIM

${email} foi usado para gerar um token SCIM. Insira este código para verificar seu e-mail e criar o token.

 

${code}

 

Se você tiver alguma dúvida, por favor, entre em contato conosco.

Política de privacidade e termos de uso · Reportar uso indevido
${copyright}. TODOS OS DIREITOS RESERVADOS.

                                                           
\ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/pt/user/email/verification-scim-token.txt b/services/brig/deb/opt/brig/templates/pt/user/email/verification-scim-token.txt new file mode 100644 index 00000000000..e55147ef8b1 --- /dev/null +++ b/services/brig/deb/opt/brig/templates/pt/user/email/verification-scim-token.txt @@ -0,0 +1,18 @@ +[${brand_logo}] + +${brand_label_url} [${brand_url}] + +VERIFICAR CRIAÇÃO DO TOKEN SCIM +${email} foi usado para gerar um token SCIM. Insira este código para verificar +seu e-mail e criar o token. + +${code} + +Se você tiver alguma dúvida, por favor, entre em contato conosco [${support}]. + + +-------------------------------------------------------------------------------- + +Política de privacidade e termos de uso [${legal}] · Reportar uso indevido +[${misuse}] +${copyright}. TODOS OS DIREITOS RESERVADOS. \ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/pt/user/email/verification-subject.txt b/services/brig/deb/opt/brig/templates/pt/user/email/verification-subject.txt new file mode 100644 index 00000000000..3c1b6bbaade --- /dev/null +++ b/services/brig/deb/opt/brig/templates/pt/user/email/verification-subject.txt @@ -0,0 +1 @@ +${code} é o seu código de verificação do ${brand} \ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/pt/user/email/verification.html b/services/brig/deb/opt/brig/templates/pt/user/email/verification.html new file mode 100644 index 00000000000..103bbb41ea9 --- /dev/null +++ b/services/brig/deb/opt/brig/templates/pt/user/email/verification.html @@ -0,0 +1 @@ +${code} é o seu código de verificação do ${brand}

${brand_label_url}

Verifique seu e-mail

${email} foi usado para se registrar no ${brand}. Digite este código para verificar seu e-mail e criar sua conta.

 

${code}

 

Se você tiver alguma dúvida, por favor, entre em contato conosco.

Política de privacidade e termos de uso · Reportar uso indevido
${copyright}. TODOS OS DIREITOS RESERVADOS.

                                                           
\ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/pt/user/email/verification.txt b/services/brig/deb/opt/brig/templates/pt/user/email/verification.txt new file mode 100644 index 00000000000..c0b0003e06b --- /dev/null +++ b/services/brig/deb/opt/brig/templates/pt/user/email/verification.txt @@ -0,0 +1,18 @@ +[${brand_logo}] + +${brand_label_url} [${brand_url}] + +VERIFIQUE SEU E-MAIL +${email} foi usado para se registrar no ${brand}. Digite este código para +verificar seu e-mail e criar sua conta. + +${code} + +Se você tiver alguma dúvida, por favor, entre em contato conosco [${support}]. + + +-------------------------------------------------------------------------------- + +Política de privacidade e termos de uso [${legal}] · Reportar uso indevido +[${misuse}] +${copyright}. TODOS OS DIREITOS RESERVADOS. \ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/pt/user/sms/activation.txt b/services/brig/deb/opt/brig/templates/pt/user/sms/activation.txt new file mode 100644 index 00000000000..520eb63c92d --- /dev/null +++ b/services/brig/deb/opt/brig/templates/pt/user/sms/activation.txt @@ -0,0 +1,3 @@ +Seu código ${brand} é ${code}. + +Acesse ${url} para verificar seu número. diff --git a/services/brig/deb/opt/brig/templates/pt/user/sms/deletion.txt b/services/brig/deb/opt/brig/templates/pt/user/sms/deletion.txt new file mode 100644 index 00000000000..7faf69e6639 --- /dev/null +++ b/services/brig/deb/opt/brig/templates/pt/user/sms/deletion.txt @@ -0,0 +1,2 @@ +Toque para excluir sua conta no ${brand}. +${url} diff --git a/services/brig/deb/opt/brig/templates/pt/user/sms/login.txt b/services/brig/deb/opt/brig/templates/pt/user/sms/login.txt new file mode 100644 index 00000000000..ef5e8fd5d16 --- /dev/null +++ b/services/brig/deb/opt/brig/templates/pt/user/sms/login.txt @@ -0,0 +1,3 @@ +Seu código de login ${brand} é ${code}. + +Acesse ${url} para entrar. diff --git a/services/brig/deb/opt/brig/templates/pt/user/sms/password-reset.txt b/services/brig/deb/opt/brig/templates/pt/user/sms/password-reset.txt new file mode 100644 index 00000000000..3667edd333c --- /dev/null +++ b/services/brig/deb/opt/brig/templates/pt/user/sms/password-reset.txt @@ -0,0 +1,3 @@ +Seu código de recuperação ${brand} é ${code}. + +Use este código para concluir a redefinição de senha. diff --git a/services/brig/deb/opt/brig/templates/ru/user/email/activation.html b/services/brig/deb/opt/brig/templates/ru/user/email/activation.html index 01de6edfd88..8470a280639 100644 --- a/services/brig/deb/opt/brig/templates/ru/user/email/activation.html +++ b/services/brig/deb/opt/brig/templates/ru/user/email/activation.html @@ -1 +1 @@ -Ваша учетная запись ${brand}

${brand_label_url}

Подтвердите ваш email

${email} был использован для регистрации в ${brand}.
Нажмите на кнопку для подтверждения вашего email адреса.

 
Подтвердить
 

Если вы не можете нажать на кнопку, скопируйте и вставьте эту ссылку в свой браузер:

${url}

Если у вас возникли вопросы или нужна помощь, пожалуйста свяжитесь с нами.

Политика конфиденциальности и условия использования · Сообщить о злоупотреблении
${copyright}. ВСЕ ПРАВА РЕЗЕРВЕННЫ.

                                                           
\ No newline at end of file +Ваша учетная запись ${brand}

${brand_label_url}

Подтвердите ваш email

${email} был использован для регистрации в ${brand}.
Нажмите на кнопку для подтверждения вашего email адреса.

 
Подтвердить
 

Если вы не можете нажать на кнопку, скопируйте и вставьте эту ссылку в свой браузер:

${url}

Если у вас возникли вопросы или нужна помощь, пожалуйста свяжитесь с нами.

Политика конфиденциальности и условия использования · Сообщить о злоупотреблении
${copyright}. ВСЕ ПРАВА РЕЗЕРВЕННЫ.

                                                           
\ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/ru/user/email/deletion.html b/services/brig/deb/opt/brig/templates/ru/user/email/deletion.html index 2066c270ddb..cb4f186bde7 100644 --- a/services/brig/deb/opt/brig/templates/ru/user/email/deletion.html +++ b/services/brig/deb/opt/brig/templates/ru/user/email/deletion.html @@ -1 +1 @@ -Удалить учетную запись?

${brand_label_url}

Удалить учетную запись

Мы получили запрос на удаление вашего аккаунта ${brand}. Нажмите на кнопку ниже в течение 10 минут для удаления всех ваших разговоров, контента и контактов.

 
Удалить учетную запись
 

Если вы не можете нажать на кнопку, скопируйте и вставьте эту ссылку в свой браузер:

${url}

Если вы не запрашивали удаление вашего аккаунта, то сбросьте ваш пароль.

Если у вас возникли вопросы или нужна помощь, пожалуйста свяжитесь с нами.

Политика конфиденциальности и условия использования · Сообщить о злоупотреблении
${copyright}. ВСЕ ПРАВА РЕЗЕРВЕННЫ.

                                                           
\ No newline at end of file +Удалить учетную запись?

${brand_label_url}

Удалить учетную запись

Мы получили запрос на удаление вашего аккаунта ${brand}. Нажмите на кнопку ниже в течение 10 минут для удаления всех ваших разговоров, контента и контактов.

 
Удалить учетную запись
 

Если вы не можете нажать на кнопку, скопируйте и вставьте эту ссылку в свой браузер:

${url}

Если вы не запрашивали удаление вашего аккаунта, то сбросьте ваш пароль.

Если у вас возникли вопросы или нужна помощь, пожалуйста свяжитесь с нами.

Политика конфиденциальности и условия использования · Сообщить о злоупотреблении
${copyright}. ВСЕ ПРАВА РЕЗЕРВЕННЫ.

                                                           
\ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/ru/user/email/new-client.html b/services/brig/deb/opt/brig/templates/ru/user/email/new-client.html index b3f8669542d..6c111e2c508 100644 --- a/services/brig/deb/opt/brig/templates/ru/user/email/new-client.html +++ b/services/brig/deb/opt/brig/templates/ru/user/email/new-client.html @@ -1 +1 @@ -Новое устройство

${brand_label_url}

Новое устройство

Ваша учетная запись ${brand} использовалась на:

${date}

${model}

Возможно, вы установили ${brand} на новом устройстве или переустановили его на одном из уже используемых ранее. Если это не так, перейдите в настройки ${brand}, удалите это устройство из списка и сбросьте ваш пароль.

Если у вас возникли вопросы или нужна помощь, пожалуйста свяжитесь с нами.

Политика конфиденциальности и условия использования · Сообщить о злоупотреблении
${copyright}. ВСЕ ПРАВА РЕЗЕРВЕННЫ.

                                                           
\ No newline at end of file +Новое устройство

${brand_label_url}

Новое устройство

Ваша учетная запись ${brand} использовалась на:

${date}

${model}

Возможно, вы установили ${brand} на новое устройство или повторно установили его на существующее. Если это не так, перейдите в настройки ${brand}, удалите это устройство из списка и сбросьте пароль.

Если у вас возникли вопросы или нужна помощь, пожалуйста свяжитесь с нами.

Политика конфиденциальности и условия использования · Сообщить о злоупотреблении
${copyright}. ВСЕ ПРАВА РЕЗЕРВЕННЫ.

                                                           
\ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/ru/user/email/new-client.txt b/services/brig/deb/opt/brig/templates/ru/user/email/new-client.txt index fade67d1c4f..1bc94a85aca 100644 --- a/services/brig/deb/opt/brig/templates/ru/user/email/new-client.txt +++ b/services/brig/deb/opt/brig/templates/ru/user/email/new-client.txt @@ -9,9 +9,9 @@ ${date} ${model} -Возможно, вы установили ${brand} на новом устройстве или переустановили его на -одном из уже используемых ранее. Если это не так, перейдите в настройки -${brand}, удалите это устройство из списка и сбросьте ваш пароль [${forgot}]. +Возможно, вы установили ${brand} на новое устройство или повторно установили его +на существующее. Если это не так, перейдите в настройки ${brand}, удалите это +устройство из списка и сбросьте пароль [${forgot}]. Если у вас возникли вопросы или нужна помощь, пожалуйста свяжитесь с нами [${support}]. diff --git a/services/brig/deb/opt/brig/templates/ru/user/email/password-reset.html b/services/brig/deb/opt/brig/templates/ru/user/email/password-reset.html index 3ee9646f58c..fd2ea12f9ce 100644 --- a/services/brig/deb/opt/brig/templates/ru/user/email/password-reset.html +++ b/services/brig/deb/opt/brig/templates/ru/user/email/password-reset.html @@ -1 +1 @@ -Смена пароля в ${brand}

${brand_label_url}

Сбросить пароль

Мы получили запрос на сброс пароля для вашей учетной записи ${brand}. Чтобы создать новый пароль нажмите на кнопку ниже.

 
Сбросить пароль
 

Если вы не можете нажать на кнопку, скопируйте и вставьте эту ссылку в свой браузер:

${url}

Если у вас возникли вопросы или нужна помощь, пожалуйста свяжитесь с нами.

Политика конфиденциальности и условия использования · Сообщить о злоупотреблении
${copyright}. ВСЕ ПРАВА РЕЗЕРВЕННЫ.

                                                           
\ No newline at end of file +Смена пароля в ${brand}

${brand_label_url}

Сбросить пароль

Мы получили запрос на сброс пароля для вашей учетной записи ${brand}. Чтобы создать новый пароль нажмите на кнопку ниже.

 
Сбросить пароль
 

Если вы не можете нажать на кнопку, скопируйте и вставьте эту ссылку в свой браузер:

${url}

Если у вас возникли вопросы или нужна помощь, пожалуйста свяжитесь с нами.

Политика конфиденциальности и условия использования · Сообщить о злоупотреблении
${copyright}. ВСЕ ПРАВА РЕЗЕРВЕННЫ.

                                                           
\ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/ru/user/email/team-activation.html b/services/brig/deb/opt/brig/templates/ru/user/email/team-activation.html index 4543331120e..8302577b73e 100644 --- a/services/brig/deb/opt/brig/templates/ru/user/email/team-activation.html +++ b/services/brig/deb/opt/brig/templates/ru/user/email/team-activation.html @@ -1 +1 @@ -Ваша учетная запись ${brand}

${brand_label_url}

Ваша новая учетная запись ${brand}

В ${brand} была создана новая команда с использованием email адреса ${email}. Подтвердите ваш email адрес.

 
Подтвердить
 

Если вы не можете нажать на кнопку, скопируйте и вставьте эту ссылку в свой браузер:

${url}

Если у вас возникли вопросы или нужна помощь, пожалуйста свяжитесь с нами.

Политика конфиденциальности и условия использования · Сообщить о злоупотреблении
${copyright}. ВСЕ ПРАВА РЕЗЕРВЕННЫ.

                                                           
\ No newline at end of file +Ваша учетная запись ${brand}

${brand_label_url}

Ваша новая учетная запись ${brand}

В ${brand} была создана новая команда с использованием email адреса ${email}. Подтвердите ваш email адрес.

 
Подтвердить
 

Если вы не можете нажать на кнопку, скопируйте и вставьте эту ссылку в свой браузер:

${url}

Если у вас возникли вопросы или нужна помощь, пожалуйста свяжитесь с нами.

Политика конфиденциальности и условия использования · Сообщить о злоупотреблении
${copyright}. ВСЕ ПРАВА РЕЗЕРВЕННЫ.

                                                           
\ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/ru/user/email/team-activation.txt b/services/brig/deb/opt/brig/templates/ru/user/email/team-activation.txt index bde3eda6113..9ea2873c2f4 100644 --- a/services/brig/deb/opt/brig/templates/ru/user/email/team-activation.txt +++ b/services/brig/deb/opt/brig/templates/ru/user/email/team-activation.txt @@ -2,7 +2,7 @@ ${brand_label_url} [${brand_url}] -ВАША НОВАЯ УЧЕТНАЯ ЗАПИСЬ ${brand} +ВАША НОВАЯ УЧЕТНАЯ ЗАПИСЬ ${BRAND} В ${brand} была создана новая команда с использованием email адреса ${email}. Подтвердите ваш email адрес. diff --git a/services/brig/deb/opt/brig/templates/ru/user/email/update.html b/services/brig/deb/opt/brig/templates/ru/user/email/update.html index 64122ef00b6..36577320f83 100644 --- a/services/brig/deb/opt/brig/templates/ru/user/email/update.html +++ b/services/brig/deb/opt/brig/templates/ru/user/email/update.html @@ -1 +1 @@ -Ваш новый email адрес в ${brand}

${brand_label_url}

Подтвердите ваш email адрес

${email} был указан как ваш новый email адрес в ${brand}. Нажмите на кнопку ниже для подтверждения своего адреса.

 
Подтвердить
 

Если вы не можете нажать на кнопку, скопируйте и вставьте эту ссылку в свой браузер:

${url}

Если у вас возникли вопросы или нужна помощь, пожалуйста свяжитесь с нами.

Политика конфиденциальности и условия использования · Сообщить о злоупотреблении
${copyright}. ВСЕ ПРАВА РЕЗЕРВЕННЫ.

                                                           
\ No newline at end of file +Ваш новый email адрес в ${brand}

${brand_label_url}

Подтвердите ваш email адрес

${email} был указан как ваш новый email адрес в ${brand}. Нажмите на кнопку ниже для подтверждения своего адреса.

 
Подтвердить
 

Если вы не можете нажать на кнопку, скопируйте и вставьте эту ссылку в свой браузер:

${url}

Если у вас возникли вопросы или нужна помощь, пожалуйста свяжитесь с нами.

Политика конфиденциальности и условия использования · Сообщить о злоупотреблении
${copyright}. ВСЕ ПРАВА РЕЗЕРВЕННЫ.

                                                           
\ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/ru/user/email/verification-delete-team-subject.txt b/services/brig/deb/opt/brig/templates/ru/user/email/verification-delete-team-subject.txt index e69de29bb2d..1cb058df873 100644 --- a/services/brig/deb/opt/brig/templates/ru/user/email/verification-delete-team-subject.txt +++ b/services/brig/deb/opt/brig/templates/ru/user/email/verification-delete-team-subject.txt @@ -0,0 +1 @@ +ваш код подтверждения ${brand} - ${code} \ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/ru/user/email/verification-delete-team.html b/services/brig/deb/opt/brig/templates/ru/user/email/verification-delete-team.html index 8023ee5b7b5..81d0a92e4b3 100644 --- a/services/brig/deb/opt/brig/templates/ru/user/email/verification-delete-team.html +++ b/services/brig/deb/opt/brig/templates/ru/user/email/verification-delete-team.html @@ -1 +1 @@ -

${brand_label_url}

Подтвердить удаление команды

${email} был использован для удаления вашей команды ${brand}. Введите этот код для подтверждения электронной почты и удаления команды.

 

${code}

 

Если у вас возникли вопросы или нужна помощь, пожалуйста свяжитесь с нами.

Политика конфиденциальности и условия использования · Сообщить о злоупотреблении
${copyright}. ВСЕ ПРАВА РЕЗЕРВЕННЫ.

                                                           
\ No newline at end of file +ваш код подтверждения ${brand} - ${code}

${brand_label_url}

Подтвердить удаление команды

${email} был использован для удаления вашей команды ${brand}. Введите этот код для подтверждения электронной почты и удаления команды.

 

${code}

 

Если у вас возникли вопросы или нужна помощь, пожалуйста свяжитесь с нами.

Политика конфиденциальности и условия использования · Сообщить о злоупотреблении
${copyright}. ВСЕ ПРАВА РЕЗЕРВЕННЫ.

                                                           
\ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/ru/user/email/verification-login-subject.txt b/services/brig/deb/opt/brig/templates/ru/user/email/verification-login-subject.txt index e69de29bb2d..1cb058df873 100644 --- a/services/brig/deb/opt/brig/templates/ru/user/email/verification-login-subject.txt +++ b/services/brig/deb/opt/brig/templates/ru/user/email/verification-login-subject.txt @@ -0,0 +1 @@ +ваш код подтверждения ${brand} - ${code} \ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/ru/user/email/verification-login.html b/services/brig/deb/opt/brig/templates/ru/user/email/verification-login.html index 07664a34a3b..3124ff0691b 100644 --- a/services/brig/deb/opt/brig/templates/ru/user/email/verification-login.html +++ b/services/brig/deb/opt/brig/templates/ru/user/email/verification-login.html @@ -1 +1 @@ -

${brand_label_url}

Подтвердить вход

${email} был использован для входа в ${brand}. Введите этот код для подтверждения электронной почты и авторизации в вашем аккаунте.

 

${code}

 

Если у вас возникли вопросы или нужна помощь, пожалуйста свяжитесь с нами.

Политика конфиденциальности и условия использования · Сообщить о злоупотреблении
${copyright}. ВСЕ ПРАВА РЕЗЕРВЕННЫ.

                                                           
\ No newline at end of file +ваш код подтверждения ${brand} - ${code}

${brand_label_url}

Подтвердить вход

${email} был использован для входа в ${brand}. Введите этот код для подтверждения электронной почты и авторизации в вашем аккаунте.

 

${code}

 

Если у вас возникли вопросы или нужна помощь, пожалуйста свяжитесь с нами.

Политика конфиденциальности и условия использования · Сообщить о злоупотреблении
${copyright}. ВСЕ ПРАВА РЕЗЕРВЕННЫ.

                                                           
\ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/ru/user/email/verification-scim-token-subject.txt b/services/brig/deb/opt/brig/templates/ru/user/email/verification-scim-token-subject.txt index e69de29bb2d..1cb058df873 100644 --- a/services/brig/deb/opt/brig/templates/ru/user/email/verification-scim-token-subject.txt +++ b/services/brig/deb/opt/brig/templates/ru/user/email/verification-scim-token-subject.txt @@ -0,0 +1 @@ +ваш код подтверждения ${brand} - ${code} \ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/ru/user/email/verification-scim-token.html b/services/brig/deb/opt/brig/templates/ru/user/email/verification-scim-token.html index 525d031dbe3..84348b41109 100644 --- a/services/brig/deb/opt/brig/templates/ru/user/email/verification-scim-token.html +++ b/services/brig/deb/opt/brig/templates/ru/user/email/verification-scim-token.html @@ -1 +1 @@ -

${brand_label_url}

Подтвердить создание токена SCIM

${email} был использован для создания токена SCIM. Введите этот код для подтверждения электронной почты и создания токена SCIM.

 

${code}

 

Если у вас возникли вопросы или нужна помощь, пожалуйста свяжитесь с нами.

Политика конфиденциальности и условия использования · Сообщить о злоупотреблении
${copyright}. ВСЕ ПРАВА РЕЗЕРВЕННЫ.

                                                           
\ No newline at end of file +ваш код подтверждения ${brand} - ${code}

${brand_label_url}

Подтвердить создание токена SCIM

${email} был использован для создания токена SCIM. Введите этот код для подтверждения электронной почты и создания токена SCIM.

 

${code}

 

Если у вас возникли вопросы или нужна помощь, пожалуйста свяжитесь с нами.

Политика конфиденциальности и условия использования · Сообщить о злоупотреблении
${copyright}. ВСЕ ПРАВА РЕЗЕРВЕННЫ.

                                                           
\ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/ru/user/email/verification.html b/services/brig/deb/opt/brig/templates/ru/user/email/verification.html index 8bd5beb8fbf..d8cbb110703 100644 --- a/services/brig/deb/opt/brig/templates/ru/user/email/verification.html +++ b/services/brig/deb/opt/brig/templates/ru/user/email/verification.html @@ -1 +1 @@ -${code} - это код подтверждения ${brand}

${brand_label_url}

Подтвердите ваш email

${email} был использован для регистрации в ${brand}. Введите этот код для подтверждения email и создания учетной записи.

 

${code}

 

Если у вас возникли вопросы или нужна помощь, пожалуйста свяжитесь с нами.

Политика конфиденциальности и условия использования · Сообщить о злоупотреблении
${copyright}. ВСЕ ПРАВА РЕЗЕРВЕННЫ.

                                                           
\ No newline at end of file +${code} - это код подтверждения ${brand}

${brand_label_url}

Подтвердите ваш email

${email} был использован для регистрации в ${brand}. Введите этот код для подтверждения email и создания учетной записи.

 

${code}

 

Если у вас возникли вопросы или нужна помощь, пожалуйста свяжитесь с нами.

Политика конфиденциальности и условия использования · Сообщить о злоупотреблении
${copyright}. ВСЕ ПРАВА РЕЗЕРВЕННЫ.

                                                           
\ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/si/user/call/activation.txt b/services/brig/deb/opt/brig/templates/si/user/call/activation.txt new file mode 100644 index 00000000000..c7754ab63c1 --- /dev/null +++ b/services/brig/deb/opt/brig/templates/si/user/call/activation.txt @@ -0,0 +1 @@ +ආයුබෝවන්, ඔබගේ වයර් සත්‍යාපන කේතය: ${code}. නැවත වරක්, ඔබගේ කේතය: ${code} \ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/si/user/call/login.txt b/services/brig/deb/opt/brig/templates/si/user/call/login.txt new file mode 100644 index 00000000000..ccb91205ee0 --- /dev/null +++ b/services/brig/deb/opt/brig/templates/si/user/call/login.txt @@ -0,0 +1 @@ +ආයුබෝවන්, ඔබගේ වයර් කේතය: ${code}. නැවත වරක්, ඔබගේ කේතය: ${code} \ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/si/user/email/activation-subject.txt b/services/brig/deb/opt/brig/templates/si/user/email/activation-subject.txt new file mode 100644 index 00000000000..f6c88ca3390 --- /dev/null +++ b/services/brig/deb/opt/brig/templates/si/user/email/activation-subject.txt @@ -0,0 +1 @@ +ඔබගේ ${brand} ගිණුම \ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/si/user/email/activation.html b/services/brig/deb/opt/brig/templates/si/user/email/activation.html new file mode 100644 index 00000000000..5469f094995 --- /dev/null +++ b/services/brig/deb/opt/brig/templates/si/user/email/activation.html @@ -0,0 +1 @@ +ඔබගේ ${brand} ගිණුම

${brand_label_url}

ඔබගේ වි-තැපෑල සත්‍යාපනය කරන්න

${brand} හි ලියාපදිංචියට ${email} භාවිතා කර ඇත.
ඔබගේ ලිපිනය සත්‍යාපනයට පහත බොත්තම ඔබන්න.

 
සත්‍යාපනය
 

බොත්තම එබීමට නොහැකි නම් මෙම සබැඳිය පිටපත් කර ඔබගේ අතිරික්සුවෙහි අලවන්න:

${url}

ඔබට කිසියම් ප්‍රශ්නයක් ඇත්නම් කරුණාකර අප අමතන්න.

රහස්‍යතා ප්‍රතිපත්තිය සහ භාවිත නියම · අවභාවිතය වාර්තා කරන්න
${copyright}. සියළුම හිමිකම් ඇවිරිණි.

                                                           
\ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/si/user/email/activation.txt b/services/brig/deb/opt/brig/templates/si/user/email/activation.txt new file mode 100644 index 00000000000..bab1d042dc5 --- /dev/null +++ b/services/brig/deb/opt/brig/templates/si/user/email/activation.txt @@ -0,0 +1,21 @@ +[${brand_logo}] + +${brand_label_url} [${brand_url}] + +ඔබගේ වි-තැපෑල සත්‍යාපනය කරන්න +${brand} හි ලියාපදිංචියට ${email} භාවිතා කර ඇත. +ඔබගේ ලිපිනය සත්‍යාපනයට පහත බොත්තම ඔබන්න. + +සත්‍යාපනය [${url}]බොත්තම එබීමට නොහැකි නම් මෙම සබැඳිය පිටපත් කර ඔබගේ +අතිරික්සුවෙහි අලවන්න: + +${url} + +ඔබට කිසියම් ප්‍රශ්නයක් ඇත්නම් කරුණාකර අප අමතන්න [${support}]. + + +-------------------------------------------------------------------------------- + +රහස්‍යතා ප්‍රතිපත්තිය සහ භාවිත නියම [${legal}] · අවභාවිතය වාර්තා කරන්න +[${misuse}] +${copyright}. සියළුම හිමිකම් ඇවිරිණි. \ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/si/user/email/deletion-subject.txt b/services/brig/deb/opt/brig/templates/si/user/email/deletion-subject.txt new file mode 100644 index 00000000000..4d3a96064c0 --- /dev/null +++ b/services/brig/deb/opt/brig/templates/si/user/email/deletion-subject.txt @@ -0,0 +1 @@ +ගිණුම මකනවාද? \ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/si/user/email/deletion.html b/services/brig/deb/opt/brig/templates/si/user/email/deletion.html new file mode 100644 index 00000000000..6852a1f7796 --- /dev/null +++ b/services/brig/deb/opt/brig/templates/si/user/email/deletion.html @@ -0,0 +1 @@ +ගිණුම මකනවාද?

${brand_label_url}

ඔබගේ ගිණුම මකන්න

ඔබගේ ${brand} ගිණුම මැකීම සඳහා අපට ඉල්ලීමක් ලැබුණි. ඔබගේ සියළුම සංවාද, අන්තර්ගත සහ සම්බන්ධතා මැකීමට විනාඩි 10 ක් ඇතුළත පහත බොත්තම ඔබන්න.

 
ගිණුම මකන්න
 

බොත්තම එබීමට නොහැකි නම් මෙම සබැඳිය පිටපත් කර ඔබගේ අතිරික්සුවෙහි අලවන්න:

${url}

ඔබ මෙය ඉල්ලුවේ නැති නම්, මුරපදය යළි සකසන්න.

ඔබට කිසියම් ප්‍රශ්නයක් ඇත්නම් කරුණාකර අප අමතන්න.

රහස්‍යතා ප්‍රතිපත්තිය සහ භාවිත නියම · අවභාවිතය වාර්තා කරන්න
${copyright}. සියළුම හිමිකම් ඇවිරිණි.

                                                           
\ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/si/user/email/deletion.txt b/services/brig/deb/opt/brig/templates/si/user/email/deletion.txt new file mode 100644 index 00000000000..07207417957 --- /dev/null +++ b/services/brig/deb/opt/brig/templates/si/user/email/deletion.txt @@ -0,0 +1,23 @@ +[${brand_logo}] + +${brand_label_url} [${brand_url}] + +ඔබගේ ගිණුම මකන්න +ඔබගේ ${brand} ගිණුම මැකීම සඳහා අපට ඉල්ලීමක් ලැබුණි. ඔබගේ සියළුම සංවාද, අන්තර්ගත +සහ සම්බන්ධතා මැකීමට විනාඩි 10 ක් ඇතුළත පහත බොත්තම ඔබන්න. + +ගිණුම මකන්න [${url}]බොත්තම එබීමට නොහැකි නම් මෙම සබැඳිය පිටපත් කර ඔබගේ +අතිරික්සුවෙහි අලවන්න: + +${url} + +ඔබ මෙය ඉල්ලුවේ නැති නම්, මුරපදය යළි සකසන්න [${forgot}]. + +ඔබට කිසියම් ප්‍රශ්නයක් ඇත්නම් කරුණාකර අප අමතන්න [${support}]. + + +-------------------------------------------------------------------------------- + +රහස්‍යතා ප්‍රතිපත්තිය සහ භාවිත නියම [${legal}] · අවභාවිතය වාර්තා කරන්න +[${misuse}] +${copyright}. සියළුම හිමිකම් ඇවිරිණි. \ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/si/user/email/new-client-subject.txt b/services/brig/deb/opt/brig/templates/si/user/email/new-client-subject.txt new file mode 100644 index 00000000000..342354069fa --- /dev/null +++ b/services/brig/deb/opt/brig/templates/si/user/email/new-client-subject.txt @@ -0,0 +1 @@ +නව උපාංගය \ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/si/user/email/new-client.html b/services/brig/deb/opt/brig/templates/si/user/email/new-client.html new file mode 100644 index 00000000000..4147eaec097 --- /dev/null +++ b/services/brig/deb/opt/brig/templates/si/user/email/new-client.html @@ -0,0 +1 @@ +නව උපාංගය

${brand_label_url}

නව උපාංගය

ඔබගේ ${brand} ගිණුම භාවිතා වී ඇත:

${date}

${model}

ඔබ නව උපාංගයක හෝ පැවති උපාංගයක නැවත ${brand} ස්ථාපනය කර ඇත. මෙය අනපේක්‍ෂිත නම්, ${brand} සැකසුම් වෙත ගොස්, උපාංගය ඉවත් කර මුරපදය යළි සකසන්න.

ඔබට කිසියම් ප්‍රශ්නයක් ඇත්නම් කරුණාකර අප අමතන්න.

රහස්‍යතා ප්‍රතිපත්තිය සහ භාවිත නියම · අවභාවිතය වාර්තා කරන්න
${copyright}. සියළුම හිමිකම් ඇවිරිණි.

                                                           
\ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/si/user/email/new-client.txt b/services/brig/deb/opt/brig/templates/si/user/email/new-client.txt new file mode 100644 index 00000000000..bd6267e1a37 --- /dev/null +++ b/services/brig/deb/opt/brig/templates/si/user/email/new-client.txt @@ -0,0 +1,22 @@ +[${brand_logo}] + +${brand_label_url} [${brand_url}] + +නව උපාංගය +ඔබගේ ${brand} ගිණුම භාවිතා වී ඇත: + +${date} + +${model} + +ඔබ නව උපාංගයක හෝ පැවති උපාංගයක නැවත ${brand} ස්ථාපනය කර ඇත. මෙය අනපේක්‍ෂිත නම්, +${brand} සැකසුම් වෙත ගොස්, උපාංගය ඉවත් කර මුරපදය යළි සකසන්න [${forgot}]. + +ඔබට කිසියම් ප්‍රශ්නයක් ඇත්නම් කරුණාකර අප අමතන්න [${support}]. + + +-------------------------------------------------------------------------------- + +රහස්‍යතා ප්‍රතිපත්තිය සහ භාවිත නියම [${legal}] · අවභාවිතය වාර්තා කරන්න +[${misuse}] +${copyright}. සියළුම හිමිකම් ඇවිරිණි. \ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/si/user/email/password-reset-subject.txt b/services/brig/deb/opt/brig/templates/si/user/email/password-reset-subject.txt new file mode 100644 index 00000000000..08edd4bae53 --- /dev/null +++ b/services/brig/deb/opt/brig/templates/si/user/email/password-reset-subject.txt @@ -0,0 +1 @@ +${brand} මුරපදය වෙනස් කිරීම \ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/si/user/email/password-reset.html b/services/brig/deb/opt/brig/templates/si/user/email/password-reset.html new file mode 100644 index 00000000000..fd5fe0d1863 --- /dev/null +++ b/services/brig/deb/opt/brig/templates/si/user/email/password-reset.html @@ -0,0 +1 @@ +${brand} මුරපදය වෙනස් කිරීම

${brand_label_url}

මුරපදය යළි සකසන්න

ඔබගේ ${brand} ගිණුමේ මුරපදය යළි සැකසීම සඳහා අපට ඉල්ලීමක් ලැබුණි. නව මුරපදයක් සෑදීමට පහත බොත්තම ඔබන්න.

 
මුරපදය යළි සකසන්න
 

බොත්තම එබීමට නොහැකි නම් මෙම සබැඳිය පිටපත් කර ඔබගේ අතිරික්සුවෙහි අලවන්න:

${url}

ඔබට කිසියම් ප්‍රශ්නයක් ඇත්නම් කරුණාකර අප අමතන්න.

රහස්‍යතා ප්‍රතිපත්තිය සහ භාවිත නියම · අවභාවිතය වාර්තා කරන්න
${copyright}. සියළුම හිමිකම් ඇවිරිණි.

                                                           
\ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/si/user/email/password-reset.txt b/services/brig/deb/opt/brig/templates/si/user/email/password-reset.txt new file mode 100644 index 00000000000..fddd05d4af4 --- /dev/null +++ b/services/brig/deb/opt/brig/templates/si/user/email/password-reset.txt @@ -0,0 +1,21 @@ +[${brand_logo}] + +${brand_label_url} [${brand_url}] + +මුරපදය යළි සකසන්න +ඔබගේ ${brand} ගිණුමේ මුරපදය යළි සැකසීම සඳහා අපට ඉල්ලීමක් ලැබුණි. නව මුරපදයක් +සෑදීමට පහත බොත්තම ඔබන්න. + +මුරපදය යළි සකසන්න [${url}]බොත්තම එබීමට නොහැකි නම් මෙම සබැඳිය පිටපත් කර ඔබගේ +අතිරික්සුවෙහි අලවන්න: + +${url} + +ඔබට කිසියම් ප්‍රශ්නයක් ඇත්නම් කරුණාකර අප අමතන්න [${support}]. + + +-------------------------------------------------------------------------------- + +රහස්‍යතා ප්‍රතිපත්තිය සහ භාවිත නියම [${legal}] · අවභාවිතය වාර්තා කරන්න +[${misuse}] +${copyright}. සියළුම හිමිකම් ඇවිරිණි. \ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/si/user/email/team-activation-subject.txt b/services/brig/deb/opt/brig/templates/si/user/email/team-activation-subject.txt new file mode 100644 index 00000000000..c9eab6a756d --- /dev/null +++ b/services/brig/deb/opt/brig/templates/si/user/email/team-activation-subject.txt @@ -0,0 +1 @@ +${brand} ගිණුම \ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/si/user/email/team-activation.html b/services/brig/deb/opt/brig/templates/si/user/email/team-activation.html new file mode 100644 index 00000000000..7017f3c8545 --- /dev/null +++ b/services/brig/deb/opt/brig/templates/si/user/email/team-activation.html @@ -0,0 +1 @@ +${brand} ගිණුම

${brand_label_url}

ඔබගේ නව ${brand} ගිණුම

${email} සමඟ නව ${brand} කණ්ඩායමක් සාදා ඇත. ඔබගේ වි-තැපෑල සත්‍යාපනය කරන්න.

 
සත්‍යාපනය
 

බොත්තම එබීමට නොහැකි නම් මෙම සබැඳිය පිටපත් කර ඔබගේ අතිරික්සුවෙහි අලවන්න:

${url}

ඔබට කිසියම් ප්‍රශ්නයක් ඇත්නම් කරුණාකර අප අමතන්න.

රහස්‍යතා ප්‍රතිපත්තිය සහ භාවිත නියම · අවභාවිතය වාර්තා කරන්න
${copyright}. සියළුම හිමිකම් ඇවිරිණි.

                                                           
\ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/si/user/email/team-activation.txt b/services/brig/deb/opt/brig/templates/si/user/email/team-activation.txt new file mode 100644 index 00000000000..520e00970c2 --- /dev/null +++ b/services/brig/deb/opt/brig/templates/si/user/email/team-activation.txt @@ -0,0 +1,20 @@ +[${brand_logo}] + +${brand_label_url} [${brand_url}] + +ඔබගේ නව ${BRAND} ගිණුම +${email} සමඟ නව ${brand} කණ්ඩායමක් සාදා ඇත. ඔබගේ වි-තැපෑල සත්‍යාපනය කරන්න. + +සත්‍යාපනය [${url}]බොත්තම එබීමට නොහැකි නම් මෙම සබැඳිය පිටපත් කර ඔබගේ +අතිරික්සුවෙහි අලවන්න: + +${url} + +ඔබට කිසියම් ප්‍රශ්නයක් ඇත්නම් කරුණාකර අප අමතන්න [${support}]. + + +-------------------------------------------------------------------------------- + +රහස්‍යතා ප්‍රතිපත්තිය සහ භාවිත නියම [${legal}] · අවභාවිතය වාර්තා කරන්න +[${misuse}] +${copyright}. සියළුම හිමිකම් ඇවිරිණි. \ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/si/user/email/update-subject.txt b/services/brig/deb/opt/brig/templates/si/user/email/update-subject.txt new file mode 100644 index 00000000000..9293ee6b3a0 --- /dev/null +++ b/services/brig/deb/opt/brig/templates/si/user/email/update-subject.txt @@ -0,0 +1 @@ +${brand} සඳහා නව වි-තැපැල් ලිපිනය \ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/si/user/email/update.html b/services/brig/deb/opt/brig/templates/si/user/email/update.html new file mode 100644 index 00000000000..a0ad8cff780 --- /dev/null +++ b/services/brig/deb/opt/brig/templates/si/user/email/update.html @@ -0,0 +1 @@ +${brand} සඳහා නව වි-තැපැල් ලිපිනය

${brand_label_url}

වි-තැපෑල සත්‍යාපනය කරන්න

ඔබගේ නව ${brand} වි-තැපැල් ලිපිනය ලෙස ${email} ලියාපදිංචි කර ඇත. ඔබගේ ලිපිනය සත්‍යාපනයට පහත බොත්තම ඔබන්න.

 
සත්‍යාපනය
 

බොත්තම එබීමට නොහැකි නම් මෙම සබැඳිය පිටපත් කර ඔබගේ අතිරික්සුවෙහි අලවන්න:

${url}

ඔබට කිසියම් ප්‍රශ්නයක් ඇත්නම් කරුණාකර අප අමතන්න.

රහස්‍යතා ප්‍රතිපත්තිය සහ භාවිත නියම · අවභාවිතය වාර්තා කරන්න
${copyright}. සියළුම හිමිකම් ඇවිරිණි.

                                                           
\ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/si/user/email/update.txt b/services/brig/deb/opt/brig/templates/si/user/email/update.txt new file mode 100644 index 00000000000..326cfeb0d08 --- /dev/null +++ b/services/brig/deb/opt/brig/templates/si/user/email/update.txt @@ -0,0 +1,21 @@ +[${brand_logo}] + +${brand_label_url} [${brand_url}] + +වි-තැපෑල සත්‍යාපනය කරන්න +ඔබගේ නව ${brand} වි-තැපැල් ලිපිනය ලෙස ${email} ලියාපදිංචි කර ඇත. ඔබගේ ලිපිනය +සත්‍යාපනයට පහත බොත්තම ඔබන්න. + +සත්‍යාපනය [${url}]බොත්තම එබීමට නොහැකි නම් මෙම සබැඳිය පිටපත් කර ඔබගේ +අතිරික්සුවෙහි අලවන්න: + +${url} + +ඔබට කිසියම් ප්‍රශ්නයක් ඇත්නම් කරුණාකර අප අමතන්න [${support}]. + + +-------------------------------------------------------------------------------- + +රහස්‍යතා ප්‍රතිපත්තිය සහ භාවිත නියම [${legal}] · අවභාවිතය වාර්තා කරන්න +[${misuse}] +${copyright}. සියළුම හිමිකම් ඇවිරිණි. \ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/si/user/email/verification-delete-team-subject.txt b/services/brig/deb/opt/brig/templates/si/user/email/verification-delete-team-subject.txt new file mode 100644 index 00000000000..d06bd22b906 --- /dev/null +++ b/services/brig/deb/opt/brig/templates/si/user/email/verification-delete-team-subject.txt @@ -0,0 +1 @@ +ඔබගේ ${brand} සත්‍යාපන කේතය ${code} වේ \ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/si/user/email/verification-delete-team.html b/services/brig/deb/opt/brig/templates/si/user/email/verification-delete-team.html new file mode 100644 index 00000000000..3c96f8daf21 --- /dev/null +++ b/services/brig/deb/opt/brig/templates/si/user/email/verification-delete-team.html @@ -0,0 +1 @@ +ඔබගේ ${brand} සත්‍යාපන කේතය ${code} වේ

${brand_label_url}

කණ්ඩායම මැකීම සත්‍යාපනය

ඔබගේ ${brand} කණ්ඩායම මැකීමට ${email} භාවිතා කර ඇත. වි-තැපෑල සත්‍යාපනයට හා කණ්ඩායම මැකීමට මෙම කේතය ඇතුල් කරන්න.

 

${code}

 

ඔබට කිසියම් ප්‍රශ්නයක් ඇත්නම් කරුණාකර අප අමතන්න.

රහස්‍යතා ප්‍රතිපත්තිය සහ භාවිත නියම · අවභාවිතය වාර්තා කරන්න
${copyright}. සියළුම හිමිකම් ඇවිරිණි.

                                                           
\ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/si/user/email/verification-delete-team.txt b/services/brig/deb/opt/brig/templates/si/user/email/verification-delete-team.txt new file mode 100644 index 00000000000..3660c00571c --- /dev/null +++ b/services/brig/deb/opt/brig/templates/si/user/email/verification-delete-team.txt @@ -0,0 +1,18 @@ +[${brand_logo}] + +${brand_label_url} [${brand_url}] + +කණ්ඩායම මැකීම සත්‍යාපනය +ඔබගේ ${brand} කණ්ඩායම මැකීමට ${email} භාවිතා කර ඇත. වි-තැපෑල සත්‍යාපනයට හා +කණ්ඩායම මැකීමට මෙම කේතය ඇතුල් කරන්න. + +${code} + +ඔබට කිසියම් ප්‍රශ්නයක් ඇත්නම් කරුණාකර අප අමතන්න [${support}]. + + +-------------------------------------------------------------------------------- + +රහස්‍යතා ප්‍රතිපත්තිය සහ භාවිත නියම [${legal}] · අවභාවිතය වාර්තා කරන්න +[${misuse}] +${copyright}. සියළුම හිමිකම් ඇවිරිණි. \ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/si/user/email/verification-login-subject.txt b/services/brig/deb/opt/brig/templates/si/user/email/verification-login-subject.txt new file mode 100644 index 00000000000..d06bd22b906 --- /dev/null +++ b/services/brig/deb/opt/brig/templates/si/user/email/verification-login-subject.txt @@ -0,0 +1 @@ +ඔබගේ ${brand} සත්‍යාපන කේතය ${code} වේ \ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/si/user/email/verification-login.html b/services/brig/deb/opt/brig/templates/si/user/email/verification-login.html new file mode 100644 index 00000000000..e119b29c810 --- /dev/null +++ b/services/brig/deb/opt/brig/templates/si/user/email/verification-login.html @@ -0,0 +1 @@ +ඔබගේ ${brand} සත්‍යාපන කේතය ${code} වේ

${brand_label_url}

පිවිසුම සත්‍යාපනය

ඔබගේ ${brand} ගිණුමට පිවිසීම සඳහා ${email} භාවිතා කර ඇත. ඔබගේ වි-තැපෑල සත්‍යාපනයට සහ පිවිසීමට මෙම කේතය ඇතුල් කරන්න.

 

${code}

 

ඔබට කිසියම් ප්‍රශ්නයක් ඇත්නම් කරුණාකර අප අමතන්න.

රහස්‍යතා ප්‍රතිපත්තිය සහ භාවිත නියම · අවභාවිතය වාර්තා කරන්න
${copyright}. සියළුම හිමිකම් ඇවිරිණි.

                                                           
\ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/si/user/email/verification-login.txt b/services/brig/deb/opt/brig/templates/si/user/email/verification-login.txt new file mode 100644 index 00000000000..dab9e9a5fe4 --- /dev/null +++ b/services/brig/deb/opt/brig/templates/si/user/email/verification-login.txt @@ -0,0 +1,18 @@ +[${brand_logo}] + +${brand_label_url} [${brand_url}] + +පිවිසුම සත්‍යාපනය +ඔබගේ ${brand} ගිණුමට පිවිසීම සඳහා ${email} භාවිතා කර ඇත. ඔබගේ වි-තැපෑල +සත්‍යාපනයට සහ පිවිසීමට මෙම කේතය ඇතුල් කරන්න. + +${code} + +ඔබට කිසියම් ප්‍රශ්නයක් ඇත්නම් කරුණාකර අප අමතන්න [${support}]. + + +-------------------------------------------------------------------------------- + +රහස්‍යතා ප්‍රතිපත්තිය සහ භාවිත නියම [${legal}] · අවභාවිතය වාර්තා කරන්න +[${misuse}] +${copyright}. සියළුම හිමිකම් ඇවිරිණි. \ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/si/user/email/verification-scim-token-subject.txt b/services/brig/deb/opt/brig/templates/si/user/email/verification-scim-token-subject.txt new file mode 100644 index 00000000000..d06bd22b906 --- /dev/null +++ b/services/brig/deb/opt/brig/templates/si/user/email/verification-scim-token-subject.txt @@ -0,0 +1 @@ +ඔබගේ ${brand} සත්‍යාපන කේතය ${code} වේ \ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/si/user/email/verification-scim-token.html b/services/brig/deb/opt/brig/templates/si/user/email/verification-scim-token.html new file mode 100644 index 00000000000..fbb8d327a0f --- /dev/null +++ b/services/brig/deb/opt/brig/templates/si/user/email/verification-scim-token.html @@ -0,0 +1 @@ +ඔබගේ ${brand} සත්‍යාපන කේතය ${code} වේ

${brand_label_url}

SCIM නිමිත්ත සෑදීම සත්‍යාපනය

SCIM නිමිත්ත උත්පාදනයට ${email} භාවිතා කර ඇත. ඔබගේ වි-තැපැල් ලිපිනය සත්‍යාපනයට සහ නිමිත්ත සෑදීමට මෙම කේතය ඇතුල් කරන්න.

 

${code}

 

ඔබට කිසියම් ප්‍රශ්නයක් ඇත්නම් කරුණාකර අප අමතන්න.

රහස්‍යතා ප්‍රතිපත්තිය සහ භාවිත නියම · අවභාවිතය වාර්තා කරන්න
${copyright}. සියළුම හිමිකම් ඇවිරිණි.

                                                           
\ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/si/user/email/verification-scim-token.txt b/services/brig/deb/opt/brig/templates/si/user/email/verification-scim-token.txt new file mode 100644 index 00000000000..abb5f7c3b66 --- /dev/null +++ b/services/brig/deb/opt/brig/templates/si/user/email/verification-scim-token.txt @@ -0,0 +1,18 @@ +[${brand_logo}] + +${brand_label_url} [${brand_url}] + +SCIM නිමිත්ත සෑදීම සත්‍යාපනය +SCIM නිමිත්ත උත්පාදනයට ${email} භාවිතා කර ඇත. ඔබගේ වි-තැපැල් ලිපිනය සත්‍යාපනයට +සහ නිමිත්ත සෑදීමට මෙම කේතය ඇතුල් කරන්න. + +${code} + +ඔබට කිසියම් ප්‍රශ්නයක් ඇත්නම් කරුණාකර අප අමතන්න [${support}]. + + +-------------------------------------------------------------------------------- + +රහස්‍යතා ප්‍රතිපත්තිය සහ භාවිත නියම [${legal}] · අවභාවිතය වාර්තා කරන්න +[${misuse}] +${copyright}. සියළුම හිමිකම් ඇවිරිණි. \ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/si/user/email/verification-subject.txt b/services/brig/deb/opt/brig/templates/si/user/email/verification-subject.txt new file mode 100644 index 00000000000..d06bd22b906 --- /dev/null +++ b/services/brig/deb/opt/brig/templates/si/user/email/verification-subject.txt @@ -0,0 +1 @@ +ඔබගේ ${brand} සත්‍යාපන කේතය ${code} වේ \ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/si/user/email/verification.html b/services/brig/deb/opt/brig/templates/si/user/email/verification.html new file mode 100644 index 00000000000..0ea0bec7a07 --- /dev/null +++ b/services/brig/deb/opt/brig/templates/si/user/email/verification.html @@ -0,0 +1 @@ +ඔබගේ ${brand} සත්‍යාපන කේතය ${code} වේ

${brand_label_url}

ඔබගේ වි-තැපෑල සත්‍යාපනය කරන්න

${brand} හි ලියාපදිංචියට ${email} භාවිතා කර ඇත. ඔබගේ වි-තැපෑල සත්‍යාපනයට හා ගිණුම සෑදීමට මෙම කේතය ඇතුල් කරන්න.

 

${code}

 

ඔබට කිසියම් ප්‍රශ්නයක් ඇත්නම් කරුණාකර අප අමතන්න.

රහස්‍යතා ප්‍රතිපත්තිය සහ භාවිත නියම · අවභාවිතය වාර්තා කරන්න
${copyright}. සියළුම හිමිකම් ඇවිරිණි.

                                                           
\ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/si/user/email/verification.txt b/services/brig/deb/opt/brig/templates/si/user/email/verification.txt new file mode 100644 index 00000000000..6aad88b82ff --- /dev/null +++ b/services/brig/deb/opt/brig/templates/si/user/email/verification.txt @@ -0,0 +1,18 @@ +[${brand_logo}] + +${brand_label_url} [${brand_url}] + +ඔබගේ වි-තැපෑල සත්‍යාපනය කරන්න +${brand} හි ලියාපදිංචියට ${email} භාවිතා කර ඇත. ඔබගේ වි-තැපෑල සත්‍යාපනයට හා +ගිණුම සෑදීමට මෙම කේතය ඇතුල් කරන්න. + +${code} + +ඔබට කිසියම් ප්‍රශ්නයක් ඇත්නම් කරුණාකර අප අමතන්න [${support}]. + + +-------------------------------------------------------------------------------- + +රහස්‍යතා ප්‍රතිපත්තිය සහ භාවිත නියම [${legal}] · අවභාවිතය වාර්තා කරන්න +[${misuse}] +${copyright}. සියළුම හිමිකම් ඇවිරිණි. \ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/si/user/sms/activation.txt b/services/brig/deb/opt/brig/templates/si/user/sms/activation.txt new file mode 100644 index 00000000000..e029a030748 --- /dev/null +++ b/services/brig/deb/opt/brig/templates/si/user/sms/activation.txt @@ -0,0 +1,3 @@ +ඔබගේ ${brand} කේතය ${code} වේ. + +ඔබගේ අංකය සත්‍යාපනයට ${url} අරින්න. diff --git a/services/brig/deb/opt/brig/templates/si/user/sms/deletion.txt b/services/brig/deb/opt/brig/templates/si/user/sms/deletion.txt new file mode 100644 index 00000000000..15b1622cad3 --- /dev/null +++ b/services/brig/deb/opt/brig/templates/si/user/sms/deletion.txt @@ -0,0 +1,2 @@ +${brand} ගිණුම මැකීමට තට්ටු කරන්න. +${url} diff --git a/services/brig/deb/opt/brig/templates/si/user/sms/login.txt b/services/brig/deb/opt/brig/templates/si/user/sms/login.txt new file mode 100644 index 00000000000..5b0be13a59d --- /dev/null +++ b/services/brig/deb/opt/brig/templates/si/user/sms/login.txt @@ -0,0 +1,3 @@ +ඔබගේ ${brand} කේතය ${code} වේ. + +පිවිසීමට ${url} අරින්න. diff --git a/services/brig/deb/opt/brig/templates/si/user/sms/password-reset.txt b/services/brig/deb/opt/brig/templates/si/user/sms/password-reset.txt new file mode 100644 index 00000000000..d39d0227116 --- /dev/null +++ b/services/brig/deb/opt/brig/templates/si/user/sms/password-reset.txt @@ -0,0 +1,3 @@ +ඔබගේ ${brand} ප්‍රතිසාධන කේතය ${code} වේ. + +මුරපදය යළි සැකසීම සඳහා මෙම කේතය භාවිතා කරන්න. diff --git a/services/brig/deb/opt/brig/templates/tr/user/call/activation.txt b/services/brig/deb/opt/brig/templates/tr/user/call/activation.txt index dfa77bd1174..d1208907366 100644 --- a/services/brig/deb/opt/brig/templates/tr/user/call/activation.txt +++ b/services/brig/deb/opt/brig/templates/tr/user/call/activation.txt @@ -1 +1 @@ -Selam, Wire doğrulama kodunuz: ${code}. Bir kez daha, kodunuz: ${code} \ No newline at end of file +Merhaba, Wire doğrulama kodunuz: ${code}. Bir kez daha, kodunuz: ${code} \ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/tr/user/call/login.txt b/services/brig/deb/opt/brig/templates/tr/user/call/login.txt index c279d5cf311..0a7091f6d20 100644 --- a/services/brig/deb/opt/brig/templates/tr/user/call/login.txt +++ b/services/brig/deb/opt/brig/templates/tr/user/call/login.txt @@ -1 +1 @@ -Selam, Wire giriş kodunuz: ${code} Bir kez daha, kodunuz: ${code} +Merhaba, Wire giriş kodunuz: ${code}. Birkez daha, kodunuz şudur: ${code} \ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/tr/user/email/activation-subject.txt b/services/brig/deb/opt/brig/templates/tr/user/email/activation-subject.txt new file mode 100644 index 00000000000..1b52783813f --- /dev/null +++ b/services/brig/deb/opt/brig/templates/tr/user/email/activation-subject.txt @@ -0,0 +1 @@ +${brand} Hesabınız \ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/tr/user/email/activation.html b/services/brig/deb/opt/brig/templates/tr/user/email/activation.html new file mode 100644 index 00000000000..024f68bd64c --- /dev/null +++ b/services/brig/deb/opt/brig/templates/tr/user/email/activation.html @@ -0,0 +1 @@ +${brand} Hesabınız

${brand_label_url}

E-postanızı doğrulayın

${brand}} a kaydolmak için ${email} kullanıldı.
Adresinizi doğrulamak için düğmeyi tıklayın.

 
Doğrula
 

Düğmeyi tıklayamıyorsanız, bu bağlantıyı kopyalayıp tarayıcınıza yapıştırın:

${url}

Herhangi bir sorunuz veya yardıma ihtiyacınız varsa, lütfen bize ulaşın.

Privacy policy and terms of use · Report Misuse
${copyright}. ALL RIGHTS RESERVED.

                                                           
\ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/tr/user/email/activation.txt b/services/brig/deb/opt/brig/templates/tr/user/email/activation.txt new file mode 100644 index 00000000000..17b7f8815c8 --- /dev/null +++ b/services/brig/deb/opt/brig/templates/tr/user/email/activation.txt @@ -0,0 +1,21 @@ +[${brand_logo}] + +${brand_label_url} [${brand_url}] + +E-POSTANIZI DOĞRULAYIN +${brand}} a kaydolmak için ${email} kullanıldı. +Adresinizi doğrulamak için düğmeyi tıklayın. + +Doğrula [${url}]Düğmeyi tıklayamıyorsanız, bu bağlantıyı kopyalayıp tarayıcınıza +yapıştırın: + +${url} + +Herhangi bir sorunuz veya yardıma ihtiyacınız varsa, lütfen bize ulaşın +[${support}]. + + +-------------------------------------------------------------------------------- + +Privacy policy and terms of use [${legal}] · Report Misuse [${misuse}] +${copyright}. ALL RIGHTS RESERVED. \ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/tr/user/email/deletion-subject.txt b/services/brig/deb/opt/brig/templates/tr/user/email/deletion-subject.txt new file mode 100644 index 00000000000..eb6e4557b10 --- /dev/null +++ b/services/brig/deb/opt/brig/templates/tr/user/email/deletion-subject.txt @@ -0,0 +1 @@ +Hesabı sil? \ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/tr/user/email/deletion.html b/services/brig/deb/opt/brig/templates/tr/user/email/deletion.html new file mode 100644 index 00000000000..56e31fa36bd --- /dev/null +++ b/services/brig/deb/opt/brig/templates/tr/user/email/deletion.html @@ -0,0 +1 @@ +Hesabı sil?

${brand_label_url}

Hesabını Sil

${brand} hesabınızı silmek için bir istek aldık. Tüm konuşmalarınızı, içeriğinizi ve bağlantılarınızı silmek için 10 dakika içinde aşağıdaki düğmeyi tıklayın.

 
Hesabı Sil
 

Düğmeyi tıklayamıyorsanız, bu bağlantıyı kopyalayıp tarayıcınıza yapıştırın:

${url}

Bunu istemediyseniz, şifrenizi sıfırlayın.

Herhangi bir sorunuz veya yardıma ihtiyacınız varsa, lütfen bize ulaşın.

Privacy policy and terms of use · Report Misuse
${copyright}. ALL RIGHTS RESERVED.

                                                           
\ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/tr/user/email/deletion.txt b/services/brig/deb/opt/brig/templates/tr/user/email/deletion.txt new file mode 100644 index 00000000000..4fa840086de --- /dev/null +++ b/services/brig/deb/opt/brig/templates/tr/user/email/deletion.txt @@ -0,0 +1,24 @@ +[${brand_logo}] + +${brand_label_url} [${brand_url}] + +HESABINI SIL +${brand} hesabınızı silmek için bir istek aldık. Tüm konuşmalarınızı, +içeriğinizi ve bağlantılarınızı silmek için 10 dakika içinde aşağıdaki düğmeyi +tıklayın. + +Hesabı Sil [${url}]Düğmeyi tıklayamıyorsanız, bu bağlantıyı kopyalayıp +tarayıcınıza yapıştırın: + +${url} + +Bunu istemediyseniz, şifrenizi sıfırlayın [${forgot}]. + +Herhangi bir sorunuz veya yardıma ihtiyacınız varsa, lütfen bize ulaşın +[${support}]. + + +-------------------------------------------------------------------------------- + +Privacy policy and terms of use [${legal}] · Report Misuse [${misuse}] +${copyright}. ALL RIGHTS RESERVED. \ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/tr/user/email/new-client-subject.txt b/services/brig/deb/opt/brig/templates/tr/user/email/new-client-subject.txt new file mode 100644 index 00000000000..7c56d398c91 --- /dev/null +++ b/services/brig/deb/opt/brig/templates/tr/user/email/new-client-subject.txt @@ -0,0 +1 @@ +Yeni cihaz \ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/tr/user/email/new-client.html b/services/brig/deb/opt/brig/templates/tr/user/email/new-client.html new file mode 100644 index 00000000000..0767e46de95 --- /dev/null +++ b/services/brig/deb/opt/brig/templates/tr/user/email/new-client.html @@ -0,0 +1 @@ +Yeni cihaz

${brand_label_url}

Yeni cihaz

${brand} hesabınız şunun üzerinde kullanıldı:

${date}

${model}

${brand} cihazını yeni bir cihaza kurmuş veya tekrar mevcut bir cihaza kurmuş olabilirsiniz. Öyle değilse, ${brand} Ayarlar bölümüne gidin, cihazı kaldırın ve şifrenizi sıfırlayın.

Herhangi bir sorunuz veya yardıma ihtiyacınız varsa, lütfen bize ulaşın.

Privacy policy and terms of use · Report Misuse
${copyright}. ALL RIGHTS RESERVED.

                                                           
\ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/tr/user/email/new-client.txt b/services/brig/deb/opt/brig/templates/tr/user/email/new-client.txt new file mode 100644 index 00000000000..893716b44c4 --- /dev/null +++ b/services/brig/deb/opt/brig/templates/tr/user/email/new-client.txt @@ -0,0 +1,23 @@ +[${brand_logo}] + +${brand_label_url} [${brand_url}] + +YENI CIHAZ +${brand} hesabınız şunun üzerinde kullanıldı: + +${date} + +${model} + +${brand} cihazını yeni bir cihaza kurmuş veya tekrar mevcut bir cihaza kurmuş +olabilirsiniz. Öyle değilse, ${brand} Ayarlar bölümüne gidin, cihazı kaldırın ve +şifrenizi sıfırlayın [${forgot}]. + +Herhangi bir sorunuz veya yardıma ihtiyacınız varsa, lütfen bize ulaşın +[${support}]. + + +-------------------------------------------------------------------------------- + +Privacy policy and terms of use [${legal}] · Report Misuse [${misuse}] +${copyright}. ALL RIGHTS RESERVED. \ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/tr/user/email/password-reset-subject.txt b/services/brig/deb/opt/brig/templates/tr/user/email/password-reset-subject.txt new file mode 100644 index 00000000000..5559a82e123 --- /dev/null +++ b/services/brig/deb/opt/brig/templates/tr/user/email/password-reset-subject.txt @@ -0,0 +1 @@ +${brand} 'da Şifre Değişikliği \ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/tr/user/email/password-reset.html b/services/brig/deb/opt/brig/templates/tr/user/email/password-reset.html new file mode 100644 index 00000000000..bb1d0aa60a9 --- /dev/null +++ b/services/brig/deb/opt/brig/templates/tr/user/email/password-reset.html @@ -0,0 +1 @@ +${brand} 'da Şifre Değişikliği

${brand_label_url}

Şifrenizi sıfırlayın

${brand} hesabınızın şifresini sıfırlama isteği aldık. Yeni bir şifre oluşturmak için aşağıdaki butona tıklayın.

 
Şifreni sıfırla
 

Düğmeyi tıklayamıyorsanız, bu bağlantıyı kopyalayıp tarayıcınıza yapıştırın:

${url}

Herhangi bir sorunuz veya yardıma ihtiyacınız varsa, lütfen bize ulaşın.

Privacy policy and terms of use · Report Misuse
${copyright}. ALL RIGHTS RESERVED.

                                                           
\ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/tr/user/email/password-reset.txt b/services/brig/deb/opt/brig/templates/tr/user/email/password-reset.txt new file mode 100644 index 00000000000..7c9925c6ca7 --- /dev/null +++ b/services/brig/deb/opt/brig/templates/tr/user/email/password-reset.txt @@ -0,0 +1,21 @@ +[${brand_logo}] + +${brand_label_url} [${brand_url}] + +ŞIFRENIZI SIFIRLAYIN +${brand} hesabınızın şifresini sıfırlama isteği aldık. Yeni bir şifre oluşturmak +için aşağıdaki butona tıklayın. + +Şifreni sıfırla [${url}]Düğmeyi tıklayamıyorsanız, bu bağlantıyı kopyalayıp +tarayıcınıza yapıştırın: + +${url} + +Herhangi bir sorunuz veya yardıma ihtiyacınız varsa, lütfen bize ulaşın +[${support}]. + + +-------------------------------------------------------------------------------- + +Privacy policy and terms of use [${legal}] · Report Misuse [${misuse}] +${copyright}. ALL RIGHTS RESERVED. \ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/tr/user/email/team-activation-subject.txt b/services/brig/deb/opt/brig/templates/tr/user/email/team-activation-subject.txt new file mode 100644 index 00000000000..c4323f2027d --- /dev/null +++ b/services/brig/deb/opt/brig/templates/tr/user/email/team-activation-subject.txt @@ -0,0 +1 @@ +${brand} Hesap \ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/tr/user/email/team-activation.html b/services/brig/deb/opt/brig/templates/tr/user/email/team-activation.html new file mode 100644 index 00000000000..6e2a676f7e9 --- /dev/null +++ b/services/brig/deb/opt/brig/templates/tr/user/email/team-activation.html @@ -0,0 +1 @@ +${brand} Hesap

${brand_label_url}

${brand}'da yeni hesabınız

${email} ile yeni bir ${brand} takımı oluşturuldu. Lütfen e-postanızı doğrulayın.

 
Doğrula
 

Düğmeyi tıklayamıyorsanız, bu bağlantıyı kopyalayıp tarayıcınıza yapıştırın:

${url}

Herhangi bir sorunuz veya yardıma ihtiyacınız varsa, lütfen bize ulaşın.

Privacy policy and terms of use · Report Misuse
${copyright}. ALL RIGHTS RESERVED.

                                                           
\ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/tr/user/email/team-activation.txt b/services/brig/deb/opt/brig/templates/tr/user/email/team-activation.txt new file mode 100644 index 00000000000..8615ceb768e --- /dev/null +++ b/services/brig/deb/opt/brig/templates/tr/user/email/team-activation.txt @@ -0,0 +1,21 @@ +[${brand_logo}] + +${brand_label_url} [${brand_url}] + +${BRAND}'DA YENI HESABINIZ +${email} ile yeni bir ${brand} takımı oluşturuldu. Lütfen e-postanızı +doğrulayın. + +Doğrula [${url}]Düğmeyi tıklayamıyorsanız, bu bağlantıyı kopyalayıp tarayıcınıza +yapıştırın: + +${url} + +Herhangi bir sorunuz veya yardıma ihtiyacınız varsa, lütfen bize ulaşın +[${support}]. + + +-------------------------------------------------------------------------------- + +Privacy policy and terms of use [${legal}] · Report Misuse [${misuse}] +${copyright}. ALL RIGHTS RESERVED. \ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/tr/user/email/update-subject.txt b/services/brig/deb/opt/brig/templates/tr/user/email/update-subject.txt new file mode 100644 index 00000000000..33b5153931f --- /dev/null +++ b/services/brig/deb/opt/brig/templates/tr/user/email/update-subject.txt @@ -0,0 +1 @@ +${brand} üzerindeki yeni e-posta adresiniz \ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/tr/user/email/update.html b/services/brig/deb/opt/brig/templates/tr/user/email/update.html new file mode 100644 index 00000000000..5b14f678898 --- /dev/null +++ b/services/brig/deb/opt/brig/templates/tr/user/email/update.html @@ -0,0 +1 @@ +${brand} üzerindeki yeni e-posta adresiniz

${brand_label_url}

E-postanızı doğrulayın

${email}, ${brand}'daki yeni e-posta adresiniz olarak kaydedildi. Adresinizi doğrulamak için aşağıdaki düğmeye tıklayın.

 
Doğrula
 

Düğmeyi tıklayamıyorsanız, bu bağlantıyı kopyalayıp tarayıcınıza yapıştırın:

${url}

Herhangi bir sorunuz veya yardıma ihtiyacınız varsa, lütfen bize ulaşın.

Privacy policy and terms of use · Report Misuse
${copyright}. ALL RIGHTS RESERVED.

                                                           
\ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/tr/user/email/update.txt b/services/brig/deb/opt/brig/templates/tr/user/email/update.txt new file mode 100644 index 00000000000..e8346877e6d --- /dev/null +++ b/services/brig/deb/opt/brig/templates/tr/user/email/update.txt @@ -0,0 +1,21 @@ +[${brand_logo}] + +${brand_label_url} [${brand_url}] + +E-POSTANIZI DOĞRULAYIN +${email}, ${brand}'daki yeni e-posta adresiniz olarak kaydedildi. Adresinizi +doğrulamak için aşağıdaki düğmeye tıklayın. + +Doğrula [${url}]Düğmeyi tıklayamıyorsanız, bu bağlantıyı kopyalayıp tarayıcınıza +yapıştırın: + +${url} + +Herhangi bir sorunuz veya yardıma ihtiyacınız varsa, lütfen bize ulaşın +[${support}]. + + +-------------------------------------------------------------------------------- + +Privacy policy and terms of use [${legal}] · Report Misuse [${misuse}] +${copyright}. ALL RIGHTS RESERVED. \ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/tr/user/email/verification-delete-team-subject.txt b/services/brig/deb/opt/brig/templates/tr/user/email/verification-delete-team-subject.txt new file mode 100644 index 00000000000..9a9c2a3d923 --- /dev/null +++ b/services/brig/deb/opt/brig/templates/tr/user/email/verification-delete-team-subject.txt @@ -0,0 +1 @@ +${brand} doğrulama kodu ${code} \ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/tr/user/email/verification-delete-team.html b/services/brig/deb/opt/brig/templates/tr/user/email/verification-delete-team.html new file mode 100644 index 00000000000..fc209c5eaeb --- /dev/null +++ b/services/brig/deb/opt/brig/templates/tr/user/email/verification-delete-team.html @@ -0,0 +1 @@ +${brand} doğrulama kodu ${code}

${brand_label_url}

Verify team deletion

${email} was used to delete your ${brand} team. Enter this code to verify your email and delete the team.

 

${code}

 

Herhangi bir sorunuz veya yardıma ihtiyacınız varsa, lütfen bize ulaşın.

Privacy policy and terms of use · Report Misuse
${copyright}. ALL RIGHTS RESERVED.

                                                           
\ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/tr/user/email/verification-delete-team.txt b/services/brig/deb/opt/brig/templates/tr/user/email/verification-delete-team.txt new file mode 100644 index 00000000000..0f035370be9 --- /dev/null +++ b/services/brig/deb/opt/brig/templates/tr/user/email/verification-delete-team.txt @@ -0,0 +1,18 @@ +[${brand_logo}] + +${brand_label_url} [${brand_url}] + +VERIFY TEAM DELETION +${email} was used to delete your ${brand} team. Enter this code to verify your +email and delete the team. + +${code} + +Herhangi bir sorunuz veya yardıma ihtiyacınız varsa, lütfen bize ulaşın +[${support}]. + + +-------------------------------------------------------------------------------- + +Privacy policy and terms of use [${legal}] · Report Misuse [${misuse}] +${copyright}. ALL RIGHTS RESERVED. \ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/tr/user/email/verification-login-subject.txt b/services/brig/deb/opt/brig/templates/tr/user/email/verification-login-subject.txt new file mode 100644 index 00000000000..9a9c2a3d923 --- /dev/null +++ b/services/brig/deb/opt/brig/templates/tr/user/email/verification-login-subject.txt @@ -0,0 +1 @@ +${brand} doğrulama kodu ${code} \ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/tr/user/email/verification-login.html b/services/brig/deb/opt/brig/templates/tr/user/email/verification-login.html new file mode 100644 index 00000000000..6a5f4cbc63d --- /dev/null +++ b/services/brig/deb/opt/brig/templates/tr/user/email/verification-login.html @@ -0,0 +1 @@ +${brand} doğrulama kodu ${code}

${brand_label_url}

Verify login

${email} was used to log in to your ${brand} account. Enter this code to verify your email and log in.

 

${code}

 

Herhangi bir sorunuz veya yardıma ihtiyacınız varsa, lütfen bize ulaşın.

Privacy policy and terms of use · Report Misuse
${copyright}. ALL RIGHTS RESERVED.

                                                           
\ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/tr/user/email/verification-login.txt b/services/brig/deb/opt/brig/templates/tr/user/email/verification-login.txt new file mode 100644 index 00000000000..67bec69e125 --- /dev/null +++ b/services/brig/deb/opt/brig/templates/tr/user/email/verification-login.txt @@ -0,0 +1,18 @@ +[${brand_logo}] + +${brand_label_url} [${brand_url}] + +VERIFY LOGIN +${email} was used to log in to your ${brand} account. Enter this code to verify +your email and log in. + +${code} + +Herhangi bir sorunuz veya yardıma ihtiyacınız varsa, lütfen bize ulaşın +[${support}]. + + +-------------------------------------------------------------------------------- + +Privacy policy and terms of use [${legal}] · Report Misuse [${misuse}] +${copyright}. ALL RIGHTS RESERVED. \ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/tr/user/email/verification-scim-token-subject.txt b/services/brig/deb/opt/brig/templates/tr/user/email/verification-scim-token-subject.txt new file mode 100644 index 00000000000..9a9c2a3d923 --- /dev/null +++ b/services/brig/deb/opt/brig/templates/tr/user/email/verification-scim-token-subject.txt @@ -0,0 +1 @@ +${brand} doğrulama kodu ${code} \ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/tr/user/email/verification-scim-token.html b/services/brig/deb/opt/brig/templates/tr/user/email/verification-scim-token.html new file mode 100644 index 00000000000..90c7885b171 --- /dev/null +++ b/services/brig/deb/opt/brig/templates/tr/user/email/verification-scim-token.html @@ -0,0 +1 @@ +${brand} doğrulama kodu ${code}

${brand_label_url}

Verify SCIM token creation

${email} was used to generate a SCIM token. Enter this code to verify your email and create the token.

 

${code}

 

Herhangi bir sorunuz veya yardıma ihtiyacınız varsa, lütfen bize ulaşın.

Privacy policy and terms of use · Report Misuse
${copyright}. ALL RIGHTS RESERVED.

                                                           
\ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/tr/user/email/verification-scim-token.txt b/services/brig/deb/opt/brig/templates/tr/user/email/verification-scim-token.txt new file mode 100644 index 00000000000..c5ed077177f --- /dev/null +++ b/services/brig/deb/opt/brig/templates/tr/user/email/verification-scim-token.txt @@ -0,0 +1,18 @@ +[${brand_logo}] + +${brand_label_url} [${brand_url}] + +VERIFY SCIM TOKEN CREATION +${email} was used to generate a SCIM token. Enter this code to verify your email +and create the token. + +${code} + +Herhangi bir sorunuz veya yardıma ihtiyacınız varsa, lütfen bize ulaşın +[${support}]. + + +-------------------------------------------------------------------------------- + +Privacy policy and terms of use [${legal}] · Report Misuse [${misuse}] +${copyright}. ALL RIGHTS RESERVED. \ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/tr/user/email/verification-subject.txt b/services/brig/deb/opt/brig/templates/tr/user/email/verification-subject.txt new file mode 100644 index 00000000000..5cb510f23f5 --- /dev/null +++ b/services/brig/deb/opt/brig/templates/tr/user/email/verification-subject.txt @@ -0,0 +1 @@ +${code} is your ${brand} verification code \ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/tr/user/email/verification.html b/services/brig/deb/opt/brig/templates/tr/user/email/verification.html new file mode 100644 index 00000000000..f8d2b9f963a --- /dev/null +++ b/services/brig/deb/opt/brig/templates/tr/user/email/verification.html @@ -0,0 +1 @@ +${code} is your ${brand} verification code

${brand_label_url}

E-postanızı doğrulayın

${brand} 'a kaydolmak için ${email} kullanıldı. E-postanızı doğrulayıp hesap oluşturmak için kodu girin.

 

${code}

 

Herhangi bir sorunuz veya yardıma ihtiyacınız varsa, lütfen bize ulaşın.

Privacy policy and terms of use · Report Misuse
${copyright}. ALL RIGHTS RESERVED.

                                                           
\ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/tr/user/email/verification.txt b/services/brig/deb/opt/brig/templates/tr/user/email/verification.txt new file mode 100644 index 00000000000..0c04a0ab6ce --- /dev/null +++ b/services/brig/deb/opt/brig/templates/tr/user/email/verification.txt @@ -0,0 +1,18 @@ +[${brand_logo}] + +${brand_label_url} [${brand_url}] + +E-POSTANIZI DOĞRULAYIN +${brand} 'a kaydolmak için ${email} kullanıldı. E-postanızı doğrulayıp hesap +oluşturmak için kodu girin. + +${code} + +Herhangi bir sorunuz veya yardıma ihtiyacınız varsa, lütfen bize ulaşın +[${support}]. + + +-------------------------------------------------------------------------------- + +Privacy policy and terms of use [${legal}] · Report Misuse [${misuse}] +${copyright}. ALL RIGHTS RESERVED. \ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/tr/user/sms/activation.txt b/services/brig/deb/opt/brig/templates/tr/user/sms/activation.txt index 85848c0dc29..0f297cd946d 100644 --- a/services/brig/deb/opt/brig/templates/tr/user/sms/activation.txt +++ b/services/brig/deb/opt/brig/templates/tr/user/sms/activation.txt @@ -1,3 +1,3 @@ -Wire kodunuz ${code}. +${brand} kodunuz ${code}. -${url} adresine açarak numaranızı doğrulayabilir ya da alttaki kodu Wire'a elle girerek doğrulayabilirsiniz. +Numaranızı doğrulamak için: ${url}. diff --git a/services/brig/deb/opt/brig/templates/tr/user/sms/deletion.txt b/services/brig/deb/opt/brig/templates/tr/user/sms/deletion.txt index b73080d74e9..41a4be3755a 100644 --- a/services/brig/deb/opt/brig/templates/tr/user/sms/deletion.txt +++ b/services/brig/deb/opt/brig/templates/tr/user/sms/deletion.txt @@ -1,2 +1,2 @@ -Wire hesabınızı silmek için tıklayın. -${url} +${brand} hesabınızı silmek için tıklayın. +${url} diff --git a/services/brig/deb/opt/brig/templates/tr/user/sms/login.txt b/services/brig/deb/opt/brig/templates/tr/user/sms/login.txt index f078a5785a2..7cd50436ad3 100644 --- a/services/brig/deb/opt/brig/templates/tr/user/sms/login.txt +++ b/services/brig/deb/opt/brig/templates/tr/user/sms/login.txt @@ -1,3 +1,3 @@ -Wire giriş kodunuz ${code}. +${brand}} giriş kodunuz ${code}. -Giriş yapmak için ${url} adresine gidebilir ya da bu kodu Wire uygulamasına girebilirsiniz: ${code}. +Giriş yapmak için: ${url}. diff --git a/services/brig/deb/opt/brig/templates/tr/user/sms/password-reset.txt b/services/brig/deb/opt/brig/templates/tr/user/sms/password-reset.txt index 53861b2cad9..2b4f0933ef2 100644 --- a/services/brig/deb/opt/brig/templates/tr/user/sms/password-reset.txt +++ b/services/brig/deb/opt/brig/templates/tr/user/sms/password-reset.txt @@ -1,3 +1,3 @@ -Wire kurtarma kodunuz ${code}. +${brand} kurtarma kodunuz ${code}. -Wire uygulamasını açın ve bu kodu şifre sıfırlama işlemini tamamlamak için kullanın. \ No newline at end of file +Şifre sıfırlama işlemini tamamlamak için bu kodu kullanın. diff --git a/services/brig/deb/opt/brig/templates/version b/services/brig/deb/opt/brig/templates/version index 4af04f0f334..fea60e70c1a 100644 --- a/services/brig/deb/opt/brig/templates/version +++ b/services/brig/deb/opt/brig/templates/version @@ -1 +1 @@ -v1.0.102 +v1.0.121 diff --git a/services/brig/deb/opt/brig/templates/vi/user/call/activation.txt b/services/brig/deb/opt/brig/templates/vi/user/call/activation.txt new file mode 100644 index 00000000000..bc29d9b108e --- /dev/null +++ b/services/brig/deb/opt/brig/templates/vi/user/call/activation.txt @@ -0,0 +1 @@ +Xin chào, mã xác thực Wire của bạn là: ${code}. Một lần nữa, mã của bạn là: ${code} \ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/vi/user/call/login.txt b/services/brig/deb/opt/brig/templates/vi/user/call/login.txt new file mode 100644 index 00000000000..d1e101d5e58 --- /dev/null +++ b/services/brig/deb/opt/brig/templates/vi/user/call/login.txt @@ -0,0 +1 @@ +Xin chào, mã đăng nhập Wire của bạn là: ${code}. Một lần nữa, mã của bạn là: ${code} \ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/vi/user/email/activation-subject.txt b/services/brig/deb/opt/brig/templates/vi/user/email/activation-subject.txt new file mode 100644 index 00000000000..dfdc7bcec75 --- /dev/null +++ b/services/brig/deb/opt/brig/templates/vi/user/email/activation-subject.txt @@ -0,0 +1 @@ +Tài khoản ${brand} của bạn \ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/vi/user/email/activation.html b/services/brig/deb/opt/brig/templates/vi/user/email/activation.html new file mode 100644 index 00000000000..3b47400c118 --- /dev/null +++ b/services/brig/deb/opt/brig/templates/vi/user/email/activation.html @@ -0,0 +1 @@ +Tài khoản ${brand} của bạn

${brand_label_url}

Xác minh địa chỉ emal của bạn

${email} đã được dùng để đăng ký ${brand}.
Nhấp vào nút để xác minh địa chỉ của bạn.

 
Xác minh
 

Nếu bạn không thể nhấp vào nút, sao chép và gán đường dẫn này vào trình duyệt của bạn:

${url}

Nếu bạn có bất kỳ thắc mắc nào, xin vui lòng liên hệ với chúng tôi.

Chính sách riêng tư và điều khoản sử dụng · Báo cáo Lạm dụng
${copyright}. ĐÃ ĐƯỢC ĐĂNG KÝ BẢN QUYỀN.

                                                           
\ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/vi/user/email/activation.txt b/services/brig/deb/opt/brig/templates/vi/user/email/activation.txt new file mode 100644 index 00000000000..9fd76c0cace --- /dev/null +++ b/services/brig/deb/opt/brig/templates/vi/user/email/activation.txt @@ -0,0 +1,21 @@ +[${brand_logo}] + +${brand_label_url} [${brand_url}] + +XÁC MINH ĐỊA CHỈ EMAL CỦA BẠN +${email} đã được dùng để đăng ký ${brand}. +Nhấp vào nút để xác minh địa chỉ của bạn. + +Xác minh [${url}]Nếu bạn không thể nhấp vào nút, sao chép và gán đường dẫn này +vào trình duyệt của bạn: + +${url} + +Nếu bạn có bất kỳ thắc mắc nào, xin vui lòng liên hệ với chúng tôi [${support}]. + + +-------------------------------------------------------------------------------- + +Chính sách riêng tư và điều khoản sử dụng [${legal}] · Báo cáo Lạm dụng +[${misuse}] +${copyright}. ĐÃ ĐƯỢC ĐĂNG KÝ BẢN QUYỀN. \ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/vi/user/email/deletion-subject.txt b/services/brig/deb/opt/brig/templates/vi/user/email/deletion-subject.txt new file mode 100644 index 00000000000..1969ad4a62c --- /dev/null +++ b/services/brig/deb/opt/brig/templates/vi/user/email/deletion-subject.txt @@ -0,0 +1 @@ +Xoá tài khoản? \ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/vi/user/email/deletion.html b/services/brig/deb/opt/brig/templates/vi/user/email/deletion.html new file mode 100644 index 00000000000..274ee2d08b4 --- /dev/null +++ b/services/brig/deb/opt/brig/templates/vi/user/email/deletion.html @@ -0,0 +1 @@ +Xoá tài khoản?

${brand_label_url}

Xoá tài khoản của bạn

Chúng tôi nhận được một yêu cầu xoá tài khoản ${brand} của bạn. Nhấp vào nút phía bên dưới trong vòng 10 phút để xoá toàn bộ cuộc hội thoại, nội dung và mọi kết nối của bạn.

 
Xoá tài khoản
 

Nếu bạn không thể nhấp vào nút, sao chép và gán đường dẫn này vào trình duyệt của bạn:

${url}

Nếu bạn không thực hiện yêu cầu này, thay đổi mật khẩu của bạn ngay.

Nếu bạn có bất kỳ thắc mắc nào, xin vui lòng liên hệ với chúng tôi.

Chính sách riêng tư và điều khoản sử dụng · Báo cáo Lạm dụng
${copyright}. ĐÃ ĐƯỢC ĐĂNG KÝ BẢN QUYỀN.

                                                           
\ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/vi/user/email/deletion.txt b/services/brig/deb/opt/brig/templates/vi/user/email/deletion.txt new file mode 100644 index 00000000000..3dfd5366e04 --- /dev/null +++ b/services/brig/deb/opt/brig/templates/vi/user/email/deletion.txt @@ -0,0 +1,24 @@ +[${brand_logo}] + +${brand_label_url} [${brand_url}] + +XOÁ TÀI KHOẢN CỦA BẠN +Chúng tôi nhận được một yêu cầu xoá tài khoản ${brand} của bạn. Nhấp vào nút +phía bên dưới trong vòng 10 phút để xoá toàn bộ cuộc hội thoại, nội dung và mọi +kết nối của bạn. + +Xoá tài khoản [${url}]Nếu bạn không thể nhấp vào nút, sao chép và gán đường dẫn +này vào trình duyệt của bạn: + +${url} + +Nếu bạn không thực hiện yêu cầu này, thay đổi mật khẩu của bạn ngay [${forgot}]. + +Nếu bạn có bất kỳ thắc mắc nào, xin vui lòng liên hệ với chúng tôi [${support}]. + + +-------------------------------------------------------------------------------- + +Chính sách riêng tư và điều khoản sử dụng [${legal}] · Báo cáo Lạm dụng +[${misuse}] +${copyright}. ĐÃ ĐƯỢC ĐĂNG KÝ BẢN QUYỀN. \ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/vi/user/email/new-client-subject.txt b/services/brig/deb/opt/brig/templates/vi/user/email/new-client-subject.txt new file mode 100644 index 00000000000..96c0793c38b --- /dev/null +++ b/services/brig/deb/opt/brig/templates/vi/user/email/new-client-subject.txt @@ -0,0 +1 @@ +Thiết bị mới \ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/vi/user/email/new-client.html b/services/brig/deb/opt/brig/templates/vi/user/email/new-client.html new file mode 100644 index 00000000000..bf10025c64c --- /dev/null +++ b/services/brig/deb/opt/brig/templates/vi/user/email/new-client.html @@ -0,0 +1 @@ +Thiết bị mới

${brand_label_url}

Thiết bị mới

Tài khoản ${brand} của bạn đã được sử dụng vào:

${date}

${model}

Bạn có thể cài đặt ${brand} trên một thiết bị mới hoặc cài đặt lại trên một thiết bị đã tồn tại. Nếu không phải các trường hợp đó, đi đến Cài đặt ${brand}, gỡ bỏ thiết bị và thay đổi mật khẩu của bạn.

Nếu bạn có bất kỳ thắc mắc nào, xin vui lòng liên hệ với chúng tôi.

Chính sách riêng tư và điều khoản sử dụng · Báo cáo Lạm dụng
${copyright}. ĐÃ ĐƯỢC ĐĂNG KÝ BẢN QUYỀN.

                                                           
\ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/vi/user/email/new-client.txt b/services/brig/deb/opt/brig/templates/vi/user/email/new-client.txt new file mode 100644 index 00000000000..14b08a02a49 --- /dev/null +++ b/services/brig/deb/opt/brig/templates/vi/user/email/new-client.txt @@ -0,0 +1,23 @@ +[${brand_logo}] + +${brand_label_url} [${brand_url}] + +THIẾT BỊ MỚI +Tài khoản ${brand} của bạn đã được sử dụng vào: + +${date} + +${model} + +Bạn có thể cài đặt ${brand} trên một thiết bị mới hoặc cài đặt lại trên một +thiết bị đã tồn tại. Nếu không phải các trường hợp đó, đi đến Cài đặt ${brand}, +gỡ bỏ thiết bị và thay đổi mật khẩu của bạn [${forgot}]. + +Nếu bạn có bất kỳ thắc mắc nào, xin vui lòng liên hệ với chúng tôi [${support}]. + + +-------------------------------------------------------------------------------- + +Chính sách riêng tư và điều khoản sử dụng [${legal}] · Báo cáo Lạm dụng +[${misuse}] +${copyright}. ĐÃ ĐƯỢC ĐĂNG KÝ BẢN QUYỀN. \ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/vi/user/email/password-reset-subject.txt b/services/brig/deb/opt/brig/templates/vi/user/email/password-reset-subject.txt new file mode 100644 index 00000000000..dde2762d74b --- /dev/null +++ b/services/brig/deb/opt/brig/templates/vi/user/email/password-reset-subject.txt @@ -0,0 +1 @@ +Thay đổi mật khẩu ${brand} \ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/vi/user/email/password-reset.html b/services/brig/deb/opt/brig/templates/vi/user/email/password-reset.html new file mode 100644 index 00000000000..3aad8d78af1 --- /dev/null +++ b/services/brig/deb/opt/brig/templates/vi/user/email/password-reset.html @@ -0,0 +1 @@ +Thay đổi mật khẩu ${brand}

${brand_label_url}

Đặt lại mật khẩu của bạn

Chúng tôi nhận được một yêu cầu đặt lại mật khẩu cho tài khoản ${brand} của bạn. Để tạo một tài khoản mới, nhấp vào nút phía bên dưới.

 
Đặt lại mật khẩu
 

Nếu bạn không thể nhấp vào nút, sao chép và gán đường dẫn này vào trình duyệt của bạn:

${url}

Nếu bạn có bất kỳ thắc mắc nào, xin vui lòng liên hệ với chúng tôi.

Chính sách riêng tư và điều khoản sử dụng · Báo cáo Lạm dụng
${copyright}. ĐÃ ĐƯỢC ĐĂNG KÝ BẢN QUYỀN.

                                                           
\ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/vi/user/email/password-reset.txt b/services/brig/deb/opt/brig/templates/vi/user/email/password-reset.txt new file mode 100644 index 00000000000..19be97f5f4e --- /dev/null +++ b/services/brig/deb/opt/brig/templates/vi/user/email/password-reset.txt @@ -0,0 +1,21 @@ +[${brand_logo}] + +${brand_label_url} [${brand_url}] + +ĐẶT LẠI MẬT KHẨU CỦA BẠN +Chúng tôi nhận được một yêu cầu đặt lại mật khẩu cho tài khoản ${brand} của bạn. +Để tạo một tài khoản mới, nhấp vào nút phía bên dưới. + +Đặt lại mật khẩu [${url}]Nếu bạn không thể nhấp vào nút, sao chép và gán đường +dẫn này vào trình duyệt của bạn: + +${url} + +Nếu bạn có bất kỳ thắc mắc nào, xin vui lòng liên hệ với chúng tôi [${support}]. + + +-------------------------------------------------------------------------------- + +Chính sách riêng tư và điều khoản sử dụng [${legal}] · Báo cáo Lạm dụng +[${misuse}] +${copyright}. ĐÃ ĐƯỢC ĐĂNG KÝ BẢN QUYỀN. \ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/vi/user/email/team-activation-subject.txt b/services/brig/deb/opt/brig/templates/vi/user/email/team-activation-subject.txt new file mode 100644 index 00000000000..8dc750aa201 --- /dev/null +++ b/services/brig/deb/opt/brig/templates/vi/user/email/team-activation-subject.txt @@ -0,0 +1 @@ +Tài khoản ${brand} \ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/vi/user/email/team-activation.html b/services/brig/deb/opt/brig/templates/vi/user/email/team-activation.html new file mode 100644 index 00000000000..48edcff50b3 --- /dev/null +++ b/services/brig/deb/opt/brig/templates/vi/user/email/team-activation.html @@ -0,0 +1 @@ +Tài khoản ${brand}

${brand_label_url}

Tài khoản mới của bạn trên ${brand}

Một nhóm ${brand} đã được tại với ${email}. Vui lòng xác minh địa chỉ email của bạn.

 
Xác minh
 

Nếu bạn không thể nhấp vào nút, sao chép và gán đường dẫn này vào trình duyệt của bạn:

${url}

Nếu bạn có bất kỳ thắc mắc nào, xin vui lòng liên hệ với chúng tôi.

Chính sách riêng tư và điều khoản sử dụng · Báo cáo Lạm dụng
${copyright}. ĐÃ ĐƯỢC ĐĂNG KÝ BẢN QUYỀN.

                                                           
\ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/vi/user/email/team-activation.txt b/services/brig/deb/opt/brig/templates/vi/user/email/team-activation.txt new file mode 100644 index 00000000000..021963e3ac9 --- /dev/null +++ b/services/brig/deb/opt/brig/templates/vi/user/email/team-activation.txt @@ -0,0 +1,21 @@ +[${brand_logo}] + +${brand_label_url} [${brand_url}] + +TÀI KHOẢN MỚI CỦA BẠN TRÊN ${BRAND} +Một nhóm ${brand} đã được tại với ${email}. Vui lòng xác minh địa chỉ email của +bạn. + +Xác minh [${url}]Nếu bạn không thể nhấp vào nút, sao chép và gán đường dẫn này +vào trình duyệt của bạn: + +${url} + +Nếu bạn có bất kỳ thắc mắc nào, xin vui lòng liên hệ với chúng tôi [${support}]. + + +-------------------------------------------------------------------------------- + +Chính sách riêng tư và điều khoản sử dụng [${legal}] · Báo cáo Lạm dụng +[${misuse}] +${copyright}. ĐÃ ĐƯỢC ĐĂNG KÝ BẢN QUYỀN. \ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/vi/user/email/update-subject.txt b/services/brig/deb/opt/brig/templates/vi/user/email/update-subject.txt new file mode 100644 index 00000000000..e78a90293d5 --- /dev/null +++ b/services/brig/deb/opt/brig/templates/vi/user/email/update-subject.txt @@ -0,0 +1 @@ +Địa chỉ eamil mới trên ${brand} \ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/vi/user/email/update.html b/services/brig/deb/opt/brig/templates/vi/user/email/update.html new file mode 100644 index 00000000000..d227a8e59d7 --- /dev/null +++ b/services/brig/deb/opt/brig/templates/vi/user/email/update.html @@ -0,0 +1 @@ +Địa chỉ eamil mới trên ${brand}

${brand_label_url}

Xác minh địa chỉ emal của bạn

${email} đã được đăng ký như là địa chỉ email mới của bạn trên ${brand}. Nhấp vào nút phía bên dưới để xác minh địa chỉ email của bạn.

 
Xác minh
 

Nếu bạn không thể nhấp vào nút, sao chép và gán đường dẫn này vào trình duyệt của bạn:

${url}

Nếu bạn có bất kỳ thắc mắc nào, xin vui lòng liên hệ với chúng tôi.

Chính sách riêng tư và điều khoản sử dụng · Báo cáo Lạm dụng
${copyright}. ĐÃ ĐƯỢC ĐĂNG KÝ BẢN QUYỀN.

                                                           
\ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/vi/user/email/update.txt b/services/brig/deb/opt/brig/templates/vi/user/email/update.txt new file mode 100644 index 00000000000..721f2a11b0f --- /dev/null +++ b/services/brig/deb/opt/brig/templates/vi/user/email/update.txt @@ -0,0 +1,21 @@ +[${brand_logo}] + +${brand_label_url} [${brand_url}] + +XÁC MINH ĐỊA CHỈ EMAL CỦA BẠN +${email} đã được đăng ký như là địa chỉ email mới của bạn trên ${brand}. Nhấp +vào nút phía bên dưới để xác minh địa chỉ email của bạn. + +Xác minh [${url}]Nếu bạn không thể nhấp vào nút, sao chép và gán đường dẫn này +vào trình duyệt của bạn: + +${url} + +Nếu bạn có bất kỳ thắc mắc nào, xin vui lòng liên hệ với chúng tôi [${support}]. + + +-------------------------------------------------------------------------------- + +Chính sách riêng tư và điều khoản sử dụng [${legal}] · Báo cáo Lạm dụng +[${misuse}] +${copyright}. ĐÃ ĐƯỢC ĐĂNG KÝ BẢN QUYỀN. \ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/vi/user/email/verification-delete-team-subject.txt b/services/brig/deb/opt/brig/templates/vi/user/email/verification-delete-team-subject.txt new file mode 100644 index 00000000000..27223da6a8c --- /dev/null +++ b/services/brig/deb/opt/brig/templates/vi/user/email/verification-delete-team-subject.txt @@ -0,0 +1 @@ +Mã xác minh ${brand} của bạn là ${code} \ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/vi/user/email/verification-delete-team.html b/services/brig/deb/opt/brig/templates/vi/user/email/verification-delete-team.html new file mode 100644 index 00000000000..c9e3dc52d87 --- /dev/null +++ b/services/brig/deb/opt/brig/templates/vi/user/email/verification-delete-team.html @@ -0,0 +1 @@ +Mã xác minh ${brand} của bạn là ${code}

${brand_label_url}

Xác minh việc xóa nhóm

${email} đã được sử dụng để xóa nhóm ${brand} của bạn. Nhập đoạn mã này để xác nhận email của bạn và xóa nhóm.

 

${code}

 

Nếu bạn có bất kỳ thắc mắc nào, xin vui lòng liên hệ với chúng tôi.

Chính sách riêng tư và điều khoản sử dụng · Báo cáo Lạm dụng
${copyright}. ĐÃ ĐƯỢC ĐĂNG KÝ BẢN QUYỀN.

                                                           
\ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/vi/user/email/verification-delete-team.txt b/services/brig/deb/opt/brig/templates/vi/user/email/verification-delete-team.txt new file mode 100644 index 00000000000..1e238a77a06 --- /dev/null +++ b/services/brig/deb/opt/brig/templates/vi/user/email/verification-delete-team.txt @@ -0,0 +1,18 @@ +[${brand_logo}] + +${brand_label_url} [${brand_url}] + +XÁC MINH VIỆC XÓA NHÓM +${email} đã được sử dụng để xóa nhóm ${brand} của bạn. Nhập đoạn mã này để xác +nhận email của bạn và xóa nhóm. + +${code} + +Nếu bạn có bất kỳ thắc mắc nào, xin vui lòng liên hệ với chúng tôi [${support}]. + + +-------------------------------------------------------------------------------- + +Chính sách riêng tư và điều khoản sử dụng [${legal}] · Báo cáo Lạm dụng +[${misuse}] +${copyright}. ĐÃ ĐƯỢC ĐĂNG KÝ BẢN QUYỀN. \ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/vi/user/email/verification-login-subject.txt b/services/brig/deb/opt/brig/templates/vi/user/email/verification-login-subject.txt new file mode 100644 index 00000000000..27223da6a8c --- /dev/null +++ b/services/brig/deb/opt/brig/templates/vi/user/email/verification-login-subject.txt @@ -0,0 +1 @@ +Mã xác minh ${brand} của bạn là ${code} \ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/vi/user/email/verification-login.html b/services/brig/deb/opt/brig/templates/vi/user/email/verification-login.html new file mode 100644 index 00000000000..61ef970b3d4 --- /dev/null +++ b/services/brig/deb/opt/brig/templates/vi/user/email/verification-login.html @@ -0,0 +1 @@ +Mã xác minh ${brand} của bạn là ${code}

${brand_label_url}

Xác minh đăng nhập

${email} đã được sử dụng để đưng nhập vào tài khoản ${brand} của bạn. Nhập đoạn mã này để xác thực email của bạn và đăng nhập.

 

${code}

 

Nếu bạn có bất kỳ thắc mắc nào, xin vui lòng liên hệ với chúng tôi.

Chính sách riêng tư và điều khoản sử dụng · Báo cáo Lạm dụng
${copyright}. ĐÃ ĐƯỢC ĐĂNG KÝ BẢN QUYỀN.

                                                           
\ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/vi/user/email/verification-login.txt b/services/brig/deb/opt/brig/templates/vi/user/email/verification-login.txt new file mode 100644 index 00000000000..7cd8b52fa89 --- /dev/null +++ b/services/brig/deb/opt/brig/templates/vi/user/email/verification-login.txt @@ -0,0 +1,18 @@ +[${brand_logo}] + +${brand_label_url} [${brand_url}] + +XÁC MINH ĐĂNG NHẬP +${email} đã được sử dụng để đưng nhập vào tài khoản ${brand} của bạn. Nhập đoạn +mã này để xác thực email của bạn và đăng nhập. + +${code} + +Nếu bạn có bất kỳ thắc mắc nào, xin vui lòng liên hệ với chúng tôi [${support}]. + + +-------------------------------------------------------------------------------- + +Chính sách riêng tư và điều khoản sử dụng [${legal}] · Báo cáo Lạm dụng +[${misuse}] +${copyright}. ĐÃ ĐƯỢC ĐĂNG KÝ BẢN QUYỀN. \ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/vi/user/email/verification-scim-token-subject.txt b/services/brig/deb/opt/brig/templates/vi/user/email/verification-scim-token-subject.txt new file mode 100644 index 00000000000..27223da6a8c --- /dev/null +++ b/services/brig/deb/opt/brig/templates/vi/user/email/verification-scim-token-subject.txt @@ -0,0 +1 @@ +Mã xác minh ${brand} của bạn là ${code} \ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/vi/user/email/verification-scim-token.html b/services/brig/deb/opt/brig/templates/vi/user/email/verification-scim-token.html new file mode 100644 index 00000000000..18bd7b87856 --- /dev/null +++ b/services/brig/deb/opt/brig/templates/vi/user/email/verification-scim-token.html @@ -0,0 +1 @@ +Mã xác minh ${brand} của bạn là ${code}

${brand_label_url}

Xác minh về việc tạo SCIM token

${email} được sử dụng để tạo một mã SCIM token. Nhập đoạn mã này để xác minh email và tạo mã token.

 

${code}

 

Nếu bạn có bất kỳ thắc mắc nào, xin vui lòng liên hệ với chúng tôi.

Chính sách riêng tư và điều khoản sử dụng · Báo cáo Lạm dụng
${copyright}. ĐÃ ĐƯỢC ĐĂNG KÝ BẢN QUYỀN.

                                                           
\ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/vi/user/email/verification-scim-token.txt b/services/brig/deb/opt/brig/templates/vi/user/email/verification-scim-token.txt new file mode 100644 index 00000000000..009edf61f53 --- /dev/null +++ b/services/brig/deb/opt/brig/templates/vi/user/email/verification-scim-token.txt @@ -0,0 +1,18 @@ +[${brand_logo}] + +${brand_label_url} [${brand_url}] + +XÁC MINH VỀ VIỆC TẠO SCIM TOKEN +${email} được sử dụng để tạo một mã SCIM token. Nhập đoạn mã này để xác minh +email và tạo mã token. + +${code} + +Nếu bạn có bất kỳ thắc mắc nào, xin vui lòng liên hệ với chúng tôi [${support}]. + + +-------------------------------------------------------------------------------- + +Chính sách riêng tư và điều khoản sử dụng [${legal}] · Báo cáo Lạm dụng +[${misuse}] +${copyright}. ĐÃ ĐƯỢC ĐĂNG KÝ BẢN QUYỀN. \ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/vi/user/email/verification-subject.txt b/services/brig/deb/opt/brig/templates/vi/user/email/verification-subject.txt new file mode 100644 index 00000000000..c1a38dc6a24 --- /dev/null +++ b/services/brig/deb/opt/brig/templates/vi/user/email/verification-subject.txt @@ -0,0 +1 @@ +${code} là mã xác nhận ${brand} của bạn \ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/vi/user/email/verification.html b/services/brig/deb/opt/brig/templates/vi/user/email/verification.html new file mode 100644 index 00000000000..601ada7eb42 --- /dev/null +++ b/services/brig/deb/opt/brig/templates/vi/user/email/verification.html @@ -0,0 +1 @@ +${code} là mã xác nhận ${brand} của bạn

${brand_label_url}

Xác minh địa chỉ emal của bạn

${email} đã được dùng để đăng ký ${brand}. Nhập mã này để xác minh địa chỉ email và tạo tài khoản của bạn.

 

${code}

 

Nếu bạn có bất kỳ thắc mắc nào, xin vui lòng liên hệ với chúng tôi.

Chính sách riêng tư và điều khoản sử dụng · Báo cáo Lạm dụng
${copyright}. ĐÃ ĐƯỢC ĐĂNG KÝ BẢN QUYỀN.

                                                           
\ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/vi/user/email/verification.txt b/services/brig/deb/opt/brig/templates/vi/user/email/verification.txt new file mode 100644 index 00000000000..499224ab2d6 --- /dev/null +++ b/services/brig/deb/opt/brig/templates/vi/user/email/verification.txt @@ -0,0 +1,18 @@ +[${brand_logo}] + +${brand_label_url} [${brand_url}] + +XÁC MINH ĐỊA CHỈ EMAL CỦA BẠN +${email} đã được dùng để đăng ký ${brand}. Nhập mã này để xác minh địa chỉ email +và tạo tài khoản của bạn. + +${code} + +Nếu bạn có bất kỳ thắc mắc nào, xin vui lòng liên hệ với chúng tôi [${support}]. + + +-------------------------------------------------------------------------------- + +Chính sách riêng tư và điều khoản sử dụng [${legal}] · Báo cáo Lạm dụng +[${misuse}] +${copyright}. ĐÃ ĐƯỢC ĐĂNG KÝ BẢN QUYỀN. \ No newline at end of file diff --git a/services/brig/deb/opt/brig/templates/vi/user/sms/activation.txt b/services/brig/deb/opt/brig/templates/vi/user/sms/activation.txt new file mode 100644 index 00000000000..e9987182a50 --- /dev/null +++ b/services/brig/deb/opt/brig/templates/vi/user/sms/activation.txt @@ -0,0 +1,3 @@ +Mã ${brand} của bạn là ${code}. + +Mở ${url} để xác minh số điện thoại của bạn. diff --git a/services/brig/deb/opt/brig/templates/vi/user/sms/deletion.txt b/services/brig/deb/opt/brig/templates/vi/user/sms/deletion.txt new file mode 100644 index 00000000000..63b7431b400 --- /dev/null +++ b/services/brig/deb/opt/brig/templates/vi/user/sms/deletion.txt @@ -0,0 +1,2 @@ +Chạm để xoá tài khoản ${brand} của bạn. +${url} diff --git a/services/brig/deb/opt/brig/templates/vi/user/sms/login.txt b/services/brig/deb/opt/brig/templates/vi/user/sms/login.txt new file mode 100644 index 00000000000..e12fa3949bd --- /dev/null +++ b/services/brig/deb/opt/brig/templates/vi/user/sms/login.txt @@ -0,0 +1,3 @@ +Mã đăng nhập ${brand} của bạn là ${code}. + +Mở ${url} để đăng nhập. diff --git a/services/brig/deb/opt/brig/templates/vi/user/sms/password-reset.txt b/services/brig/deb/opt/brig/templates/vi/user/sms/password-reset.txt new file mode 100644 index 00000000000..de5c4600cd4 --- /dev/null +++ b/services/brig/deb/opt/brig/templates/vi/user/sms/password-reset.txt @@ -0,0 +1,3 @@ +Mã khôi phục ${brand} của bạn là ${code}. + +Sử dụng mã này để hoàn tất việc đặt lại mật khẩu. From 1bff35284c642afa727f8dc220ca7a6295f7755e Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Marko=20Dimja=C5=A1evi=C4=87?= Date: Thu, 30 May 2024 11:52:13 +0200 Subject: [PATCH 14/64] [WPB-7161] Fix Request ID logging in all services (#4059) Co-authored-by: Igor Ranieri Co-authored-by: Akshay Mankar Co-authored-by: Leif Battermann Co-authored-by: Stefan Berthold --- .hlint.yaml | 2 +- changelog.d/3-bug-fixes/request-id-logging | 1 + .../5-internal/federator-simplification | 3 + .../src/Wire/Sem/Logger/TinyLog.hs | 7 +- libs/wai-utilities/default.nix | 15 ++ .../src/Network/Wai/Utilities/Request.hs | 12 +- .../src/Network/Wai/Utilities/Server.hs | 52 +++-- libs/wai-utilities/test/Main.hs | 1 + .../test/Network/Wai/Utilities/ServerSpec.hs | 67 ++++++ libs/wai-utilities/wai-utilities.cabal | 64 ++++-- services/brig/src/Brig/Run.hs | 56 ++---- services/cannon/cannon.cabal | 1 - services/cannon/default.nix | 1 - services/cannon/src/Cannon/Run.hs | 3 +- services/cannon/src/Cannon/Types.hs | 23 +-- services/cargohold/src/CargoHold/Run.hs | 26 +-- services/federator/default.nix | 1 - services/federator/federator.cabal | 4 +- services/federator/src/Federator/App.hs | 93 --------- services/federator/src/Federator/Env.hs | 2 - .../federator/src/Federator/ExternalServer.hs | 60 ++---- services/federator/src/Federator/Health.hs | 9 +- .../federator/src/Federator/InternalServer.hs | 59 ++---- .../federator/src/Federator/Interpreter.hs | 190 ++++++++++++++++++ .../federator/src/Federator/MockServer.hs | 27 +-- services/federator/src/Federator/Remote.hs | 9 +- services/federator/src/Federator/Response.hs | 161 +-------------- services/federator/src/Federator/Service.hs | 10 +- .../integration/Test/Federator/IngressSpec.hs | 3 +- services/federator/test/unit/Main.hs | 4 +- .../test/unit/Test/Federator/Client.hs | 3 +- .../unit/Test/Federator/ExternalServer.hs | 85 ++++---- .../unit/Test/Federator/InternalServer.hs | 21 +- .../test/unit/Test/Federator/Remote.hs | 3 +- .../test/unit/Test/Federator/Response.hs | 104 ---------- .../test/unit/Test/Federator/Util.hs | 2 + services/galley/src/Galley/Run.hs | 25 +-- services/gundeck/src/Gundeck/Run.hs | 34 +--- services/proxy/src/Proxy/Run.hs | 3 +- services/spar/src/Spar/API.hs | 17 +- services/spar/src/Spar/Run.hs | 39 ++-- tools/stern/src/Stern/API.hs | 11 +- tools/stern/src/Stern/App.hs | 3 +- 43 files changed, 598 insertions(+), 718 deletions(-) create mode 100644 changelog.d/3-bug-fixes/request-id-logging create mode 100644 changelog.d/5-internal/federator-simplification create mode 100644 libs/wai-utilities/test/Main.hs create mode 100644 libs/wai-utilities/test/Network/Wai/Utilities/ServerSpec.hs delete mode 100644 services/federator/src/Federator/App.hs create mode 100644 services/federator/src/Federator/Interpreter.hs delete mode 100644 services/federator/test/unit/Test/Federator/Response.hs diff --git a/.hlint.yaml b/.hlint.yaml index 9fa143c7cba..3e972c604bd 100644 --- a/.hlint.yaml +++ b/.hlint.yaml @@ -24,7 +24,7 @@ - error: { name: Use shutdown, lhs: runSettings, rhs: runSettingsWithShutdown } - ignore: { name: Use shutdown, within: [ Network.Wai.Utilities.Server, # this is the implementation 'runSettingsWithShutdown' - Federator.Response, # this is just a naming conincidence + Federator.Interpreter, # this is just a naming coincidence Cannon.Run # we do something similar, but not identical here by hand ] } diff --git a/changelog.d/3-bug-fixes/request-id-logging b/changelog.d/3-bug-fixes/request-id-logging new file mode 100644 index 00000000000..17d0fea68fc --- /dev/null +++ b/changelog.d/3-bug-fixes/request-id-logging @@ -0,0 +1 @@ +Ensure that a Request ID is logged whenever unexpected errors are caught in any service \ No newline at end of file diff --git a/changelog.d/5-internal/federator-simplification b/changelog.d/5-internal/federator-simplification new file mode 100644 index 00000000000..9a170ab3f41 --- /dev/null +++ b/changelog.d/5-internal/federator-simplification @@ -0,0 +1,3 @@ +federator: Simplify polysemy setup to make it similar to other services so the +interpreter is only used for hoisting the servant application and not explicitly +inside handler of an endpoint \ No newline at end of file diff --git a/libs/polysemy-wire-zoo/src/Wire/Sem/Logger/TinyLog.hs b/libs/polysemy-wire-zoo/src/Wire/Sem/Logger/TinyLog.hs index a7b63f7fe7d..76889f09b3a 100644 --- a/libs/polysemy-wire-zoo/src/Wire/Sem/Logger/TinyLog.hs +++ b/libs/polysemy-wire-zoo/src/Wire/Sem/Logger/TinyLog.hs @@ -51,13 +51,12 @@ loggerToTinyLogReqId :: Member (Embed IO) r => RequestId -> Log.Logger -> - Sem (Logger (Log.Msg -> Log.Msg) ': r) a -> + Sem (TinyLog ': r) a -> Sem r a loggerToTinyLogReqId r tinylog = loggerToTinyLog tinylog - . mapLogger - (Log.field "request" (unRequestId r) Log.~~) - . raise @(Logger (Log.Msg -> Log.Msg)) + . mapLogger (Log.field "request" (unRequestId r) .) + . raiseUnder @TinyLog stringLoggerToTinyLog :: Member (Logger (Log.Msg -> Log.Msg)) r => Sem (Logger String ': r) a -> Sem r a stringLoggerToTinyLog = mapLogger @String Log.msg diff --git a/libs/wai-utilities/default.nix b/libs/wai-utilities/default.nix index bc345ab3586..1c893b72f76 100644 --- a/libs/wai-utilities/default.nix +++ b/libs/wai-utilities/default.nix @@ -11,6 +11,8 @@ , errors , exceptions , gitignoreSource +, hspec +, hspec-discover , http-types , http2 , imports @@ -24,10 +26,12 @@ , schema-profunctor , servant-server , streaming-commons +, temporary , text , tinylog , types-common , unix +, uuid , wai , wai-predicates , wai-routing @@ -62,12 +66,23 @@ mkDerivation { tinylog types-common unix + uuid wai wai-predicates wai-routing warp warp-tls ]; + testHaskellDepends = [ + bytestring + hspec + http-types + imports + temporary + tinylog + wai + ]; + testToolDepends = [ hspec-discover ]; description = "Various helpers for WAI"; license = lib.licenses.agpl3Only; } diff --git a/libs/wai-utilities/src/Network/Wai/Utilities/Request.hs b/libs/wai-utilities/src/Network/Wai/Utilities/Request.hs index a0d11b59658..7da25d4449b 100644 --- a/libs/wai-utilities/src/Network/Wai/Utilities/Request.hs +++ b/libs/wai-utilities/src/Network/Wai/Utilities/Request.hs @@ -27,9 +27,10 @@ import Control.Monad.Catch (MonadThrow, throwM) import Data.Aeson import Data.ByteString qualified as B import Data.ByteString.Lazy qualified as Lazy +import Data.Id import Data.Text.Lazy qualified as Text import Imports -import Network.HTTP.Types.Status (status400) +import Network.HTTP.Types import Network.Wai import Network.Wai.Predicate import Network.Wai.Predicate.Request @@ -68,8 +69,13 @@ parseOptionalBody r = nonEmptyBody "" = Nothing nonEmptyBody ne = Just ne -lookupRequestId :: HasRequest r => r -> Maybe ByteString -lookupRequestId = lookup "Request-Id" . requestHeaders . getRequest +lookupRequestId :: HeaderName -> Request -> Maybe ByteString +lookupRequestId reqIdHeaderName = + lookup reqIdHeaderName . requestHeaders + +getRequestId :: HeaderName -> Request -> RequestId +getRequestId reqIdHeaderName req = + RequestId $ fromMaybe "N/A" $ lookupRequestId reqIdHeaderName req ---------------------------------------------------------------------------- -- Typed JSON 'Request' diff --git a/libs/wai-utilities/src/Network/Wai/Utilities/Server.hs b/libs/wai-utilities/src/Network/Wai/Utilities/Server.hs index 14fa566c12a..1425eec16a8 100644 --- a/libs/wai-utilities/src/Network/Wai/Utilities/Server.hs +++ b/libs/wai-utilities/src/Network/Wai/Utilities/Server.hs @@ -30,6 +30,7 @@ module Network.Wai.Utilities.Server route, -- * Middlewares + requestIdMiddleware, catchErrors, catchErrorsWithRequestId, OnErrorMetrics, @@ -42,10 +43,13 @@ module Network.Wai.Utilities.Server logError, logError', logErrorMsg, - logIO, runHandlers, restrict, flushRequestBody, + + -- * Constants + defaultRequestIdHeaderName, + federationRequestIdHeaderName, ) where @@ -62,18 +66,20 @@ import Data.Domain (domainText) import Data.Metrics.GC (spawnGCMetricsCollector) import Data.Metrics.Middleware import Data.Streaming.Zlib (ZlibException (..)) +import Data.Text.Encoding qualified as Text import Data.Text.Encoding.Error (lenientDecode) import Data.Text.Lazy qualified as LT import Data.Text.Lazy.Encoding qualified as LT +import Data.UUID qualified as UUID +import Data.UUID.V4 qualified as UUID import Imports -import Network.HTTP.Types.Status +import Network.HTTP.Types import Network.Wai import Network.Wai.Handler.Warp import Network.Wai.Handler.Warp.Internal (TimeoutThread) import Network.Wai.Internal qualified as WaiInt import Network.Wai.Predicate hiding (Error, err, status) import Network.Wai.Predicate qualified as P -import Network.Wai.Predicate.Request (HasRequest) import Network.Wai.Routing.Route (App, Continue, Routes, Tree) import Network.Wai.Routing.Route qualified as Route import Network.Wai.Utilities.Error qualified as Error @@ -185,8 +191,23 @@ route rt rq k = Route.routeWith (Route.Config $ errorRs' noEndpoint) rt rq (lift -------------------------------------------------------------------------------- -- Middlewares -catchErrors :: Logger -> OnErrorMetrics -> Middleware -catchErrors l m = catchErrorsWithRequestId lookupRequestId l m +requestIdMiddleware :: Logger -> HeaderName -> Middleware +requestIdMiddleware logger reqIdHeaderName origApp req responder = + case lookup reqIdHeaderName req.requestHeaders of + Just _ -> origApp req responder + Nothing -> do + reqId <- Text.encodeUtf8 . UUID.toText <$> UUID.nextRandom + unless (req.rawPathInfo `elem` ["/i/status", "/i/metrics", "/api-version"]) $ + Log.info logger $ + msg ("generated a new request id for local request" :: ByteString) + . field "request" reqId + . field "method" (requestMethod req) + . field "path" (rawPathInfo req) + let reqWithId = req {requestHeaders = (reqIdHeaderName, reqId) : req.requestHeaders} + origApp reqWithId responder + +catchErrors :: Logger -> HeaderName -> OnErrorMetrics -> Middleware +catchErrors l reqIdHeaderName m = catchErrorsWithRequestId (lookupRequestId reqIdHeaderName) l m -- | Create a middleware that catches exceptions and turns -- them into appropriate 'Error' responses, thereby logging @@ -258,8 +279,9 @@ heavyDebugLogging :: ((Request, LByteString) -> Maybe (Request, LByteString)) -> Level -> Logger -> + HeaderName -> Middleware -heavyDebugLogging sanitizeReq lvl lgr app = \req cont -> do +heavyDebugLogging sanitizeReq lvl lgr reqIdHeaderName app = \req cont -> do (bdy, req') <- if lvl `elem` [Trace, Debug] then cloneBody req @@ -278,7 +300,7 @@ heavyDebugLogging sanitizeReq lvl lgr app = \req cont -> do logMostlyEverything req bdy resp = Log.debug lgr logMsg where logMsg = - field "request" (fromMaybe "N/A" $ lookupRequestId req) + field "request" (fromMaybe "N/A" $ lookupRequestId reqIdHeaderName req) . field "request_details" (show req) . field "request_body" bdy . field "response_status" (show $ responseStatus resp) @@ -377,12 +399,18 @@ onError g mReqId m r k e = liftIO $ do flushRequestBody r k (jsonResponseToWai resp) +defaultRequestIdHeaderName :: HeaderName +defaultRequestIdHeaderName = "Request-Id" + +federationRequestIdHeaderName :: HeaderName +federationRequestIdHeaderName = "Wire-Origin-Request-Id" + -- | Log an 'Error' response for debugging purposes. -- -- It would be nice to have access to the request body here, but that's already streamed away -- by the handler in all likelyhood. See 'heavyDebugLogging'. -logError :: (MonadIO m, HasRequest r) => Logger -> Maybe r -> Wai.Error -> m () -logError g mr = logError' g (lookupRequestId =<< mr) +logError :: (MonadIO m) => Logger -> Maybe Request -> Wai.Error -> m () +logError g mr = logError' g (lookupRequestId defaultRequestIdHeaderName =<< mr) logError' :: (MonadIO m) => Logger -> Maybe ByteString -> Wai.Error -> m () logError' g mr e = liftIO $ doLog g (logErrorMsgWithRequest mr e) @@ -421,12 +449,6 @@ logErrorMsgWithRequest :: Maybe ByteString -> Wai.Error -> Msg -> Msg logErrorMsgWithRequest mr e = field "request" (fromMaybe "N/A" mr) . logErrorMsg e -logIO :: (ToBytes msg, HasRequest r) => Logger -> Level -> Maybe r -> msg -> IO () -logIO lg lv r a = - let reqId = field "request" . fromMaybe "N/A" . lookupRequestId <$> r - mesg = fromMaybe id reqId . msg a - in Log.log lg lv mesg - runHandlers :: SomeException -> [Handler m a] -> m a runHandlers e [] = throw e runHandlers e (Handler h : hs) = maybe (runHandlers e hs) h (fromException e) diff --git a/libs/wai-utilities/test/Main.hs b/libs/wai-utilities/test/Main.hs new file mode 100644 index 00000000000..a824f8c30c8 --- /dev/null +++ b/libs/wai-utilities/test/Main.hs @@ -0,0 +1 @@ +{-# OPTIONS_GHC -F -pgmF hspec-discover #-} diff --git a/libs/wai-utilities/test/Network/Wai/Utilities/ServerSpec.hs b/libs/wai-utilities/test/Network/Wai/Utilities/ServerSpec.hs new file mode 100644 index 00000000000..db27b579266 --- /dev/null +++ b/libs/wai-utilities/test/Network/Wai/Utilities/ServerSpec.hs @@ -0,0 +1,67 @@ +module Network.Wai.Utilities.ServerSpec where + +import Data.ByteString.Char8 qualified as BC8 +import Imports +import Network.HTTP.Types +import Network.Wai +import Network.Wai.Internal +import Network.Wai.Utilities.Server +import System.IO.Temp +import System.Logger qualified as Log +import Test.Hspec + +spec :: Spec +spec = do + describe "requestIdMiddleware" $ do + it "should add request id header if it is missing in the orig request" $ do + requestProcessed <- newIORef False + reqIdRef <- newIORef Nothing + withSystemTempFile "requestIdMiddlewareTest-" $ \logFile logFileHandle -> do + hClose logFileHandle + logger <- Log.new $ Log.setOutput (Log.Path logFile) Log.defSettings + let headerName = "Request-ID-Test" + app req responder = do + writeIORef requestProcessed True + case find (\(n, _) -> n == headerName) (requestHeaders req) of + Nothing -> expectationFailure "The request has no header with a request ID" + Just (_, reqId) -> writeIORef reqIdRef (Just reqId) + responder $ responseLBS status200 [] "" + req0 = defaultRequest {requestMethod = "POST", rawPathInfo = "/req-id-test"} + responder0 _resp = pure ResponseReceived + void $ requestIdMiddleware logger headerName app req0 responder0 + + Log.close logger + logEntries <- readFile logFile + + Just reqId <- readIORef reqIdRef + length (lines logEntries) `shouldBe` 1 + logEntries `shouldContain` "generated a new request id for local request" + logEntries `shouldContain` ("request=" <> BC8.unpack reqId) + logEntries `shouldContain` "method=POST" + logEntries `shouldContain` "path=/req-id-test" + + readIORef requestProcessed `shouldReturn` True + + it "should not add request id header if is present in the orig request" $ do + requestProcessed <- newIORef False + withSystemTempFile "requestIdMiddlewareTest-" $ \logFile logFileHandle -> do + hClose logFileHandle + logger <- Log.new $ Log.setOutput (Log.Path logFile) Log.defSettings + let origRequestId = "test-req-id" + headerName = "Request-ID-Test" + app req responder = do + writeIORef requestProcessed True + case find (\(n, _) -> n == headerName) (requestHeaders req) of + Nothing -> expectationFailure "The request has no header with a request ID" + Just (_, foundReqId) -> foundReqId `shouldBe` origRequestId + responder $ responseLBS status200 [] "" + req0 = defaultRequest {requestHeaders = [(headerName, origRequestId)]} + responder0 _resp = pure ResponseReceived + void $ requestIdMiddleware logger headerName app req0 responder0 + Log.close logger + + -- Nothing should be logged + logEntries <- readFile logFile + length logEntries `shouldBe` 0 + + readIORef requestProcessed `shouldReturn` True diff --git a/libs/wai-utilities/wai-utilities.cabal b/libs/wai-utilities/wai-utilities.cabal index 6105387dddb..4741ef9cd04 100644 --- a/libs/wai-utilities/wai-utilities.cabal +++ b/libs/wai-utilities/wai-utilities.cabal @@ -1,4 +1,4 @@ -cabal-version: 1.12 +cabal-version: 3.0 name: wai-utilities version: 0.16.1 synopsis: Various helpers for WAI @@ -7,24 +7,17 @@ category: Web author: Wire Swiss GmbH maintainer: Wire Swiss GmbH copyright: (c) 2017 Wire Swiss GmbH -license: AGPL-3 +license: AGPL-3.0-only license-file: LICENSE build-type: Simple -library - exposed-modules: - Network.Wai.Utilities - Network.Wai.Utilities.Error - Network.Wai.Utilities.Headers - Network.Wai.Utilities.JSONResponse - Network.Wai.Utilities.MockServer - Network.Wai.Utilities.Request - Network.Wai.Utilities.Response - Network.Wai.Utilities.Server - Network.Wai.Utilities.ZAuth +common common-all + default-language: GHC2021 + ghc-options: + -O2 -Wall -Wincomplete-uni-patterns -Wincomplete-record-updates + -Wpartial-fields -fwarn-tabs -optP-Wno-nonportable-include-path + -Wredundant-constraints -Wunused-packages - other-modules: Paths_wai_utilities - hs-source-dirs: src default-extensions: AllowAmbiguousTypes BangPatterns @@ -67,13 +60,23 @@ library UndecidableInstances ViewPatterns - ghc-options: - -O2 -Wall -Wincomplete-uni-patterns -Wincomplete-record-updates - -Wpartial-fields -fwarn-tabs -optP-Wno-nonportable-include-path - -Wredundant-constraints -Wunused-packages +library + import: common-all + exposed-modules: + Network.Wai.Utilities + Network.Wai.Utilities.Error + Network.Wai.Utilities.Headers + Network.Wai.Utilities.JSONResponse + Network.Wai.Utilities.MockServer + Network.Wai.Utilities.Request + Network.Wai.Utilities.Response + Network.Wai.Utilities.Server + Network.Wai.Utilities.ZAuth + other-modules: Paths_wai_utilities + hs-source-dirs: src build-depends: - aeson >=2.0.1.0 + , aeson >=2.0.1.0 , async >=2.0 , base >=4.6 && <5.0 , bytestring >=0.10 @@ -96,10 +99,29 @@ library , tinylog >=0.8 , types-common >=0.12 , unix >=2.7 + , uuid , wai >=3.0 , wai-predicates >=0.8 , wai-routing >=0.12 , warp >=3.0 , warp-tls - default-language: GHC2021 +test-suite wai-utilities-tests + import: common-all + type: exitcode-stdio-1.0 + main-is: Main.hs + ghc-options: -threaded -with-rtsopts=-N + hs-source-dirs: test + build-tool-depends: hspec-discover:hspec-discover + + -- cabal-fmt: expand test -Main + other-modules: Network.Wai.Utilities.ServerSpec + build-depends: + , bytestring + , hspec + , http-types + , imports + , temporary + , tinylog + , wai + , wai-utilities diff --git a/services/brig/src/Brig/Run.hs b/services/brig/src/Brig/Run.hs index 35f3fd36efa..8c0c6facda0 100644 --- a/services/brig/src/Brig/Run.hs +++ b/services/brig/src/Brig/Run.hs @@ -46,28 +46,23 @@ import Control.Monad.Catch (MonadCatch, finally) import Control.Monad.Random (randomRIO) import Data.Aeson qualified as Aeson import Data.ByteString.UTF8 qualified as UTF8 -import Data.Id (RequestId (..)) import Data.Metrics.AWS (gaugeTokenRemaing) import Data.Metrics.Servant qualified as Metrics import Data.Proxy (Proxy (Proxy)) import Data.Text (unpack) -import Data.Text.Encoding -import Data.UUID as UUID -import Data.UUID.V4 as UUID import Imports hiding (head) import Network.HTTP.Media qualified as HTTPMedia import Network.HTTP.Types qualified as HTTP import Network.Wai qualified as Wai import Network.Wai.Middleware.Gunzip qualified as GZip import Network.Wai.Middleware.Gzip qualified as GZip -import Network.Wai.Utilities (lookupRequestId) +import Network.Wai.Utilities.Request import Network.Wai.Utilities.Server import Network.Wai.Utilities.Server qualified as Server import Polysemy (Member) import Servant (Context ((:.)), (:<|>) (..)) import Servant qualified -import System.Logger (Logger, msg, val, (.=), (~~)) -import System.Logger qualified as Log +import System.Logger (msg, val, (.=), (~~)) import System.Logger.Class (MonadLogger, err) import Util.Options import Wire.API.Routes.API @@ -118,31 +113,36 @@ run o = do mkApp :: Opts -> IO (Wai.Application, Env) mkApp o = do e <- newEnv o - pure (middleware e $ \reqId -> servantApp (e & requestId .~ reqId), e) + pure (middleware e $ servantApp e, e) where - middleware :: Env -> (RequestId -> Wai.Application) -> Wai.Application + middleware :: Env -> Wai.Middleware middleware e = -- this rewrites the request, so it must be at the top (i.e. applied last) versionMiddleware (e ^. disabledVersions) + -- this also rewrites the request + . requestIdMiddleware (e ^. applog) defaultRequestIdHeaderName . Metrics.servantPrometheusMiddleware (Proxy @ServantCombinedAPI) . GZip.gunzip . GZip.gzip GZip.def - . catchErrors (e ^. applog) [Right $ e ^. metrics] - . lookupRequestIdMiddleware (e ^. applog) + . catchErrors (e ^. applog) defaultRequestIdHeaderName [Right $ e ^. metrics] -- the servant API wraps the one defined using wai-routing servantApp :: Env -> Wai.Application - servantApp e = + servantApp e0 req cont = do + let rid = getRequestId defaultRequestIdHeaderName req + let e = requestId .~ rid $ e0 let localDomain = view (settings . federationDomain) e - in Servant.serveWithContext - (Proxy @ServantCombinedAPI) - (customFormatters :. localDomain :. Servant.EmptyContext) - ( docsAPI - :<|> hoistServerWithDomain @BrigAPI (toServantHandler e) servantSitemap - :<|> hoistServerWithDomain @IAPI.API (toServantHandler e) IAPI.servantSitemap - :<|> hoistServerWithDomain @FederationAPI (toServantHandler e) federationSitemap - :<|> hoistServerWithDomain @VersionAPI (toServantHandler e) versionAPI - ) + Servant.serveWithContext + (Proxy @ServantCombinedAPI) + (customFormatters :. localDomain :. Servant.EmptyContext) + ( docsAPI + :<|> hoistServerWithDomain @BrigAPI (toServantHandler e) servantSitemap + :<|> hoistServerWithDomain @IAPI.API (toServantHandler e) IAPI.servantSitemap + :<|> hoistServerWithDomain @FederationAPI (toServantHandler e) federationSitemap + :<|> hoistServerWithDomain @VersionAPI (toServantHandler e) versionAPI + ) + req + cont type ServantCombinedAPI = ( DocsAPI @@ -152,20 +152,6 @@ type ServantCombinedAPI = :<|> VersionAPI ) -lookupRequestIdMiddleware :: Logger -> (RequestId -> Wai.Application) -> Wai.Application -lookupRequestIdMiddleware logger mkapp req cont = do - case lookupRequestId req of - Just rid -> do - mkapp (RequestId rid) req cont - Nothing -> do - localRid <- RequestId . encodeUtf8 . UUID.toText <$> UUID.nextRandom - Log.info logger $ - "request-id" .= localRid - ~~ "method" .= Wai.requestMethod req - ~~ "path" .= Wai.rawPathInfo req - ~~ msg (val "generated a new request id for local request") - mkapp localRid req cont - customFormatters :: Servant.ErrorFormatters customFormatters = Servant.defaultErrorFormatters diff --git a/services/cannon/cannon.cabal b/services/cannon/cannon.cabal index 992758164de..e69c1a663ae 100644 --- a/services/cannon/cannon.cabal +++ b/services/cannon/cannon.cabal @@ -107,7 +107,6 @@ library , types-common >=0.16 , unix , unliftio - , uuid , vector >=0.10 , wai >=3.0 , wai-extra >=3.0 diff --git a/services/cannon/default.nix b/services/cannon/default.nix index dce615c2001..2161483f93f 100644 --- a/services/cannon/default.nix +++ b/services/cannon/default.nix @@ -87,7 +87,6 @@ mkDerivation { types-common unix unliftio - uuid vector wai wai-extra diff --git a/services/cannon/src/Cannon/Run.hs b/services/cannon/src/Cannon/Run.hs index 01eeefc167d..c3ec4f6f4d5 100644 --- a/services/cannon/src/Cannon/Run.hs +++ b/services/cannon/src/Cannon/Run.hs @@ -82,9 +82,10 @@ run o = do let middleware :: Wai.Middleware middleware = versionMiddleware (foldMap expandVersionExp (o ^. disabledAPIVersions)) + . requestIdMiddleware g defaultRequestIdHeaderName . servantPrometheusMiddleware (Proxy @CombinedAPI) . Gzip.gzip Gzip.def - . catchErrors g [Right m] + . catchErrors g defaultRequestIdHeaderName [Right m] app :: Application app = middleware (serve (Proxy @CombinedAPI) server) server :: Servant.Server CombinedAPI diff --git a/services/cannon/src/Cannon/Types.hs b/services/cannon/src/Cannon/Types.hs index 9dc29f2e2e8..31abc52800c 100644 --- a/services/cannon/src/Cannon/Types.hs +++ b/services/cannon/src/Cannon/Types.hs @@ -38,7 +38,7 @@ module Cannon.Types ) where -import Bilge (Manager, RequestId (..), requestIdName) +import Bilge (Manager, RequestId (..)) import Bilge.RPC (HasRequestId (..)) import Cannon.Dict (Dict) import Cannon.Options @@ -49,12 +49,11 @@ import Control.Lens ((^.)) import Control.Monad.Catch import Data.Metrics.Middleware import Data.Text.Encoding -import Data.UUID as UUID -import Data.UUID.V4 as UUID import Imports import Network.Wai +import Network.Wai.Utilities.Request qualified as Wai +import Network.Wai.Utilities.Server import Servant qualified -import System.Logger qualified as Log import System.Logger qualified as Logger import System.Logger.Class hiding (info) import System.Random.MWC (GenIO) @@ -115,25 +114,13 @@ mkEnv m external o l d p g t = runCannon :: Env -> Cannon a -> Request -> IO a runCannon e c r = do - rid <- lookupReqId e.applog r - let e' = e {reqId = rid} + let rid = Wai.getRequestId defaultRequestIdHeaderName r + e' = e {reqId = rid} runCannon' e' c runCannon' :: Env -> Cannon a -> IO a runCannon' e c = runReaderT (unCannon c) e -lookupReqId :: Logger -> Request -> IO RequestId -lookupReqId l r = case lookup requestIdName (requestHeaders r) of - Just rid -> pure $ RequestId rid - Nothing -> do - localRid <- RequestId . UUID.toASCIIBytes <$> UUID.nextRandom - Log.info l $ - "request-id" .= localRid - ~~ "method" .= requestMethod r - ~~ "path" .= rawPathInfo r - ~~ msg (val "generated a new request id for local request") - pure localRid - options :: Cannon Opts options = Cannon $ asks opts diff --git a/services/cargohold/src/CargoHold/Run.hs b/services/cargohold/src/CargoHold/Run.hs index 2a7165e162d..783199cccb3 100644 --- a/services/cargohold/src/CargoHold/Run.hs +++ b/services/cargohold/src/CargoHold/Run.hs @@ -24,7 +24,6 @@ where import AWS.Util (readAuthExpiration) import qualified Amazonka as AWS -import Bilge.Request (requestIdName) import CargoHold.API.Federation import CargoHold.API.Public import CargoHold.AWS (amazonkaEnv) @@ -33,24 +32,20 @@ import CargoHold.Options hiding (aws) import Control.Exception (bracket) import Control.Lens ((.~), (^.)) import Control.Monad.Codensity -import Data.Id import Data.Metrics (Metrics) import Data.Metrics.AWS (gaugeTokenRemaing) import Data.Metrics.Servant import Data.Proxy import Data.Text (unpack) -import Data.UUID as UUID -import Data.UUID.V4 as UUID import Imports import qualified Network.Wai as Wai import qualified Network.Wai.Middleware.Gzip as GZip +import Network.Wai.Utilities.Request import Network.Wai.Utilities.Server import qualified Network.Wai.Utilities.Server as Server import qualified Servant import Servant.API import Servant.Server hiding (Handler, runHandler) -import System.Logger (Logger, msg, val, (.=), (~~)) -import qualified System.Logger as Log import qualified UnliftIO.Async as Async import Util.Options import Wire.API.Routes.API @@ -83,13 +78,14 @@ mkApp o = Codensity $ \k -> middleware :: Env -> Wai.Middleware middleware e = versionMiddleware (foldMap expandVersionExp (o ^. settings . disabledAPIVersions)) + . requestIdMiddleware (e ^. appLogger) defaultRequestIdHeaderName . servantPrometheusMiddleware (Proxy @CombinedAPI) . GZip.gzip GZip.def - . catchErrors (e ^. appLogger) [Right $ e ^. metrics] + . catchErrors (e ^. appLogger) defaultRequestIdHeaderName [Right $ e ^. metrics] servantApp :: Env -> Application servantApp e0 r cont = do - rid <- lookupReqId (e0 ^. appLogger) r - let e = requestId .~ rid $ e0 + let rid = getRequestId defaultRequestIdHeaderName r + e = requestId .~ rid $ e0 Servant.serveWithContext (Proxy @CombinedAPI) ((o ^. settings . federationDomain) :. Servant.EmptyContext) @@ -100,18 +96,6 @@ mkApp o = Codensity $ \k -> r cont - lookupReqId :: Logger -> Wai.Request -> IO RequestId - lookupReqId l r = case lookup requestIdName $ Wai.requestHeaders r of - Just rid -> pure $ RequestId rid - Nothing -> do - localRid <- RequestId . UUID.toASCIIBytes <$> UUID.nextRandom - Log.info l $ - "request-id" .= localRid - ~~ "method" .= Wai.requestMethod r - ~~ "path" .= Wai.rawPathInfo r - ~~ msg (val "generated a new request id for local request") - pure localRid - toServantHandler :: Env -> Handler a -> Servant.Handler a toServantHandler env = liftIO . runHandler env diff --git a/services/federator/default.nix b/services/federator/default.nix index 423926f9509..9b687bbd39e 100644 --- a/services/federator/default.nix +++ b/services/federator/default.nix @@ -123,7 +123,6 @@ mkDerivation { types-common unix utf8-string - uuid wai wai-utilities warp diff --git a/services/federator/federator.cabal b/services/federator/federator.cabal index 4fa411b3be0..1812c4e115b 100644 --- a/services/federator/federator.cabal +++ b/services/federator/federator.cabal @@ -35,7 +35,6 @@ extra-source-files: library -- cabal-fmt: expand src exposed-modules: - Federator.App Federator.Discovery Federator.Env Federator.Error @@ -43,6 +42,7 @@ library Federator.ExternalServer Federator.Health Federator.InternalServer + Federator.Interpreter Federator.Metrics Federator.MockServer Federator.Monitor @@ -148,7 +148,6 @@ library , types-common , unix , utf8-string - , uuid , wai , wai-utilities , warp @@ -326,7 +325,6 @@ test-suite federator-tests Test.Federator.Monitor Test.Federator.Options Test.Federator.Remote - Test.Federator.Response Test.Federator.Util Test.Federator.Validation diff --git a/services/federator/src/Federator/App.hs b/services/federator/src/Federator/App.hs deleted file mode 100644 index 30561b19923..00000000000 --- a/services/federator/src/Federator/App.hs +++ /dev/null @@ -1,93 +0,0 @@ -{-# LANGUAGE DerivingStrategies #-} -{-# LANGUAGE GeneralizedNewtypeDeriving #-} - --- This file is part of the Wire Server implementation. --- --- Copyright (C) 2022 Wire Swiss GmbH --- --- This program is free software: you can redistribute it and/or modify it under --- the terms of the GNU Affero General Public License as published by the Free --- Software Foundation, either version 3 of the License, or (at your option) any --- later version. --- --- This program is distributed in the hope that it will be useful, but WITHOUT --- ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS --- FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for more --- details. --- --- You should have received a copy of the GNU Affero General Public License along --- with this program. If not, see . - -module Federator.App - ( AppT, - runAppT, - embedApp, - ) -where - -import Bilge (MonadHttp (..), RequestId (unRequestId), withResponse) -import Bilge.RPC (HasRequestId (..)) -import Control.Lens (view) -import Control.Monad.Catch -import Control.Monad.Except -import Federator.Env (Env, applog, httpManager, requestId) -import Imports -import Polysemy -import Polysemy.Input -import System.Logger.Class as LC -import System.Logger.Extended qualified as Log - --- FUTUREWORK(federation): this code re-occurs in every service. introduce 'MkAppT' in types-common that --- takes 'Env' as one more argument. -newtype AppT m a = AppT - { unAppT :: ReaderT Env m a - } - deriving newtype - ( Functor, - Applicative, - Monad, - MonadIO, - MonadThrow, - MonadCatch, - MonadMask, - MonadReader Env - ) - -instance MonadIO m => LC.MonadLogger (AppT m) where - log l m = do - g <- view applog - r <- view requestId - Log.log g l $ field "request" (unRequestId r) ~~ m - -instance MonadIO m => LC.MonadLogger (ExceptT err (AppT m)) where - log l m = lift (LC.log l m) - -instance Monad m => HasRequestId (AppT m) where - getRequestId = view requestId - -instance MonadUnliftIO m => MonadUnliftIO (AppT m) where - withRunInIO inner = - AppT . ReaderT $ \r -> - withRunInIO $ \runner -> - inner (runner . flip runReaderT r . unAppT) - -instance MonadTrans AppT where - lift = AppT . lift - -instance MonadIO m => MonadHttp (AppT m) where - handleRequestWithCont req handler = do - manager <- view httpManager <$> ask - liftIO $ withResponse req manager handler - -runAppT :: forall m a. Env -> AppT m a -> m a -runAppT e (AppT ma) = runReaderT ma e - -embedApp :: - ( Member (Embed m) r, - Member (Input Env) r - ) => - AppT m a -> - Sem r a -embedApp (AppT action) = do - env <- input - embed $ runReaderT action env diff --git a/services/federator/src/Federator/Env.hs b/services/federator/src/Federator/Env.hs index 12f3670ef18..e15b19f532b 100644 --- a/services/federator/src/Federator/Env.hs +++ b/services/federator/src/Federator/Env.hs @@ -21,7 +21,6 @@ module Federator.Env where -import Bilge (RequestId) import Control.Lens (makeLenses) import Data.Metrics (Metrics) import Federator.Options (RunSettings) @@ -43,7 +42,6 @@ data FederatorMetrics = FederatorMetrics data Env = Env { _metrics :: Metrics, _applog :: LC.Logger, - _requestId :: RequestId, _dnsResolver :: Resolver, _runSettings :: RunSettings, _service :: Component -> Endpoint, diff --git a/services/federator/src/Federator/ExternalServer.hs b/services/federator/src/Federator/ExternalServer.hs index 4a2f83d4c5f..11345b1ae6b 100644 --- a/services/federator/src/Federator/ExternalServer.hs +++ b/services/federator/src/Federator/ExternalServer.hs @@ -24,25 +24,20 @@ module Federator.ExternalServer ) where -import Control.Monad.Codensity import Data.Bifunctor import Data.ByteString qualified as BS import Data.ByteString.Builder import Data.ByteString.Lazy qualified as LBS import Data.Domain -import Data.Id (RequestId (..)) -import Data.Metrics.Servant qualified as Metrics -import Data.Proxy (Proxy (Proxy)) import Data.Sequence qualified as Seq import Data.Text qualified as Text import Data.Text.Encoding qualified as Text -import Data.UUID as UUID -import Data.UUID.V4 as UUID import Data.X509 qualified as X509 import Federator.Discovery import Federator.Env import Federator.Error.ServerError import Federator.Health qualified as Health +import Federator.Interpreter import Federator.Metrics import Federator.RPC import Federator.Response @@ -57,18 +52,17 @@ import Polysemy.Error import Polysemy.Input import Polysemy.TinyLog (TinyLog) import Polysemy.TinyLog qualified as Log +import Servant qualified import Servant.API import Servant.API.Extended.Endpath +import Servant.API.Extended.RawM import Servant.Client.Core -import Servant.Server (Tagged (..)) -import Servant.Server.Generic -import System.Logger (msg, val, (.=), (~~)) +import Servant.Server.Generic (AsServerT) import System.Logger.Message qualified as Log import Wire.API.Federation.Component import Wire.API.Federation.Domain import Wire.API.Routes.FederationDomainConfig import Wire.API.VersionInfo -import Wire.Sem.Logger (info) -- | Used to get PEM encoded certificate out of an HTTP header newtype CertHeader = CertHeader X509.Certificate @@ -92,14 +86,12 @@ data API mode = API :- "federation" :> Capture "component" Component :> Capture "rpc" RPC - :> Header "Wire-Origin-Request-Id" RequestId :> Header' '[Required, Strict] OriginDomainHeaderName Domain :> Header' '[Required, Strict] "X-SSL-Certificate" CertHeader :> Endpath - -- We need to use 'Raw' so we can stream request body regardless of - -- content-type and send a response with arbitrary content-type. Not - -- sure if this is the right approach. - :> Raw + -- We need to use 'RawM' so we can stream request body regardless of + -- content-type and send a response with arbitrary content-type. + :> RawM } deriving (Generic) @@ -111,18 +103,17 @@ server :: Member (Error ValidationError) r, Member (Error DiscoveryFailure) r, Member (Error ServerError) r, + Member (Error Servant.ServerError) r, Member (Input FederationDomainConfigs) r, Member Metrics r ) => Manager -> Word16 -> - (Sem r Wai.Response -> Codensity IO Wai.Response) -> - API AsServer -server mgr intPort interpreter = + API (AsServerT (Sem r)) +server mgr intPort = API { status = Health.status mgr "internal server" intPort, - externalRequest = \component rpc mReqId remoteDomain remoteCert -> - Tagged $ \req respond -> runCodensity (interpreter (callInward component rpc mReqId remoteDomain remoteCert req)) respond + externalRequest = callInward } -- FUTUREWORK(federation): Versioning of the federation API. @@ -139,22 +130,12 @@ callInward :: ) => Component -> RPC -> - Maybe RequestId -> Domain -> CertHeader -> Wai.Request -> - Sem r Wai.Response -callInward component (RPC rpc) mReqId originDomain (CertHeader cert) wreq = do - rid <- case mReqId of - Just r -> pure r - Nothing -> do - localRid <- liftIO $ RequestId . Text.encodeUtf8 . UUID.toText <$> UUID.nextRandom - info $ - "request-id" .= localRid - ~~ "method" .= Wai.requestMethod wreq - ~~ "path" .= Wai.rawPathInfo wreq - ~~ msg (val "generated a new request id for local request") - pure localRid + (Wai.Response -> IO Wai.ResponseReceived) -> + Sem r Wai.ResponseReceived +callInward component (RPC rpc) originDomain (CertHeader cert) wreq cont = do incomingCounterIncr originDomain -- only POST is supported when (Wai.requestMethod wreq /= HTTP.methodPost) $ @@ -169,7 +150,6 @@ callInward component (RPC rpc) mReqId originDomain (CertHeader cert) wreq = do . Log.field "originDomain" (domainText originDomain) . Log.field "component" (show component) . Log.field "rpc" rpc - . Log.field "request" rid validatedDomain <- validateDomain cert originDomain @@ -177,12 +157,11 @@ callInward component (RPC rpc) mReqId originDomain (CertHeader cert) wreq = do body <- embed $ Wai.lazyRequestBody wreq let headers = filter ((== versionHeader) . fst) (Wai.requestHeaders wreq) - resp <- serviceCall component path headers body rid validatedDomain + resp <- serviceCall component path headers body validatedDomain Log.debug $ Log.msg ("Inward Request response" :: ByteString) . Log.field "status" (show (responseStatusCode resp)) - . Log.field "request" rid - pure $ + embed . cont $ streamingResponseToWai resp { responseHeaders = @@ -192,8 +171,5 @@ callInward component (RPC rpc) mReqId originDomain (CertHeader cert) wreq = do } serveInward :: Env -> Int -> IO () -serveInward env = - serveServant - (Metrics.servantPrometheusMiddleware $ Proxy @(ToServantApi API)) - (server env._httpManager env._internalPort $ runFederator env) - env +serveInward env port = + serveServant @(ToServantApi API) env port $ toServant $ server env._httpManager env._internalPort diff --git a/services/federator/src/Federator/Health.hs b/services/federator/src/Federator/Health.hs index 857a3e56415..602faf7ddd0 100644 --- a/services/federator/src/Federator/Health.hs +++ b/services/federator/src/Federator/Health.hs @@ -5,9 +5,12 @@ import Data.ByteString.UTF8 qualified as UTF8 import Imports import Network.HTTP.Client import Network.HTTP.Types.Status qualified as HTTP +import Polysemy +import Polysemy.Error import Servant status :: + (Member (Embed IO) r, Member (Error ServerError) r) => Manager -> -- | Name of other service LByteString -> @@ -15,15 +18,15 @@ status :: Word16 -> -- | standalone flag, when specified only return status of current service Bool -> - Handler NoContent + Sem r NoContent status _ _ _ True = pure NoContent status mgr otherName otherPort False = do - req <- parseRequest $ "http://localhost:" <> show otherPort <> "/i/status?standalone" + req <- liftIO $ parseRequest $ "http://localhost:" <> show otherPort <> "/i/status?standalone" res <- liftIO $ httpNoBody req mgr if HTTP.statusIsSuccessful $ responseStatus res then pure NoContent else - throwError + throw Servant.err500 { Servant.errBody = otherName diff --git a/services/federator/src/Federator/InternalServer.hs b/services/federator/src/Federator/InternalServer.hs index ef6cbd0cce4..12a25475c35 100644 --- a/services/federator/src/Federator/InternalServer.hs +++ b/services/federator/src/Federator/InternalServer.hs @@ -20,19 +20,13 @@ module Federator.InternalServer where -import Control.Monad.Codensity import Data.Binary.Builder import Data.ByteString qualified as BS import Data.Domain -import Data.Id -import Data.Metrics.Servant qualified as Metrics -import Data.Proxy -import Data.Text.Encoding qualified as T -import Data.UUID as UUID -import Data.UUID.V4 as UUID import Federator.Env import Federator.Error.ServerError import Federator.Health qualified as Health +import Federator.Interpreter import Federator.Metrics (Metrics, outgoingCounterIncr) import Federator.RPC import Federator.Remote @@ -45,15 +39,15 @@ import Network.Wai qualified as Wai import Polysemy import Polysemy.Error import Polysemy.Input +import Polysemy.TinyLog +import Servant qualified import Servant.API import Servant.API.Extended.Endpath -import Servant.Server (Tagged (..)) +import Servant.API.Extended.RawM import Servant.Server.Generic -import System.Logger (msg, val, (.=), (~~)) import System.Logger.Class qualified as Log import Wire.API.Federation.Component import Wire.API.Routes.FederationDomainConfig -import Wire.Sem.Logger (Logger, debug, info) data API mode = API { status :: @@ -67,15 +61,13 @@ data API mode = API internalRequest :: mode :- "rpc" - :> Header "Wire-Origin-Request-Id" RequestId :> Capture "domain" Domain :> Capture "component" Component :> Capture "rpc" RPC :> Endpath - -- We need to use 'Raw' so we can stream request body regardless of - -- content-type and send a response with arbitrary content-type. Not - -- sure if this is the right approach. - :> Raw + -- We need to use 'RawM' so we can stream request body regardless of + -- content-type and send a response with arbitrary content-type. + :> RawM } deriving (Generic) @@ -86,17 +78,16 @@ server :: Member (Error ServerError) r, Member (Input FederationDomainConfigs) r, Member Metrics r, - Member (Logger (Log.Msg -> Log.Msg)) r + Member (Logger (Log.Msg -> Log.Msg)) r, + Member (Error Servant.ServerError) r ) => Manager -> Word16 -> - (Sem r Wai.Response -> Codensity IO Wai.Response) -> - API AsServer -server mgr extPort interpreter = + API (AsServerT (Sem r)) +server mgr extPort = API { status = Health.status mgr "external server" extPort, - internalRequest = \mReqId remoteDomain component rpc -> - Tagged $ \req respond -> runCodensity (interpreter (callOutward mReqId remoteDomain component rpc req)) respond + internalRequest = callOutward } callOutward :: @@ -108,23 +99,13 @@ callOutward :: Member Metrics r, Member (Logger (Log.Msg -> Log.Msg)) r ) => - Maybe RequestId -> Domain -> Component -> RPC -> Wai.Request -> - Sem r Wai.Response -callOutward mReqId targetDomain component (RPC path) req = do - rid <- case mReqId of - Just r -> pure r - Nothing -> do - localRid <- liftIO $ RequestId . T.encodeUtf8 . UUID.toText <$> UUID.nextRandom - info $ - "request-id" .= localRid - ~~ "method" .= Wai.requestMethod req - ~~ "path" .= Wai.rawPathInfo req - ~~ msg (val "generated a new request id for local request") - pure localRid + (Wai.Response -> IO Wai.ResponseReceived) -> + Sem r Wai.ResponseReceived +callOutward targetDomain component (RPC path) req cont = do -- only POST is supported when (Wai.requestMethod req /= HTTP.methodPost) $ throw InvalidRoute @@ -142,17 +123,13 @@ callOutward mReqId targetDomain component (RPC path) req = do . Log.field "body" body resp <- discoverAndCall - rid targetDomain component path (Wai.requestHeaders req) (fromLazyByteString body) - pure $ streamingResponseToWai resp + embed . cont $ streamingResponseToWai resp serveOutward :: Env -> Int -> IO () -serveOutward env = - serveServant - (Metrics.servantPrometheusMiddleware $ Proxy @(ToServantApi API)) - (server env._httpManager env._externalPort $ runFederator env) - env +serveOutward env port = do + serveServant @(ToServantApi API) env port (toServant $ server env._httpManager env._internalPort) diff --git a/services/federator/src/Federator/Interpreter.hs b/services/federator/src/Federator/Interpreter.hs new file mode 100644 index 00000000000..089ef1ff07e --- /dev/null +++ b/services/federator/src/Federator/Interpreter.hs @@ -0,0 +1,190 @@ +module Federator.Interpreter + ( runWaiErrors, + serveServant, + ) +where + +import Control.Lens +import Control.Monad.Codensity +import Control.Monad.Except +import Data.Aeson (encode) +import Data.Id +import Data.Kind +import Data.Metrics.Servant qualified as Metrics +import Data.Text qualified as T +import Data.Text.Lazy qualified as LText +import Federator.Discovery +import Federator.Env +import Federator.Error +import Federator.Error.ServerError +import Federator.Metrics (Metrics, interpretMetrics) +import Federator.Options +import Federator.Remote +import Federator.Service +import Federator.Validation +import HTTP2.Client.Manager (Http2Manager) +import Imports +import Network.HTTP.Types qualified as HTTP +import Network.Wai qualified as Wai +import Network.Wai.Handler.Warp qualified as Warp +import Network.Wai.Utilities (getRequestId) +import Network.Wai.Utilities.Error qualified as Wai +import Network.Wai.Utilities.Server (federationRequestIdHeaderName, requestIdMiddleware) +import Network.Wai.Utilities.Server qualified as Wai +import Polysemy +import Polysemy.Embed +import Polysemy.Error +import Polysemy.Input +import Polysemy.Internal +import Polysemy.TinyLog +import Servant (ServerError (..), serve) +import Servant hiding (ServerError, respond, serve) +import Servant.Client (mkClientEnv) +import Servant.Client.Core +import Util.Options (Endpoint (..)) +import Wire.API.FederationUpdate qualified as FedUp (getFederationDomainConfigs) +import Wire.API.MakesFederatedCall (Component (Brig)) +import Wire.API.Routes.FederationDomainConfig qualified as FedUp (FederationDomainConfigs) +import Wire.Network.DNS.Effect +import Wire.Sem.Logger.TinyLog + +class ErrorEffects (ee :: [Type]) r where + type Row ee :: EffectRow + runWaiErrorsEither :: + Sem (Append (Row ee) r) (Either Wai.Error a) -> + Sem r (Either Wai.Error a) + +runWaiErrors :: + forall ee r a. + (ErrorEffects ee r, Member (Error Servant.ServerError) r) => + Sem (Append (Row ee) r) a -> + Sem r a +runWaiErrors action = do + x <- runWaiErrorsEither @ee . fmap Right $ action + case x of + Left e -> throw $ waiToServant e + Right a -> pure a + +instance ErrorEffects '[] r where + type Row '[] = '[] + runWaiErrorsEither = id + +instance + ( Member TinyLog (Append (Row ee) r), + AsWai e, + ErrorEffects ee r + ) => + ErrorEffects (e ': ee) r + where + type Row (e ': ee) = (Error e ': Row ee) + runWaiErrorsEither action = do + runWaiErrorsEither @ee $ runWaiErrorEither @e action + +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 + where + logError :: + ( Member (Error Wai.Error) r, + Member TinyLog r + ) => + Wai.Error -> + Sem r a + logError e = do + err $ Wai.logErrorMsg e + throw e + +serveServant :: + forall (api :: Type). + (HasServer api '[], Metrics.RoutesToPaths api) => + Env -> + Int -> + ServerT api (Sem AllEffects) -> + IO () +serveServant env port server = do + let hoistApp :: RequestId -> Server api + hoistApp rid = + hoistServerWithContext (Proxy @api) (Proxy @'[]) (runFederator env rid) server + Warp.run port + . requestIdMiddleware env._applog federationRequestIdHeaderName + . Wai.catchErrors (view applog env) federationRequestIdHeaderName [] + . Metrics.servantPrometheusMiddleware (Proxy @api) + $ app hoistApp + where + app :: (RequestId -> Server api) -> Wai.Application + app mkServerFromReqId req cont = do + let rid = getRequestId federationRequestIdHeaderName req + serve (Proxy @api) (mkServerFromReqId rid) req cont + +type AllEffects = + '[ Metrics, + Remote, + DiscoverFederator, + DNSLookup, -- needed by DiscoverFederator + ServiceStreaming, + Input RunSettings, + Input Http2Manager, -- needed by Remote + Input FedUp.FederationDomainConfigs, -- needed for the domain list and federation policy. + Input Env, -- needed by Service + Input RequestId, + Error ValidationError, + Error RemoteError, + Error Federator.Error.ServerError.ServerError, + Error DiscoveryFailure, + Error Servant.ServerError, + TinyLog, + Embed IO, + Embed (Codensity IO) + ] + +runFederator :: Env -> RequestId -> Sem AllEffects a -> Handler a +runFederator env rid = + Handler + . ExceptT + . lowerCodensity + . runM + . runEmbedded (liftIO @(Codensity IO)) + . loggerToTinyLogReqId rid (view applog env) + . runError + . runWaiErrors + @'[ ValidationError, + RemoteError, + Federator.Error.ServerError.ServerError, + DiscoveryFailure + ] + . runInputConst rid + . runInputConst env + . runInputSem (embed @IO (getFederationDomainConfigs env)) + . runInputSem (embed @IO (readIORef (view http2Manager env))) + . runInputConst (view runSettings env) + . interpretServiceHTTP + . runDNSLookupWithResolver (view dnsResolver env) + . runFederatorDiscovery + . interpretRemote + . interpretMetrics + +waiToServant :: Wai.Error -> Servant.ServerError +waiToServant waierr = + ServerError + { errHTTPCode = HTTP.statusCode (Wai.code waierr), + errReasonPhrase = LText.unpack (Wai.label waierr), + errBody = encode waierr, + errHeaders = [("Content-Type", "application/json")] + } + +getFederationDomainConfigs :: Env -> IO FedUp.FederationDomainConfigs +getFederationDomainConfigs env = do + let mgr = env ^. httpManager + Endpoint h p = env ^. service $ Brig + baseurl = BaseUrl Http (T.unpack h) (fromIntegral p) "" + clientEnv = mkClientEnv mgr baseurl + FedUp.getFederationDomainConfigs clientEnv >>= \case + Right v -> pure v + Left e -> error $ show e diff --git a/services/federator/src/Federator/MockServer.hs b/services/federator/src/Federator/MockServer.hs index 463967531ba..a5dd6ae38e1 100644 --- a/services/federator/src/Federator/MockServer.hs +++ b/services/federator/src/Federator/MockServer.hs @@ -52,8 +52,8 @@ import Data.Text.Lazy qualified as LText import Federator.Error import Federator.Error.ServerError import Federator.InternalServer +import Federator.Interpreter import Federator.RPC -import Federator.Response import Federator.Validation import Imports hiding (fromException) import Network.HTTP.Media qualified as HTTP @@ -65,7 +65,7 @@ import Network.Wai.Utilities.MockServer import Polysemy import Polysemy.Error hiding (throw) import Servant.API -import Servant.Server (Tagged (..)) +import Servant.Server qualified as Servant import Servant.Server.Generic import Wire.API.Federation.API (Component) import Wire.API.Federation.API.Common @@ -108,14 +108,11 @@ mockServer :: ) => IORef [FederatedRequest] -> MockFederator -> - (Sem r Wai.Response -> IO Wai.Response) -> - API AsServer -mockServer remoteCalls mock interpreter = + API (AsServerT (Sem r)) +mockServer remoteCalls mock = Federator.InternalServer.API { status = const $ pure NoContent, - internalRequest = \_mReqId targetDomain component rpc -> - Tagged $ \req respond -> - respond =<< interpreter (mockInternalRequest remoteCalls mock targetDomain component rpc req) + internalRequest = mockInternalRequest remoteCalls mock } mockInternalRequest :: @@ -130,8 +127,9 @@ mockInternalRequest :: Component -> RPC -> Wai.Request -> - Sem r Wai.Response -mockInternalRequest remoteCalls mock targetDomain component (RPC path) req = do + (Wai.Response -> IO Wai.ResponseReceived) -> + Sem r Wai.ResponseReceived +mockInternalRequest remoteCalls mock targetDomain component (RPC path) req cont = do domainTxt <- note NoOriginDomain $ lookup originDomainHeaderName (Wai.requestHeaders req) originDomain <- parseDomain domainTxt reqBody <- embed $ Wai.lazyRequestBody req @@ -153,7 +151,7 @@ mockInternalRequest remoteCalls mock targetDomain component (RPC path) req = do . handle (throw . handleException) $ mock.handler fedRequest let headers = ("Content-Type", HTTP.renderHeader ct) : mock.headers - pure $ Wai.responseLBS HTTP.status200 headers resBody + embed . cont $ Wai.responseLBS HTTP.status200 headers resBody where handleException :: SomeException -> MockException handleException e = case Exception.fromException e of @@ -187,14 +185,17 @@ withTempMockFederator :: withTempMockFederator mock action = do remoteCalls <- newIORef [] let interpreter = - runM + Servant.Handler + . ExceptT + . runM . discardTinyLogs + . runError . runWaiErrors @'[ ValidationError, ServerError, MockException ] - app = genericServe (mockServer remoteCalls mock interpreter) + app = genericServeT interpreter (mockServer remoteCalls mock) result <- bracket (liftIO (startMockServer Nothing app)) diff --git a/services/federator/src/Federator/Remote.hs b/services/federator/src/Federator/Remote.hs index 2bc3ae9a05b..06d2246bb58 100644 --- a/services/federator/src/Federator/Remote.hs +++ b/services/federator/src/Federator/Remote.hs @@ -70,7 +70,6 @@ instance AsWai RemoteError where data Remote m a where DiscoverAndCall :: - RequestId -> Domain -> Component -> Text -> @@ -85,13 +84,15 @@ interpretRemote :: Member DiscoverFederator r, Member (Error DiscoveryFailure) r, Member (Error RemoteError) r, - Member (Input Http2Manager) r + Member (Input Http2Manager) r, + Member (Input RequestId) r ) => Sem (Remote ': r) a -> Sem r a interpretRemote = interpret $ \case - DiscoverAndCall rid domain component rpc headers body -> do + DiscoverAndCall domain component rpc headers body -> do target@(SrvTarget hostname port) <- discoverFederatorWithError domain + RequestId rid <- input let path = LBS.toStrict . toLazyByteString $ HTTP.encodePathSegments ["federation", componentName component, rpc] @@ -99,7 +100,7 @@ interpretRemote = interpret $ \case -- filter out Host header, because the HTTP2 client adds it back headers' = filter ((/= "Host") . fst) headers - <> [(RPC.requestIdName, unRequestId rid)] + <> [(RPC.requestIdName, rid)] req' = HTTP2.requestBuilder HTTP.methodPost path headers' body mgr <- input diff --git a/services/federator/src/Federator/Response.hs b/services/federator/src/Federator/Response.hs index f4082f93c1a..7633252c287 100644 --- a/services/federator/src/Federator/Response.hs +++ b/services/federator/src/Federator/Response.hs @@ -15,172 +15,13 @@ -- You should have received a copy of the GNU Affero General Public License along -- with this program. If not, see . -module Federator.Response - ( defaultHeaders, - serveServant, - runFederator, - runWaiError, - runWaiErrors, - streamingResponseToWai, - ) -where +module Federator.Response where -import Control.Lens -import Control.Monad.Codensity import Data.ByteString.Builder -import Data.Kind -import Data.Text qualified as T -import Federator.Discovery -import Federator.Env -import Federator.Error -import Federator.Error.ServerError -import Federator.Metrics (Metrics, interpretMetrics) -import Federator.Options -import Federator.Remote -import Federator.Service -import Federator.Validation -import HTTP2.Client.Manager (Http2Manager) import Imports -import Network.HTTP.Types qualified as HTTP -import Network.Wai (Middleware) import Network.Wai qualified as Wai -import Network.Wai.Handler.Warp qualified as Warp -import Network.Wai.Utilities.Error qualified as Wai -import Network.Wai.Utilities.Server qualified as Wai -import Polysemy -import Polysemy.Embed -import Polysemy.Error -import Polysemy.Input -import Polysemy.Internal -import Polysemy.TinyLog -import Servant hiding (ServerError, respond, serve) -import Servant.Client (mkClientEnv) import Servant.Client.Core -import Servant.Server.Generic import Servant.Types.SourceT -import Util.Options (Endpoint (..)) -import Wire.API.FederationUpdate qualified as FedUp (getFederationDomainConfigs) -import Wire.API.MakesFederatedCall (Component (Brig)) -import Wire.API.Routes.FederationDomainConfig qualified as FedUp (FederationDomainConfigs) -import Wire.Network.DNS.Effect -import Wire.Sem.Logger.TinyLog - -defaultHeaders :: [HTTP.Header] -defaultHeaders = [("Content-Type", "application/json")] - -class ErrorEffects (ee :: [Type]) r where - type Row ee :: EffectRow - runWaiErrors :: - Sem (Append (Row ee) r) Wai.Response -> - Sem r Wai.Response - -instance ErrorEffects '[] r where - type Row '[] = '[] - runWaiErrors = id - -instance - ( Member TinyLog (Append (Row ee) r), - AsWai e, - ErrorEffects ee r - ) => - ErrorEffects (e ': ee) r - where - type Row (e ': ee) = (Error e ': Row ee) - runWaiErrors = runWaiErrors @ee . runWaiError @e - -runWaiError :: - (AsWai e, Member TinyLog r) => - Sem (Error e ': r) Wai.Response -> - Sem r Wai.Response -runWaiError = - fmap (either (errorResponse defaultHeaders) id) - . runError - . flip catch logError - . mapError toWai - . raiseUnder - where - logError :: - ( Member (Error Wai.Error) r, - Member TinyLog r - ) => - Wai.Error -> - Sem r a - logError e = do - err $ Wai.logErrorMsg e - throw e - -serveServant :: - forall routes. - (HasServer (ToServantApi routes) '[], GenericServant routes AsServer, Server (ToServantApi routes) ~ ToServant routes AsServer) => - Middleware -> - routes AsServer -> - Env -> - Int -> - IO () -serveServant middleware server env port = - Warp.run port - . Wai.catchErrorsWithRequestId getRequestId (view applog env) [] - . middleware - $ app - where - app :: Wai.Application - app = - genericServe server - - getRequestId :: Wai.Request -> Maybe ByteString - getRequestId = lookup "Wire-Origin-Request-Id" . Wai.requestHeaders - -type AllEffects = - '[ Metrics, - Remote, - DiscoverFederator, - DNSLookup, -- needed by DiscoverFederator - ServiceStreaming, - Input RunSettings, - Input Http2Manager, -- needed by Remote - Input FedUp.FederationDomainConfigs, -- needed for the domain list and federation policy. - Input Env, -- needed by Service - Error ValidationError, - Error RemoteError, - Error ServerError, - Error DiscoveryFailure, - TinyLog, - Embed IO, - Embed (Codensity IO) - ] - --- | Run Sem action containing HTTP handlers. All errors have to been handled --- already by this point. -runFederator :: Env -> Sem AllEffects Wai.Response -> Codensity IO Wai.Response -runFederator env = - runM - . runEmbedded @IO @(Codensity IO) liftIO - . loggerToTinyLogReqId (view requestId env) (view applog env) - . runWaiErrors - @'[ ValidationError, - RemoteError, - ServerError, - DiscoveryFailure - ] - . runInputConst env - . runInputSem (embed @IO (getFederationDomainConfigs env)) - . runInputSem (embed @IO (readIORef (view http2Manager env))) - . runInputConst (view runSettings env) - . interpretServiceHTTP - . runDNSLookupWithResolver (view dnsResolver env) - . runFederatorDiscovery - . interpretRemote - . interpretMetrics - -getFederationDomainConfigs :: Env -> IO FedUp.FederationDomainConfigs -getFederationDomainConfigs env = do - let mgr = env ^. httpManager - Endpoint h p = env ^. service $ Brig - baseurl = BaseUrl Http (T.unpack h) (fromIntegral p) "" - clientEnv = mkClientEnv mgr baseurl - FedUp.getFederationDomainConfigs clientEnv >>= \case - Right v -> pure v - Left e -> error $ show e streamingResponseToWai :: StreamingResponse -> Wai.Response streamingResponseToWai resp = diff --git a/services/federator/src/Federator/Service.hs b/services/federator/src/Federator/Service.hs index b4f859d52bf..d76718b7dc6 100644 --- a/services/federator/src/Federator/Service.hs +++ b/services/federator/src/Federator/Service.hs @@ -53,7 +53,7 @@ type ServiceStreaming = Service (SourceT IO ByteString) data Service body m a where -- | Returns status, headers and body, 'HTTP.Response' is not nice to work with in tests - ServiceCall :: Component -> ByteString -> RequestHeaders -> LByteString -> RequestId -> Domain -> Service body m (Servant.ResponseF body) + ServiceCall :: Component -> ByteString -> RequestHeaders -> LByteString -> Domain -> Service body m (Servant.ResponseF body) makeSem ''Service @@ -77,14 +77,16 @@ bodyReaderToStreamT action = fromStepT go -- interpretServiceHTTP :: ( Member (Embed (Codensity IO)) r, - Member (Input Env) r + Member (Input Env) r, + Member (Input RequestId) r ) => Sem (ServiceStreaming ': r) a -> Sem r a interpretServiceHTTP = interpret $ \case - ServiceCall component rpcPath headers body rid domain -> do + ServiceCall component rpcPath headers body domain -> do Endpoint serviceHost servicePort <- inputs (view service) <*> pure component manager <- inputs (view httpManager) + RequestId rid <- input let req = defaultRequest { method = HTTP.methodPost, @@ -95,7 +97,7 @@ interpretServiceHTTP = interpret $ \case requestHeaders = [ ("Content-Type", "application/json"), (originDomainHeaderName, Text.encodeUtf8 (domainText domain)), - (RPC.requestIdName, unRequestId rid) + (RPC.requestIdName, rid) ] <> headers } diff --git a/services/federator/test/integration/Test/Federator/IngressSpec.hs b/services/federator/test/integration/Test/Federator/IngressSpec.hs index f28fca1bdf1..93a6d7fc720 100644 --- a/services/federator/test/integration/Test/Federator/IngressSpec.hs +++ b/services/federator/test/integration/Test/Federator/IngressSpec.hs @@ -147,7 +147,8 @@ inwardBrigCallViaIngressWithSettings sslCtx requestPath payload = mgr <- liftToCodensity . liftIO $ http2ManagerWithSSLCtx sslCtx liftToCodensity . runInputConst mgr + . runInputConst (RequestId "N/A") . assertNoError @DiscoveryFailure . discoverConst target . interpretRemote - $ discoverAndCall (RequestId "N/A") (Domain "example.com") Brig requestPath headers payload + $ discoverAndCall (Domain "example.com") Brig requestPath headers payload diff --git a/services/federator/test/unit/Main.hs b/services/federator/test/unit/Main.hs index f58f7a80652..1936df48d0d 100644 --- a/services/federator/test/unit/Main.hs +++ b/services/federator/test/unit/Main.hs @@ -28,7 +28,6 @@ import Test.Federator.InternalServer qualified import Test.Federator.Monitor qualified import Test.Federator.Options qualified import Test.Federator.Remote qualified -import Test.Federator.Response qualified import Test.Federator.Validation qualified import Test.Tasty @@ -44,6 +43,5 @@ main = Test.Federator.InternalServer.tests, Test.Federator.ExternalServer.tests, Test.Federator.Monitor.tests, - Test.Federator.Remote.tests, - Test.Federator.Response.tests + Test.Federator.Remote.tests ] diff --git a/services/federator/test/unit/Test/Federator/Client.hs b/services/federator/test/unit/Test/Federator/Client.hs index 6100252dbbe..a816f7710c9 100644 --- a/services/federator/test/unit/Test/Federator/Client.hs +++ b/services/federator/test/unit/Test/Federator/Client.hs @@ -40,6 +40,7 @@ import Network.HTTP2.Client qualified as HTTP2 import Network.Wai qualified as Wai import Network.Wai.Utilities.Error qualified as Wai import Network.Wai.Utilities.MockServer +import Network.Wai.Utilities.Server import Servant.API import Servant.Client hiding ((//)) import Servant.Client.Core @@ -221,7 +222,7 @@ testResponseHeaders = do HTTP2.requestBuilder HTTP.methodPost "/rpc/target.example.com/brig/test" - [("Wire-Origin-Domain", "origin.example.com")] + [("Wire-Origin-Domain", "origin.example.com"), (federationRequestIdHeaderName, "rid")] "body" mgr <- defaultHttp2Manager performHTTP2Request mgr (False, "127.0.0.1", port) req diff --git a/services/federator/test/unit/Test/Federator/ExternalServer.hs b/services/federator/test/unit/Test/Federator/ExternalServer.hs index 7e499e3bc56..a0b4effee60 100644 --- a/services/federator/test/unit/Test/Federator/ExternalServer.hs +++ b/services/federator/test/unit/Test/Federator/ExternalServer.hs @@ -19,7 +19,7 @@ module Test.Federator.ExternalServer where -import Control.Monad.Codensity +import Control.Monad.Except import Data.ByteString qualified as BS import Data.Default import Data.Domain @@ -29,9 +29,9 @@ import Data.Text.Encoding qualified as Text import Federator.Discovery import Federator.Error.ServerError (ServerError (..)) import Federator.ExternalServer +import Federator.Interpreter import Federator.Metrics import Federator.Options -import Federator.Response import Federator.Service (Service (..), ServiceStreaming) import Federator.Validation import Imports @@ -46,6 +46,7 @@ import Polysemy.Input import Polysemy.Output import Polysemy.TinyLog import Servant.Client.Core qualified as Servant +import Servant.Server qualified as Servant import Servant.Server.Generic import Servant.Types.SourceT import System.Logger (Msg) @@ -104,7 +105,7 @@ mockService :: Sem (ServiceStreaming ': r) a -> Sem r a mockService status = interpret $ \case - ServiceCall comp path headers body _mReqId domain -> do + ServiceCall comp path headers body domain -> do output (Call comp path headers body domain) pure Servant.Response @@ -135,7 +136,8 @@ requestBrigSuccess = OutgoingCounterIncr _ -> embed @IO $ assertFailure "Should not increment outgoing counter" IncomingCounterIncr od -> embed @IO $ od @?= aValidDomain - (actualCalls, res) <- + resRef <- newIORef Nothing + (actualCalls, _) <- runM . assertMetrics . runOutputList @@ -147,7 +149,9 @@ requestBrigSuccess = . mockDiscoveryTrivial . runInputConst noClientCertSettings . runInputConst scaffoldingFederationDomainConfigs - $ callInward Brig (RPC "get-user-by-handle") Nothing aValidDomain (CertHeader cert) request + $ callInward Brig (RPC "get-user-by-handle") aValidDomain (CertHeader cert) request (saveResponse resRef) + + Just res <- readIORef resRef let expectedCall = Call Brig "/federation/get-user-by-handle" [("X-Wire-API-Version", "v0")] "\"foo\"" aValidDomain assertEqual "one call to brig should be made" [expectedCall] actualCalls Wai.responseStatus res @?= HTTP.status200 @@ -163,7 +167,8 @@ requestBrigFailure = "/federation/brig/get-user-by-handle" Right cert <- decodeCertificate <$> BS.readFile "test/resources/unit/localhost.example.com.pem" - (actualCalls, res) <- + resRef <- newIORef Nothing + (actualCalls, _) <- runM . interpretMetricsEmpty . runOutputList @@ -175,8 +180,9 @@ requestBrigFailure = . mockDiscoveryTrivial . runInputConst noClientCertSettings . runInputConst scaffoldingFederationDomainConfigs - $ callInward Brig (RPC "get-user-by-handle") Nothing aValidDomain (CertHeader cert) request + $ callInward Brig (RPC "get-user-by-handle") aValidDomain (CertHeader cert) request (saveResponse resRef) + Just res <- readIORef resRef let expectedCall = Call Brig "/federation/get-user-by-handle" [] "\"foo\"" aValidDomain assertEqual "one call to brig should be made" [expectedCall] actualCalls Wai.responseStatus res @?= HTTP.notFound404 @@ -193,24 +199,27 @@ requestGalleySuccess = Right cert <- decodeCertificate <$> BS.readFile "test/resources/unit/localhost.example.com.pem" - runM $ do - (actualCalls, res) <- - runOutputList - . interpretMetricsEmpty - . mockService HTTP.ok200 - . assertNoError @ValidationError - . assertNoError @DiscoveryFailure - . assertNoError @ServerError - . discardTinyLogs - . mockDiscoveryTrivial - . runInputConst noClientCertSettings - . runInputConst scaffoldingFederationDomainConfigs - $ callInward Galley (RPC "get-conversations") Nothing aValidDomain (CertHeader cert) request - let expectedCall = Call Galley "/federation/get-conversations" [] "\"foo\"" aValidDomain - embed $ assertEqual "one call to galley should be made" [expectedCall] actualCalls - embed $ Wai.responseStatus res @?= HTTP.status200 - body <- embed $ Wai.lazyResponseBody res - embed $ body @?= "\"bar\"" + resRef <- newIORef Nothing + (actualCalls, _) <- + runM + . runOutputList + . interpretMetricsEmpty + . mockService HTTP.ok200 + . assertNoError @ValidationError + . assertNoError @DiscoveryFailure + . assertNoError @ServerError + . discardTinyLogs + . mockDiscoveryTrivial + . runInputConst noClientCertSettings + . runInputConst scaffoldingFederationDomainConfigs + $ callInward Galley (RPC "get-conversations") aValidDomain (CertHeader cert) request (saveResponse resRef) + + Just res <- readIORef resRef + let expectedCall = Call Galley "/federation/get-conversations" [] "\"foo\"" aValidDomain + assertEqual "one call to galley should be made" [expectedCall] actualCalls + Wai.responseStatus res @?= HTTP.status200 + body <- Wai.lazyResponseBody res + body @?= "\"bar\"" requestNoDomain :: TestTree requestNoDomain = @@ -223,7 +232,7 @@ requestNoDomain = trPath = "/federation/brig/get-users" } serviceCallsRef <- newIORef [] - let serverApp = genericServe $ server undefined undefined (testInterpretter serviceCallsRef) + let serverApp = genericServeT (testInterpreter serviceCallsRef) $ server undefined undefined void . serverApp request $ \res -> do serviceCalls <- readIORef serviceCallsRef assertEqual "Expected response to have status 400" status400 (Wai.responseStatus res) @@ -240,7 +249,7 @@ requestNoCertificate = trPath = "/federation/brig/get-users" } serviceCallsRef <- newIORef [] - let serverApp = genericServe $ server undefined undefined (testInterpretter serviceCallsRef) + let serverApp = genericServeT (testInterpreter serviceCallsRef) $ server undefined undefined void . serverApp request $ \res -> do serviceCalls <- readIORef serviceCallsRef assertEqual "Expected response to have status 400" status400 (Wai.responseStatus res) @@ -258,7 +267,7 @@ requestInvalidCertificate = trCertificateHeader = Just "not a certificate" } serviceCallsRef <- newIORef [] - let serverApp = genericServe $ server undefined undefined (testInterpretter serviceCallsRef) + let serverApp = genericServeT (testInterpreter serviceCallsRef) $ server undefined undefined void . serverApp request $ \res -> do serviceCalls <- readIORef serviceCallsRef assertEqual "Expected response to have status 400" status400 (Wai.responseStatus res) @@ -307,7 +316,7 @@ testInvalidPaths = do invalidPath serviceCallsRef <- newIORef [] - let serverApp = genericServe $ server undefined undefined (testInterpretter serviceCallsRef) + let serverApp = genericServeT (testInterpreter serviceCallsRef) $ server undefined undefined void . serverApp request $ \res -> do serviceCalls <- readIORef serviceCallsRef assertEqual "Unexpected status" expectedStatus (Wai.responseStatus res) @@ -328,7 +337,7 @@ testMethod = } request <- testRequest tr {trMethod = method} serviceCallsRef <- newIORef [] - let serverApp = genericServe $ server undefined undefined (testInterpretter serviceCallsRef) + let serverApp = genericServeT (testInterpreter serviceCallsRef) $ server undefined undefined void . serverApp request $ \res -> do serviceCalls <- readIORef serviceCallsRef assertEqual "Expected response to have status 403" status403 (Wai.responseStatus res) @@ -336,7 +345,7 @@ testMethod = pure Wai.ResponseReceived in map invalidMethodTest [HTTP.methodGet, HTTP.methodDelete, HTTP.methodPut, HTTP.methodPatch] -testInterpretter :: +testInterpreter :: IORef [Call] -> Sem '[ Metrics, @@ -346,25 +355,31 @@ testInterpretter :: Error DiscoveryFailure, Error ValidationError, Error ServerError, + Error Servant.ServerError, Logger (Msg -> Msg), ServiceStreaming, Output Call, Embed IO ] - Wai.Response -> - Codensity IO Wai.Response -testInterpretter serviceCallsRef = - liftIO + a -> + Servant.Handler a +testInterpreter serviceCallsRef = + Servant.Handler + . ExceptT . runM @IO . runOutputMonoidIORef @Call serviceCallsRef (: []) . mockService HTTP.ok200 . discardLogs + . runError . runWaiErrors @'[DiscoveryFailure, ValidationError, ServerError] . mockDiscoveryTrivial . runInputConst noClientCertSettings . runInputConst scaffoldingFederationDomainConfigs . interpretMetricsEmpty +saveResponse :: IORef (Maybe Wai.Response) -> Wai.Response -> IO Wai.ResponseReceived +saveResponse ref res = writeIORef ref (Just res) $> Wai.ResponseReceived + exampleDomain :: Text exampleDomain = "localhost.example.com" diff --git a/services/federator/test/unit/Test/Federator/InternalServer.hs b/services/federator/test/unit/Test/Federator/InternalServer.hs index 86f9f7e93e7..27029c50b13 100644 --- a/services/federator/test/unit/Test/Federator/InternalServer.hs +++ b/services/federator/test/unit/Test/Federator/InternalServer.hs @@ -32,6 +32,8 @@ import Federator.Validation import Imports import Network.HTTP.Types qualified as HTTP import Network.Wai qualified as Wai +import Network.Wai.Internal qualified as Wai +import Network.Wai.Utilities.Server (federationRequestIdHeaderName) import Network.Wai.Utilities.Server qualified as Wai import Polysemy import Polysemy.Error @@ -72,13 +74,13 @@ federatedRequestSuccess = trBody = "\"foo\"", trExtraHeaders = requestHeaders } - let interpretCall :: Member (Embed IO) r => Sem (Remote ': r) a -> Sem r a - interpretCall = interpret $ \case - DiscoverAndCall _ domain component rpc headers body -> embed @IO $ do + let verifyCallAndRespond :: Member (Embed IO) r => Sem (Remote ': r) a -> Sem r a + verifyCallAndRespond = interpret $ \case + DiscoverAndCall domain component rpc headers body -> embed @IO $ do domain @?= targetDomain component @?= Brig rpc @?= "get-user-by-handle" - headers @?= requestHeaders + sort headers @?= sort (requestHeaders <> [(federationRequestIdHeaderName, "test")]) toLazyByteString body @?= "\"foo\"" pure Response @@ -93,16 +95,19 @@ federatedRequestSuccess = OutgoingCounterIncr td -> embed @IO $ td @?= targetDomain IncomingCounterIncr _ -> embed @IO $ assertFailure "Should not increment incoming counter" - res <- + resRef <- newIORef Nothing + let saveResponse res = writeIORef resRef (Just res) $> Wai.ResponseReceived + _ <- runM - . interpretCall + . verifyCallAndRespond . assertNoError @ValidationError . assertNoError @ServerError . discardTinyLogs . runInputConst settings . runInputConst (FederationDomainConfigs AllowDynamic [FederationDomainConfig (Domain "target.example.com") FullSearch FederationRestrictionAllowAll] 10) . assertMetrics - $ callOutward Nothing targetDomain Brig (RPC "get-user-by-handle") request + $ callOutward targetDomain Brig (RPC "get-user-by-handle") request saveResponse + Just res <- readIORef resRef Wai.responseStatus res @?= HTTP.status200 body <- Wai.lazyResponseBody res body @?= "\"bar\"" @@ -147,5 +152,5 @@ federatedRequestFailureAllowList = . runInputConst settings . runInputConst (FederationDomainConfigs AllowDynamic [FederationDomainConfig (Domain "hello.world") FullSearch FederationRestrictionAllowAll] 10) . interpretMetricsEmpty - $ callOutward Nothing targetDomain Brig (RPC "get-user-by-handle") request + $ callOutward targetDomain Brig (RPC "get-user-by-handle") request undefined eith @?= Left (FederationDenied targetDomain) diff --git a/services/federator/test/unit/Test/Federator/Remote.hs b/services/federator/test/unit/Test/Federator/Remote.hs index 8d8de9f0660..0a8b92e432a 100644 --- a/services/federator/test/unit/Test/Federator/Remote.hs +++ b/services/federator/test/unit/Test/Federator/Remote.hs @@ -87,10 +87,11 @@ mkTestCall sslCtx hostname port = do . runError @RemoteError . void . runInputConst mgr + . runInputConst (RequestId "test") . discoverLocalhost hostname port . assertNoError @DiscoveryFailure . interpretRemote - $ discoverAndCall (RequestId "N/A") (Domain "localhost") Brig "test" [] mempty + $ discoverAndCall (Domain "localhost") Brig "test" [] mempty withMockServer :: Warp.TLSSettings -> (Warp.Port -> IO a) -> IO a withMockServer tls k = diff --git a/services/federator/test/unit/Test/Federator/Response.hs b/services/federator/test/unit/Test/Federator/Response.hs deleted file mode 100644 index dcc0fec008c..00000000000 --- a/services/federator/test/unit/Test/Federator/Response.hs +++ /dev/null @@ -1,104 +0,0 @@ --- This file is part of the Wire Server implementation. --- --- Copyright (C) 2022 Wire Swiss GmbH --- --- This program is free software: you can redistribute it and/or modify it under --- the terms of the GNU Affero General Public License as published by the Free --- Software Foundation, either version 3 of the License, or (at your option) any --- later version. --- --- This program is distributed in the hope that it will be useful, but WITHOUT --- ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS --- FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for more --- details. --- --- You should have received a copy of the GNU Affero General Public License along --- with this program. If not, see . - -module Test.Federator.Response (tests) where - -import Data.Aeson qualified as Aeson -import Federator.Discovery -import Federator.Error.ServerError (ServerError (..)) -import Federator.Remote -import Federator.Response (runWaiError) -import Federator.Validation -import Imports -import Network.HTTP.Types qualified as HTTP -import Network.Wai qualified as Wai -import Network.Wai.Utilities.Error qualified as Wai -import Network.Wai.Utilities.Server qualified as Wai -import Polysemy -import Polysemy.Error -import Test.Tasty -import Test.Tasty.HUnit -import Wire.API.Federation.Error -import Wire.Network.DNS.SRV -import Wire.Sem.Logger.TinyLog qualified as Log - -tests :: TestTree -tests = - testGroup - "Wai Errors" - [ testValidationError, - testServerError, - testDiscoveryFailure, - testRemoteError - ] - -testValidationError :: TestTree -testValidationError = - testCase "validation errors should be converted to wai error responses" $ do - resp <- - runM - . Log.discardTinyLogs - . runWaiError @ValidationError - $ throw NoClientCertificate - body <- Wai.lazyResponseBody resp - let merr = Aeson.decode body - Wai.responseStatus resp @?= HTTP.status403 - fmap Wai.label merr @?= Just "no-client-certificate" - -testServerError :: TestTree -testServerError = - testCase "server errors should be converted to wai error responses" $ do - resp <- - runM - . Log.discardTinyLogs - . runWaiError @ServerError - $ throw InvalidRoute - body <- Wai.lazyResponseBody resp - let merr = Aeson.decode body - Wai.responseStatus resp @?= HTTP.status403 - fmap Wai.label merr @?= Just "invalid-endpoint" - -testDiscoveryFailure :: TestTree -testDiscoveryFailure = - testCase "discovery failures should be converted to wai error responses" $ do - resp <- - runM - . Log.discardTinyLogs - . runWaiError @DiscoveryFailure - $ throw (DiscoveryFailureDNSError "mock error") - body <- Wai.lazyResponseBody resp - let merr = Aeson.decode body - Wai.responseStatus resp @?= HTTP.status400 - fmap Wai.label merr @?= Just "discovery-failure" - -testRemoteError :: TestTree -testRemoteError = - testCase "remote errors should be converted to wai error responses" $ do - resp <- - runM - . Log.discardTinyLogs - . runWaiError @RemoteError - $ throw - ( RemoteError - (SrvTarget "example.com" 7777) - "" - FederatorClientNoStatusCode - ) - body <- Wai.lazyResponseBody resp - let merr = Aeson.decode body - Wai.responseStatus resp @?= toEnum 533 - fmap Wai.label merr @?= Just "federation-http2-error" diff --git a/services/federator/test/unit/Test/Federator/Util.hs b/services/federator/test/unit/Test/Federator/Util.hs index decf7d356a2..6af804a1d67 100644 --- a/services/federator/test/unit/Test/Federator/Util.hs +++ b/services/federator/test/unit/Test/Federator/Util.hs @@ -25,6 +25,7 @@ import Imports import Network.HTTP.Types qualified as HTTP import Network.Wai qualified as Wai import Network.Wai.Test qualified as Wai +import Network.Wai.Utilities.Server (federationRequestIdHeaderName) import Polysemy import Polysemy.Error import Test.Tasty.HUnit @@ -68,5 +69,6 @@ testRequest tr = do Wai.requestHeaders = [("X-SSL-Certificate", HTTP.urlEncode True h) | h <- toList (trCertificateHeader tr)] <> [(originDomainHeaderName, h) | h <- toList (trDomainHeader tr)] + <> [(federationRequestIdHeaderName, "test")] <> trExtraHeaders tr } diff --git a/services/galley/src/Galley/Run.hs b/services/galley/src/Galley/Run.hs index bda488ad4b6..8110fc4454a 100644 --- a/services/galley/src/Galley/Run.hs +++ b/services/galley/src/Galley/Run.hs @@ -24,7 +24,6 @@ where import AWS.Util (readAuthExpiration) import Amazonka qualified as AWS -import Bilge.Request (requestIdName) import Cassandra (runClient, shutdown) import Cassandra.Schema (versionCheck) import Control.Concurrent.Async qualified as Async @@ -33,7 +32,6 @@ import Control.Lens (view, (.~), (^.)) import Control.Monad.Codensity import Data.Aeson qualified as Aeson import Data.ByteString.UTF8 qualified as UTF8 -import Data.Id import Data.Metrics (Metrics) import Data.Metrics.AWS (gaugeTokenRemaing) import Data.Metrics.Middleware qualified as M @@ -41,8 +39,6 @@ import Data.Metrics.Servant import Data.Misc (portNumber) import Data.Singletons import Data.Text (unpack) -import Data.UUID as UUID -import Data.UUID.V4 as UUID import Galley.API.Federation import Galley.API.Internal import Galley.API.Public.Servant @@ -60,9 +56,9 @@ import Network.Wai import Network.Wai.Middleware.Gunzip qualified as GZip import Network.Wai.Middleware.Gzip qualified as GZip import Network.Wai.Utilities.Error +import Network.Wai.Utilities.Request import Network.Wai.Utilities.Server import Servant hiding (route) -import System.Logger (Logger, msg, val, (.=), (~~)) import System.Logger qualified as Log import System.Logger.Extended (mkLogger) import Util.Options @@ -99,10 +95,11 @@ mkApp opts = lift $ runClient (env ^. cstate) $ versionCheck schemaVersion let middlewares = versionMiddleware (foldMap expandVersionExp (opts ^. settings . disabledAPIVersions)) + . requestIdMiddleware logger defaultRequestIdHeaderName . servantPrometheusMiddleware (Proxy @CombinedAPI) . GZip.gunzip . GZip.gzip GZip.def - . catchErrors logger [Right metrics] + . catchErrors logger defaultRequestIdHeaderName [Right metrics] Codensity $ \k -> finally (k ()) $ do Log.info logger $ Log.msg @Text "Galley application finished." Log.flush logger @@ -133,8 +130,8 @@ mkApp opts = servantApp :: Env -> Application servantApp e0 r cont = do - rid <- lookupReqId (e0 ^. applog) r - let e = reqId .~ rid $ e0 + let rid = getRequestId defaultRequestIdHeaderName r + e = reqId .~ rid $ e0 Servant.serveWithContext (Proxy @CombinedAPI) ( view (options . settings . federationDomain) e @@ -149,18 +146,6 @@ mkApp opts = r cont - lookupReqId :: Logger -> Request -> IO RequestId - lookupReqId l r = case lookup requestIdName $ requestHeaders r of - Just rid -> pure $ RequestId rid - Nothing -> do - localRid <- RequestId . UUID.toASCIIBytes <$> UUID.nextRandom - Log.info l $ - "request-id" .= localRid - ~~ "method" .= requestMethod r - ~~ "path" .= rawPathInfo r - ~~ msg (val "generated a new request id for local request") - pure localRid - closeApp :: Env -> IO () closeApp env = do shutdown (env ^. cstate) diff --git a/services/gundeck/src/Gundeck/Run.hs b/services/gundeck/src/Gundeck/Run.hs index 4a919bd0ba7..cff04418894 100644 --- a/services/gundeck/src/Gundeck/Run.hs +++ b/services/gundeck/src/Gundeck/Run.hs @@ -26,15 +26,12 @@ import Control.Error (ExceptT (ExceptT)) import Control.Exception (finally) import Control.Lens ((.~), (^.)) import Control.Monad.Extra -import Data.Id (RequestId (..)) import Data.Metrics (Metrics) import Data.Metrics.AWS (gaugeTokenRemaing) import Data.Metrics.Middleware (metrics) import Data.Metrics.Middleware.Prometheus (waiPrometheusMiddleware) import Data.Proxy (Proxy (Proxy)) import Data.Text (unpack) -import Data.UUID qualified as UUID -import Data.UUID.V4 qualified as UUID import Database.Redis qualified as Redis import Gundeck.API (sitemap) import Gundeck.API.Public (servantSitemap) @@ -49,11 +46,10 @@ import Imports hiding (head) import Network.Wai as Wai import Network.Wai.Middleware.Gunzip qualified as GZip import Network.Wai.Middleware.Gzip qualified as GZip -import Network.Wai.Utilities (lookupRequestId) +import Network.Wai.Utilities.Request import Network.Wai.Utilities.Server hiding (serverPort) import Servant (Handler (Handler), (:<|>) (..)) import Servant qualified -import System.Logger ((.=), (~~)) import System.Logger qualified as Log import UnliftIO.Async qualified as Async import Util.Options @@ -75,7 +71,7 @@ run o = do wtbs <- forM (e ^. threadBudgetState) $ \tbs -> Async.async $ runDirect e $ watchThreadBudgetState m tbs 10 wCollectAuth <- Async.async (collectAuthMetrics m (Aws._awsEnv (Env._awsEnv e))) - let app = middleware e (\requestId -> mkApp (e & reqId .~ requestId)) + let app = middleware e $ mkApp e runSettingsWithShutdown s app Nothing `finally` do Log.info l $ Log.msg (Log.val "Shutting down ...") shutdown (e ^. cstate) @@ -87,36 +83,26 @@ run o = do whenJust (e ^. rstateAdditionalWrite) $ (=<<) Redis.disconnect . takeMVar Log.close (e ^. applog) where - middleware :: Env -> (RequestId -> Wai.Application) -> Wai.Application + middleware :: Env -> Middleware middleware e = versionMiddleware (foldMap expandVersionExp (o ^. settings . disabledAPIVersions)) + . requestIdMiddleware (e ^. applog) defaultRequestIdHeaderName . waiPrometheusMiddleware sitemap . GZip.gunzip . GZip.gzip GZip.def - . catchErrors (e ^. applog) [Right $ e ^. monitor] - . lookupRequestIdMiddleware (e ^. applog) - - lookupRequestIdMiddleware :: Log.Logger -> (RequestId -> Wai.Application) -> Wai.Application - lookupRequestIdMiddleware logger mkapp req cont = do - case lookupRequestId req of - Just rid -> do - mkapp (RequestId rid) req cont - Nothing -> do - localRid <- RequestId . UUID.toASCIIBytes <$> UUID.nextRandom - Log.info logger $ - "request-id" .= localRid - ~~ "method" .= Wai.requestMethod req - ~~ "path" .= Wai.rawPathInfo req - ~~ Log.msg (Log.val "generated a new request id for local request") - mkapp localRid req cont + . catchErrors (e ^. applog) defaultRequestIdHeaderName [Right $ e ^. monitor] type CombinedAPI = GundeckAPI :<|> Servant.Raw mkApp :: Env -> Wai.Application -mkApp env = +mkApp env0 req cont = do + let rid = getRequestId defaultRequestIdHeaderName req + env = reqId .~ rid $ env0 Servant.serve (Proxy @CombinedAPI) (servantSitemap' env :<|> Servant.Tagged (runGundeckWithRoutes env)) + req + cont where runGundeckWithRoutes :: Env -> Wai.Application runGundeckWithRoutes e r k = runGundeck e r (route (compile sitemap) r k) diff --git a/services/proxy/src/Proxy/Run.hs b/services/proxy/src/Proxy/Run.hs index 7a32829f5d5..2058052a059 100644 --- a/services/proxy/src/Proxy/Run.hs +++ b/services/proxy/src/Proxy/Run.hs @@ -43,7 +43,8 @@ run o = do let app r k = runProxy e r (route rtree r k) let middleware = versionMiddleware (foldMap expandVersionExp (o ^. disabledAPIVersions)) + . requestIdMiddleware (e ^. applog) defaultRequestIdHeaderName . waiPrometheusMiddleware (sitemap e) . GZip.gunzip - . catchErrors (e ^. applog) [Right m] + . catchErrors (e ^. applog) defaultRequestIdHeaderName [Right m] runSettingsWithShutdown s (middleware app) Nothing `finally` destroyEnv e diff --git a/services/spar/src/Spar/API.hs b/services/spar/src/Spar/API.hs index ae3a3d94d90..adeaedef8ea 100644 --- a/services/spar/src/Spar/API.hs +++ b/services/spar/src/Spar/API.hs @@ -47,7 +47,7 @@ where import Brig.Types.Intra import Cassandra as Cas -import Control.Lens +import Control.Lens hiding ((.=)) import Control.Monad.Except import qualified Data.ByteString as SBS import Data.ByteString.Builder (toLazyByteString) @@ -60,6 +60,8 @@ import qualified Data.Text.Lazy as T import Data.Text.Lazy.Encoding import Data.Time import Imports +import Network.Wai.Utilities.Request +import Network.Wai.Utilities.Server (defaultRequestIdHeaderName) import Polysemy import Polysemy.Error import Polysemy.Input @@ -114,9 +116,16 @@ import Wire.Sem.Random (Random) import qualified Wire.Sem.Random as Random app :: Env -> Application -app ctx = - SAML.setHttpCachePolicy $ - serve (Proxy @SparAPI) (hoistServer (Proxy @SparAPI) (runSparToHandler ctx) (api $ sparCtxOpts ctx) :: Server SparAPI) +app ctx0 req cont = do + let rid = getRequestId defaultRequestIdHeaderName req + let ctx = ctx0 {sparCtxRequestId = rid} + SAML.setHttpCachePolicy + ( serve + (Proxy @SparAPI) + (hoistServer (Proxy @SparAPI) (runSparToHandler ctx) (api $ sparCtxOpts ctx) :: Server SparAPI) + ) + req + cont api :: ( Member GalleyAccess r, diff --git a/services/spar/src/Spar/Run.hs b/services/spar/src/Spar/Run.hs index 137ef209d1d..8b55c3ce603 100644 --- a/services/spar/src/Spar/Run.hs +++ b/services/spar/src/Spar/Run.hs @@ -36,14 +36,12 @@ import Data.Id import Data.Metrics.Servant (servantPrometheusMiddleware) import Data.Proxy (Proxy (Proxy)) import Data.Text.Encoding -import qualified Data.UUID as UUID -import Data.UUID.V4 as UUID import Imports import Network.Wai (Application) import qualified Network.Wai as Wai import qualified Network.Wai.Handler.Warp as Warp import qualified Network.Wai.Middleware.Gunzip as GZip -import Network.Wai.Utilities.Request (lookupRequestId) +import Network.Wai.Utilities.Server import qualified Network.Wai.Utilities.Server as WU import qualified SAML2.WebSSO as SAML import Spar.API (SparAPI, app) @@ -52,7 +50,7 @@ import qualified Spar.Data as Data import Spar.Data.Instances () import Spar.Options as Opt import Spar.Orphans () -import System.Logger (Logger, msg, val, (.=), (~~)) +import System.Logger (Logger) import qualified System.Logger as Log import qualified System.Logger.Extended as Log import Util.Options @@ -101,33 +99,24 @@ mkApp sparCtxOpts = do Bilge.host (sparCtxOpts ^. to galley . host . to encodeUtf8) . Bilge.port (sparCtxOpts ^. to galley . port) $ Bilge.empty - let wrappedApp = + let sparCtxRequestId = RequestId "N/A" + let ctx0 = Env {..} + let heavyLogOnly :: (Wai.Request, LByteString) -> Maybe (Wai.Request, LByteString) + heavyLogOnly out@(req, _) = + if Wai.requestMethod req == "POST" && Wai.pathInfo req == ["sso", "finalize-login"] + then Just out + else Nothing + let middleware = versionMiddleware (foldMap expandVersionExp (disabledAPIVersions sparCtxOpts)) - . WU.heavyDebugLogging heavyLogOnly logLevel sparCtxLogger + . requestIdMiddleware (ctx0.sparCtxLogger) defaultRequestIdHeaderName + . WU.heavyDebugLogging heavyLogOnly logLevel sparCtxLogger defaultRequestIdHeaderName . servantPrometheusMiddleware (Proxy @SparAPI) . GZip.gunzip - . WU.catchErrors sparCtxLogger [] + . WU.catchErrors sparCtxLogger defaultRequestIdHeaderName [] -- Error 'Response's are usually not thrown as exceptions, but logged in -- 'renderSparErrorWithLogging' before the 'Application' can construct a 'Response' -- value, when there is still all the type information around. 'WU.catchErrors' is -- still here for errors outside the power of the 'Application', like network -- outages. . SAML.setHttpCachePolicy - . lookupRequestIdMiddleware sparCtxLogger - $ \sparCtxRequestId -> app Env {..} - heavyLogOnly :: (Wai.Request, LByteString) -> Maybe (Wai.Request, LByteString) - heavyLogOnly out@(req, _) = - if Wai.requestMethod req == "POST" && Wai.pathInfo req == ["sso", "finalize-login"] - then Just out - else Nothing - pure (wrappedApp, let sparCtxRequestId = Bilge.RequestId "N/A" in Env {..}) - -lookupRequestIdMiddleware :: Logger -> (RequestId -> Wai.Application) -> Wai.Application -lookupRequestIdMiddleware logger mkapp req cont = do - case lookupRequestId req of - Just rid -> do - mkapp (RequestId rid) req cont - Nothing -> do - localRid <- RequestId . encodeUtf8 . UUID.toText <$> UUID.nextRandom - Log.info logger $ "request-id" .= localRid ~~ "request" .= (show req) ~~ msg (val "generated a new request id for local request") - mkapp localRid req cont + pure (middleware $ app ctx0, ctx0) diff --git a/tools/stern/src/Stern/API.hs b/tools/stern/src/Stern/API.hs index c604da034ac..a20aa359db9 100644 --- a/tools/stern/src/Stern/API.hs +++ b/tools/stern/src/Stern/API.hs @@ -29,7 +29,7 @@ where import Brig.Types.Intra import Control.Error -import Control.Lens ((^.)) +import Control.Lens ((.~), (^.)) import Control.Monad.Except import Data.Aeson hiding (Error, json) import Data.Aeson.KeyMap qualified as KeyMap @@ -52,6 +52,7 @@ import Imports hiding (head) import Network.HTTP.Types import Network.Wai import Network.Wai.Utilities as Wai +import Network.Wai.Utilities.Server import Network.Wai.Utilities.Server qualified as Server import Servant (NoContent (NoContent), ServerT, (:<|>) (..)) import Servant qualified @@ -80,13 +81,15 @@ start :: Opts -> IO () start o = do e <- newEnv o s <- Server.newSettings (server e) - Server.runSettingsWithShutdown s (servantApp e) Nothing + Server.runSettingsWithShutdown s (requestIdMiddleware (e ^. applog) defaultRequestIdHeaderName $ servantApp e) Nothing where server :: Env -> Server.Server server e = Server.defaultServer (unpack $ stern o ^. host) (stern o ^. port) (e ^. applog) (e ^. metrics) servantApp :: Env -> Application - servantApp e = + servantApp e0 req cont = do + let rid = getRequestId defaultRequestIdHeaderName req + let e = requestId .~ rid $ e0 Servant.serve ( Proxy @( SwaggerDocsAPI @@ -100,6 +103,8 @@ start o = do :<|> sitemap e :<|> sitemapRedirectToSwaggerDocs ) + req + cont ------------------------------------------------------------------------------- -- servant API diff --git a/tools/stern/src/Stern/App.hs b/tools/stern/src/Stern/App.hs index 0f3b0aa5e4b..eccffa864f0 100644 --- a/tools/stern/src/Stern/App.hs +++ b/tools/stern/src/Stern/App.hs @@ -43,6 +43,7 @@ import Network.Wai (Request, Response, ResponseReceived) import Network.Wai.Utilities (Error (..), lookupRequestId) import Network.Wai.Utilities.Error qualified as WaiError import Network.Wai.Utilities.Response (json, setStatus) +import Network.Wai.Utilities.Server (defaultRequestIdHeaderName) import Network.Wai.Utilities.Server qualified as Server import Stern.Options as O import System.Logger qualified as Log @@ -128,7 +129,7 @@ type Continue m = Response -> m ResponseReceived runHandler :: Env -> Request -> Handler ResponseReceived -> Continue IO -> IO ResponseReceived runHandler e r h k = do - i <- reqId (lookupRequestId r) + i <- reqId (lookupRequestId defaultRequestIdHeaderName r) let e' = set requestId (Bilge.RequestId i) e a <- runAppT e' (runExceptT h) either (onError (view applog e) r k) pure a From 04e6c2afd92825a501f550b4d05bf70bf1b4a395 Mon Sep 17 00:00:00 2001 From: Matthias Fischmann Date: Fri, 31 May 2024 08:35:27 +0200 Subject: [PATCH 15/64] Make flaky test more robust. (#4065) --- services/brig/test/integration/API/User/Account.hs | 9 +++++++-- 1 file changed, 7 insertions(+), 2 deletions(-) diff --git a/services/brig/test/integration/API/User/Account.hs b/services/brig/test/integration/API/User/Account.hs index 494ffecdc6e..ecf78a9a474 100644 --- a/services/brig/test/integration/API/User/Account.hs +++ b/services/brig/test/integration/API/User/Account.hs @@ -846,7 +846,7 @@ testCreateUserAnonExpiry :: Brig -> Http () testCreateUserAnonExpiry b = do u1 <- randomUser b alice <- randomUser b - bob <- createAnonUserExpiry (Just 2) "bob" b + bob <- createAnonUserExpiry (Just 5 {- 2 was flaky, so it's 5 now; make sure to re-align with 'awaitExpiry' below! -}) "bob" b liftIO $ assertBool "expiry not set on regular creation" (isNothing (userExpire alice)) ensureExpiry (fromUTCTimeMillis <$> userExpire bob) "bob/register" resAlice <- getProfile (userId u1) (userId alice) @@ -856,12 +856,13 @@ testCreateUserAnonExpiry b = do liftIO $ assertBool "Regular user should not have any expiry" (null $ expire resAlice) ensureExpiry (expire resBob) "bob/public" ensureExpiry (expire selfBob) "bob/self" - awaitExpiry 5 (userId u1) (userId bob) + awaitExpiry 10 (userId u1) (userId bob) resBob' <- getProfile (userId u1) (userId bob) liftIO $ assertBool "Bob must be in deleted state" (fromMaybe False $ deleted resBob') where getProfile :: UserId -> UserId -> Http ResponseLBS getProfile zusr uid = get (apiVersion "v1" . b . zUser zusr . paths ["users", toByteString' uid]) UserId -> UserId -> Http () awaitExpiry n zusr uid = do -- after expiration, a profile lookup should trigger garbage collection of ephemeral users @@ -869,6 +870,7 @@ testCreateUserAnonExpiry b = do when (statusCode r == 200 && isNothing (deleted r) && n > 0) $ do liftIO $ threadDelay 1000000 awaitExpiry (n - 1) zusr uid + ensureExpiry :: Maybe UTCTime -> String -> Http () ensureExpiry expiry s = do now <- liftIO getCurrentTime @@ -880,10 +882,13 @@ testCreateUserAnonExpiry b = do maxExp = 60 * 60 * 24 * 10 :: Integer -- 10 days liftIO $ assertBool "expiry must be in the future" (diff >= fromIntegral minExp) liftIO $ assertBool "expiry must be less than 10 days" (diff < fromIntegral maxExp) + expire :: ResponseLBS -> Maybe UTCTime expire r = field "expires_at" =<< responseJsonMaybe r + deleted :: ResponseLBS -> Maybe Bool deleted r = field "deleted" =<< responseJsonMaybe r + field :: FromJSON a => Key -> Value -> Maybe a field f u = u ^? key f >>= maybeFromJSON From d66df38783609fdff248592cf31df2408f09c36b Mon Sep 17 00:00:00 2001 From: Matthias Fischmann Date: Mon, 3 Jun 2024 12:58:32 +0200 Subject: [PATCH 16/64] Do not set update origin "scim" in public brig api. (#4072) --- changelog.d/3-bug-fixes/WPB-9488-fix-update-origin | 1 + services/brig/src/Brig/API/Public.hs | 2 +- 2 files changed, 2 insertions(+), 1 deletion(-) create mode 100644 changelog.d/3-bug-fixes/WPB-9488-fix-update-origin diff --git a/changelog.d/3-bug-fixes/WPB-9488-fix-update-origin b/changelog.d/3-bug-fixes/WPB-9488-fix-update-origin new file mode 100644 index 00000000000..c22e8f3ff7d --- /dev/null +++ b/changelog.d/3-bug-fixes/WPB-9488-fix-update-origin @@ -0,0 +1 @@ +Do not set update origin "scim" in public brig api. diff --git a/services/brig/src/Brig/API/Public.hs b/services/brig/src/Brig/API/Public.hs index ec797bf83fa..3549efff504 100644 --- a/services/brig/src/Brig/API/Public.hs +++ b/services/brig/src/Brig/API/Public.hs @@ -1273,7 +1273,7 @@ updateUserEmail zuserId emailOwnerId (Public.EmailUpdate email) = do whenM (not <$> assertHasPerm maybeZuserTeamId) $ throwStd insufficientTeamPermissions maybeEmailOwnerTeamId <- lift $ wrapClient $ Data.lookupUserTeam emailOwnerId checkSameTeam maybeZuserTeamId maybeEmailOwnerTeamId - void $ API.changeSelfEmail emailOwnerId email API.AllowSCIMUpdates + void $ API.changeSelfEmail emailOwnerId email API.ForbidSCIMUpdates where checkSameTeam :: Maybe TeamId -> Maybe TeamId -> (Handler r) () checkSameTeam (Just zuserTeamId) maybeEmailOwnerTeamId = From 5c596286a67b572f04863b0ab70197335dfb70e6 Mon Sep 17 00:00:00 2001 From: Mango The Fourth <40720523+MangoIV@users.noreply.github.com> Date: Mon, 3 Jun 2024 17:00:13 +0200 Subject: [PATCH 17/64] [feat] include meate.homepage for the purl (#4075) --- hack/bin/Sbom.hs | 9 +++------ 1 file changed, 3 insertions(+), 6 deletions(-) diff --git a/hack/bin/Sbom.hs b/hack/bin/Sbom.hs index 5f8ae69abf6..2944b188fb1 100644 --- a/hack/bin/Sbom.hs +++ b/hack/bin/Sbom.hs @@ -195,8 +195,9 @@ mkPurl meta = maybe "" ("@" <>) meta.version ] where + checks = meta.homepage : meta.urls repo - | any (maybe False (T.isInfixOf "hackage.haskell.org")) meta.urls = "hackage" + | any (maybe False (T.isInfixOf "hackage.haskell.org")) checks = "hackage" | otherwise = "nixpkgs" -- | serializes an SBom to JSON format @@ -209,11 +210,7 @@ serializeSBom settings bom = do -- FUTUREWORK(mangoiv): "tools" (the tools used in the creation of the bom) let mkDependencies :: SBomMeta Identity -> Array mkDependencies meta = - [ object - [ "ref" .= meta.outPath, - "dependsOn" .= runIdentity meta.directDeps - ] - ] + [object ["ref" .= meta.outPath, "dependsOn" .= runIdentity meta.directDeps]] serializeLicense :: Maybe License -> Maybe Value serializeLicense ml = do From 357aab6a59d5c773470581def09ecd1e99291311 Mon Sep 17 00:00:00 2001 From: Matthias Fischmann Date: Wed, 5 Jun 2024 11:33:08 +0200 Subject: [PATCH 18/64] dockerephemeral environment: give ES an http interface (needed for old brig) (#4062) * dockerephemeral: add nginz rule to give ES an http interface * Whitespace and typos * Fix elasticsearch proxy * Add CHANGELOG entry * Update deploy/dockerephemeral/federation-v0/brig.yaml --------- Co-authored-by: Paolo Capriotti --- changelog.d/5-internal/elasticsearch | 1 + .../dockerephemeral/federation-v0/brig.yaml | 3 +-- .../federation-v0/nginz/conf/integration.conf | 2 +- .../federation-v0/nginz/conf/nginx.conf | 23 ++++++++++++++++--- 4 files changed, 23 insertions(+), 6 deletions(-) create mode 100644 changelog.d/5-internal/elasticsearch diff --git a/changelog.d/5-internal/elasticsearch b/changelog.d/5-internal/elasticsearch new file mode 100644 index 00000000000..84fb1f08dca --- /dev/null +++ b/changelog.d/5-internal/elasticsearch @@ -0,0 +1 @@ +Add HTTP proxy in the local setup for elasticsearch in federation-v0. This makes it possible to use a single elasticsearch instance for both the main backends and federation-v0. diff --git a/deploy/dockerephemeral/federation-v0/brig.yaml b/deploy/dockerephemeral/federation-v0/brig.yaml index 6c2216b3c1a..1864175667d 100644 --- a/deploy/dockerephemeral/federation-v0/brig.yaml +++ b/deploy/dockerephemeral/federation-v0/brig.yaml @@ -10,8 +10,7 @@ cassandra: # filterNodesByDatacentre: datacenter1 elasticsearch: - # FUTUREWORK: use separate ES v0 instance - url: http://elastic:changeme@demo_wire_elasticsearch:9200 + url: http://nginz-federation-v0:9201 index: directory_test rabbitmq: diff --git a/deploy/dockerephemeral/federation-v0/nginz/conf/integration.conf b/deploy/dockerephemeral/federation-v0/nginz/conf/integration.conf index baae352c92a..12c49ccfe88 100644 --- a/deploy/dockerephemeral/federation-v0/nginz/conf/integration.conf +++ b/deploy/dockerephemeral/federation-v0/nginz/conf/integration.conf @@ -3,7 +3,7 @@ listen 8080; listen 8081; # for nginx-without-tls, we need to use a separate port for http2 traffic, -# as nginx cannot handle unencrypted http1 and http2 trafic on the same +# as nginx cannot handle unencrypted http1 and http2 traffic on the same # port. # This port is only used for trying out nginx http2 forwarding without TLS locally and should not # be ported to any production nginz config. diff --git a/deploy/dockerephemeral/federation-v0/nginz/conf/nginx.conf b/deploy/dockerephemeral/federation-v0/nginz/conf/nginx.conf index a604e9ab199..d67bc039716 100644 --- a/deploy/dockerephemeral/federation-v0/nginz/conf/nginx.conf +++ b/deploy/dockerephemeral/federation-v0/nginz/conf/nginx.conf @@ -47,7 +47,6 @@ http { large_client_header_buffers 4 8k; - # # Security # @@ -99,12 +98,30 @@ http { default ''; } - - # # Locations # + server { + # elastic search does not support running http and https listeners + # at the same time. so our instance only runs https, but + # federation-v0 only supports http. this proxy rule helps with + # that. + # + # see also: git grep -Hn 'elasticsearch:' ../../brig.yaml + listen 9201; + + zauth_keystore /etc/wire/zauth-pubkeys.txt; + zauth_acl /etc/wire/nginz/conf/zauth_acl.txt; + + location "" { + zauth off; + + proxy_pass https://demo_wire_elasticsearch:9200; + proxy_set_header Authorization "Basic ZWxhc3RpYzpjaGFuZ2VtZQ=="; + } + } + server { include integration.conf; From 6b59c4f1c41a121200da180124bc3d6a6df37db3 Mon Sep 17 00:00:00 2001 From: Leif Battermann Date: Wed, 5 Jun 2024 11:33:44 +0200 Subject: [PATCH 19/64] WPB-9062 Provider API asset upload (#4082) --- .../3-bug-fixes/expose-provider-assets | 1 + charts/nginz/values.yaml | 22 +++++++-- integration/integration.cabal | 1 + integration/test/API/Cargohold.hs | 47 ++++++++++-------- integration/test/API/Nginz.hs | 49 +++++++++++++++++++ integration/test/Test/Provider.hs | 26 ++++++++++ integration/test/Testlib/HTTP.hs | 3 ++ .../integration-test/conf/nginz/nginx.conf | 2 +- 8 files changed, 127 insertions(+), 24 deletions(-) create mode 100644 changelog.d/3-bug-fixes/expose-provider-assets create mode 100644 integration/test/Test/Provider.hs diff --git a/changelog.d/3-bug-fixes/expose-provider-assets b/changelog.d/3-bug-fixes/expose-provider-assets new file mode 100644 index 00000000000..b23a510bfd8 --- /dev/null +++ b/changelog.d/3-bug-fixes/expose-provider-assets @@ -0,0 +1 @@ +Expose /providers/assets via nginz \ No newline at end of file diff --git a/charts/nginz/values.yaml b/charts/nginz/values.yaml index 2bfa5ae21d9..2eab637272c 100644 --- a/charts/nginz/values.yaml +++ b/charts/nginz/values.yaml @@ -232,6 +232,10 @@ nginx_conf: - path: /properties envs: - all + - path: /provider$ + envs: + - all + allow_credentials: true - path: /provider/register envs: - all @@ -253,16 +257,28 @@ nginx_conf: envs: - all disable_zauth: true - - path: /providers + - path: /provider/email envs: - all - - path: /services + allow_credentials: true + - path: /provider/password + envs: + - all + allow_credentials: true + - path: /provider/pid envs: - all - - path: /provider + allow_credentials: true + - path: /provider/services envs: - all allow_credentials: true + - path: /providers + envs: + - all + - path: /services + envs: + - all - path: /bot/self envs: - all diff --git a/integration/integration.cabal b/integration/integration.cabal index 3c3d9f63e6c..f70fd486b02 100644 --- a/integration/integration.cabal +++ b/integration/integration.cabal @@ -138,6 +138,7 @@ library Test.MLS.Unreachable Test.Notifications Test.Presence + Test.Provider Test.PushToken Test.Roles Test.Search diff --git a/integration/test/API/Cargohold.hs b/integration/test/API/Cargohold.hs index 0fe767fea35..8baa18c4148 100644 --- a/integration/test/API/Cargohold.hs +++ b/integration/test/API/Cargohold.hs @@ -32,38 +32,45 @@ uploadAssetV3 user isPublic retention mimeType bdy = do req & zUser uid & addBody body multipartMixedMime - where - multipartMixedMime :: String - multipartMixedMime = "multipart/mixed; boundary=" <> multipartBoundary uploadAsset :: (HasCallStack, MakesValue user) => user -> App Response uploadAsset = flip uploadFreshAsset "Hello World!" +uploadProviderAsset :: (HasCallStack, MakesValue domain) => domain -> String -> String -> App Response +uploadProviderAsset domain pid payload = do + req <- rawBaseRequest domain Cargohold Versioned $ joinHttpPath ["provider", "assets"] + bdy <- txtAsset payload + submit "POST" $ + req + & zProvider pid + & zType "provider" + & addBody bdy multipartMixedMime + uploadFreshAsset :: (HasCallStack, MakesValue user) => user -> String -> App Response uploadFreshAsset user payload = do uid <- user & objId req <- baseRequest user Cargohold Versioned "/assets" - bdy <- txtAsset + bdy <- txtAsset payload submit "POST" $ req & zUser uid & addBody bdy multipartMixedMime - where - txtAsset :: HasCallStack => App HTTP.RequestBody - txtAsset = - buildUploadAssetRequestBody - True - (Nothing :: Maybe String) - (LBSC.pack payload) - textPlainMime - - textPlainMime :: MIME.MIMEType - textPlainMime = MIME.Text $ T.pack "plain" - - -- This case is a bit special and doesn't fit to MIMEType: We need to define - -- the boundary. - multipartMixedMime :: String - multipartMixedMime = "multipart/mixed; boundary=" <> multipartBoundary + +txtAsset :: HasCallStack => String -> App HTTP.RequestBody +txtAsset payload = + buildUploadAssetRequestBody + True + (Nothing :: Maybe String) + (LBSC.pack payload) + textPlainMime + +textPlainMime :: MIME.MIMEType +textPlainMime = MIME.Text $ T.pack "plain" + +-- This case is a bit special and doesn't fit to MIMEType: We need to define +-- the boundary. +multipartMixedMime :: String +multipartMixedMime = "multipart/mixed; boundary=" <> multipartBoundary mimeTypeToString :: MIME.MIMEType -> String mimeTypeToString = T.unpack . MIME.showMIMEType diff --git a/integration/test/API/Nginz.hs b/integration/test/API/Nginz.hs index b4c2f08db5b..d963b79fe8d 100644 --- a/integration/test/API/Nginz.hs +++ b/integration/test/API/Nginz.hs @@ -1,5 +1,12 @@ module API.Nginz where +import qualified Codec.MIME.Type as MIME +import qualified Data.Aeson as Aeson +import qualified Data.ByteString.Lazy as LBS +import qualified Data.ByteString.Lazy.Char8 as LBSC +import qualified Data.Text as T +import qualified Network.HTTP.Client as HTTP +import Test.Cargohold.API.Util (buildMultipartBody, multipartBoundary) import Testlib.Prelude getSystemSettingsUnAuthorized :: (HasCallStack, MakesValue domain) => domain -> App Response @@ -41,3 +48,45 @@ getConversation user qcnv t = do token <- make t & asString req <- rawBaseRequest user Nginz Versioned (joinHttpPath ["conversations", domain, cnv]) submit "GET" (req & addHeader "Authorization" ("Bearer " <> token)) + +uploadProviderAsset :: (HasCallStack, MakesValue domain) => domain -> String -> String -> App Response +uploadProviderAsset domain cookie payload = do + req <- rawBaseRequest domain Nginz Versioned $ joinHttpPath ["provider", "assets"] + bdy <- txtAsset payload + submit "POST" $ + req + & setCookie cookie + & addBody bdy multipartMixedMime + +txtAsset :: HasCallStack => String -> App HTTP.RequestBody +txtAsset payload = + buildUploadAssetRequestBody + True + (Nothing :: Maybe String) + (LBSC.pack payload) + textPlainMime + +textPlainMime :: MIME.MIMEType +textPlainMime = MIME.Text $ T.pack "plain" + +-- This case is a bit special and doesn't fit to MIMEType: We need to define +-- the boundary. +multipartMixedMime :: String +multipartMixedMime = "multipart/mixed; boundary=" <> multipartBoundary + +buildUploadAssetRequestBody :: + (HasCallStack, MakesValue assetRetention) => + Bool -> + assetRetention -> + LBS.ByteString -> + MIME.MIMEType -> + App HTTP.RequestBody +buildUploadAssetRequestBody isPublic retention body mimeType = do + mbRetention <- make retention + let header' :: Aeson.Value + header' = + Aeson.object + [ "public" .= isPublic, + "retention" .= mbRetention + ] + HTTP.RequestBodyLBS <$> buildMultipartBody header' body mimeType diff --git a/integration/test/Test/Provider.hs b/integration/test/Test/Provider.hs new file mode 100644 index 00000000000..5663fb11912 --- /dev/null +++ b/integration/test/Test/Provider.hs @@ -0,0 +1,26 @@ +module Test.Provider where + +import API.Brig +-- import API.Cargohold (uploadProviderAsset) + +import qualified API.Cargohold as Cargohold +import API.Common +import qualified API.Nginz as Nginz +import Data.String.Conversions (cs) +import SetupHelpers +import Testlib.Prelude + +testProviderUploadAsset :: HasCallStack => App () +testProviderUploadAsset = do + email <- randomEmail + alice <- randomUser OwnDomain def + provider <- setupProvider alice def {newProviderEmail = email} + pid <- provider %. "id" & asString + -- test cargohold API + bindResponse (Cargohold.uploadProviderAsset OwnDomain pid "profile pic") $ \resp -> do + resp.status `shouldMatchInt` 201 + pw <- provider %. "password" & asString + cookie <- loginProvider OwnDomain email pw + -- test Nginz API + bindResponse (Nginz.uploadProviderAsset OwnDomain (cs cookie) "another profile pic") $ \resp -> do + resp.status `shouldMatchInt` 201 diff --git a/integration/test/Testlib/HTTP.hs b/integration/test/Testlib/HTTP.hs index e21b6e3c588..712c99a17ca 100644 --- a/integration/test/Testlib/HTTP.hs +++ b/integration/test/Testlib/HTTP.hs @@ -160,6 +160,9 @@ baseRequest user service versioned path = do zUser :: String -> HTTP.Request -> HTTP.Request zUser = addHeader "Z-User" +zProvider :: String -> HTTP.Request -> HTTP.Request +zProvider = addHeader "Z-Provider" + zConnection :: String -> HTTP.Request -> HTTP.Request zConnection = addHeader "Z-Connection" diff --git a/services/nginz/integration-test/conf/nginz/nginx.conf b/services/nginz/integration-test/conf/nginz/nginx.conf index 6485d34a58d..d0036ea1b9c 100644 --- a/services/nginz/integration-test/conf/nginz/nginx.conf +++ b/services/nginz/integration-test/conf/nginz/nginx.conf @@ -336,7 +336,7 @@ http { proxy_pass http://cargohold; } - location /provider/assets { + location ~* ^(/v[0-9]+)?/provider/assets$ { include common_response_with_zauth.conf; proxy_pass http://cargohold; } From f7e669b59bc0e8f9ded618f5ab75d3982981d358 Mon Sep 17 00:00:00 2001 From: Leif Battermann Date: Wed, 5 Jun 2024 16:06:58 +0200 Subject: [PATCH 20/64] WPB-9102 gundeck: Better tolerance for redis-cluster restarts (#4084) * hedis: Upgrade to fix connection timeout issues with cluster Upstream PR: https://github.com/informatikr/hedis/pull/227 * changelog --- changelog.d/3-bug-fixes/redis | 1 + nix/haskell-pins.nix | 5 +++-- 2 files changed, 4 insertions(+), 2 deletions(-) create mode 100644 changelog.d/3-bug-fixes/redis diff --git a/changelog.d/3-bug-fixes/redis b/changelog.d/3-bug-fixes/redis new file mode 100644 index 00000000000..06767cd9fe7 --- /dev/null +++ b/changelog.d/3-bug-fixes/redis @@ -0,0 +1 @@ +gundeck: Better tolerance for redis-cluster restarts diff --git a/nix/haskell-pins.nix b/nix/haskell-pins.nix index bdd47bae029..39b77216b17 100644 --- a/nix/haskell-pins.nix +++ b/nix/haskell-pins.nix @@ -130,11 +130,12 @@ let # PR: https://github.com/informatikr/hedis/pull/224 # PR: https://github.com/informatikr/hedis/pull/226 + # PR: https://github.com/informatikr/hedis/pull/227 hedis = { src = fetchgit { url = "https://github.com/wireapp/hedis"; - rev = "c45975e4b5f42b9d0c853e2d59ed55582f6b1482"; - sha256 = "sha256-oB7Z7ErYFguLiWPaFzCsD3Q+7UPfAkvdkc8aKSePmbQ="; + rev = "87f4a5ecfa572dfdc9ebe905485d0012ad2d1833"; + sha256 = "sha256-3evlUj/n39SYncJDUjN6hk12tn/DyCFy2TFvP0/6xdU="; }; }; From 5d37f6cbfabf66de8588ff5698aee58aff34183b Mon Sep 17 00:00:00 2001 From: Paolo Capriotti Date: Thu, 6 Jun 2024 11:19:30 +0200 Subject: [PATCH 21/64] User subsystem: add profile update operations (#4046) MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * UpdateUser operation; work on Error sub-effects. * Fix build * Rename onUserEvent → generateUserEvent * Use state effect for local users in mini backends * Implement user update in mini backends * Add user update property test * [feat] rethrow errors as wai errors * [feat] test behaviour if user is managed by scim * [feat] set galley api access * [feat] test all of the update record members * [feat] interpret user events * Use MiniBackend state effect in mini-backend stack * Add fake event interpreter * Add Arbitrary instance for AllowSCIMUpdates * Replace UserUpdate with a new type * Use update functionality in brig * Add locale update to user subsystem * Move allowScim argument to update structure * Add handle update functionality to UserSubsystem Some of the functions in brig now have a UserStore constraint. This is only temporary until all the user-related functionality has been migrated to subsystems. * Make sure NotPending users have an identity * Check claimed handles * Implement handle lookup in mini backend * Add DeleteUser action to UserStore * Add some TODOs * Lint and format * Added missing where clause. * Fixed tombstone. * Renamed cql query function for clarity. * usersubsystems: added handle parsing text. * Formatting. * UserSubsystems: Added prop tests for handles. * lint * UserSubsystem: added scim handle update tests. * added changelog * Added update supported protocols. * Fix 2 test cases. * Fixed property test. * Deleted repeated lines. * Regen nix. * Removed ambiguity. * Updated call sites. * Remove bogus (and unnecessary) -Wwarn pragma. * explicit imports, exports. * Removed outdated FUTUREWORK. * Typo. * Make leaking interpreter implementation into brig more explicit. * Drive-by fix. * Send handle update events. * Test for update supportedProtocols. * Update supportedProtocols [wip] * Fixed test for supported protocols. * WIP: fix permission checks * Move BadHandle type and qc generator to types-common. * Fix handle update for blocklisted handles. * Make supported-protocols update test a property. * Fix more failing test cases (same pattern as before). * Simplify checkHandle test * UserSubsystem: Implement GetSelfProfile * UserSubsystem.updateUserProfile: Add assertion for updating locale * Remove TODO deemed requiring discussion * UserSubsystem: Implement GetSelfProfile Needed for testing updates to locale * Rename names. * Re-align userstore and user subsystem interfaces around handle. * Rm some boolean blindness. * Rename names (really bad ones this time...). * Fix UpdateOriginType values in brig api. * rm TODO. * Add TODOs. * Fix TODO syntax :) * Deprioritize TODO. * Haddocs. * Improve error message for invalid handles. * Rename names. * Note on db performance. * Remove unproducable error. * Haddocks. * Remove misguided TODOs. claimHandle is not exported, it's just the cassandra-specific part of updateHandle; errors are handled in user subsystem. * Fix: update locale by client not allowed if user is managed by scim. * Fix names. * remove more low-prio TODOs. * Resolve TODO. * Add test for locale update under scim management. * Fix test. * Fix tests, add happy path for profile update. * Fixup * Fix locale update. * Rm dead code. * Typo * Fix compiler errors. * Rm dead code. * Test coverage. * Fix missing fields in update event. * Dry-by fix: make responseJsonUnsafe more helpful when crashing. * hlint. * hlint. (?!) * Polish haddocks. * Changelog. * Make Handle data type abstract. * Revert "Make Handle data type abstract." This reverts commit 459e966109713bbf01a7816e21ec1320245df37e. * Move local function in where block. * Remove FUTUREWORK (misplaced by ormolu, also self-evident.) * Rename local function. * Fix test case. * remove obsolete changelog entry (this has been fixed in WPB-9488). * Rm dead code from rest api. * Revert "Rm dead code from rest api." This reverts commit 8c662304665a6713c01f710f1f89e51c42e05b20. (maybe this is used elsewhere? also the removal wasn't complete.) * Update services/brig/test/integration/API/UserPendingActivation.hs * Update services/brig/src/Brig/User/Auth.hs * More guards in unit tests against invalid arbitrary values. * Fixup * Fix test case. * Improve error message for `*ManagedByScim`. * Revert "Fix test case." This reverts commit 4059bf93f4b9b835b2f508e1a0754351f6457b02. * Fix application logic around blocking updates because scim or e2eid. * hlint. * failed attempt to port a galley test to /integration * Revert "failed attempt to port a galley test to /integration" This reverts commit c40670e238ff051abbb74538f9baadbe554a3049. * I think I found the problem with this test! (fix coming up) * Small fix for legacy integration test. --------- Co-authored-by: Magnus Viernickel Co-authored-by: Igor Ranieri Co-authored-by: Matthias Fischmann Co-authored-by: Akshay Mankar --- changelog.d/5-internal/WPB-8880 | 1 + libs/bilge/src/Bilge/Response.hs | 2 +- libs/types-common/src/Data/Handle.hs | 23 ++ libs/types-common/test/Test/Handle.hs | 7 +- libs/wire-api/default.nix | 2 + libs/wire-api/src/Wire/API/Error/Brig.hs | 9 +- .../src/Wire/API/Routes/Internal/Brig.hs | 2 +- .../src/Wire/API/Routes/Public/Brig.hs | 14 +- libs/wire-api/src/Wire/API/Team/Feature.hs | 26 ++ libs/wire-api/src/Wire/API/User.hs | 2 +- libs/wire-api/wire-api.cabal | 1 + libs/wire-subsystems/default.nix | 7 + libs/wire-subsystems/src/Wire/MiniBackend.hs | 217 +++++++++--- libs/wire-subsystems/src/Wire/StoredUser.hs | 44 ++- libs/wire-subsystems/src/Wire/UserEvents.hs | 13 + libs/wire-subsystems/src/Wire/UserStore.hs | 55 +++ .../src/Wire/UserStore/Cassandra.hs | 129 ++++++- .../src/Wire/UserStore}/Unique.hs | 23 +- .../wire-subsystems/src/Wire/UserSubsystem.hs | 89 +++++ .../src/Wire/UserSubsystem/HandleBlacklist.hs | 19 +- .../src/Wire/UserSubsystem/Interpreter.hs | 233 ++++++++++++- .../Wire/UserSubsystem/InterpreterSpec.hs | 325 ++++++++++++++++-- libs/wire-subsystems/wire-subsystems.cabal | 8 + services/brig/brig.cabal | 5 +- services/brig/default.nix | 2 +- services/brig/src/Brig/API/Auth.hs | 3 +- services/brig/src/Brig/API/Federation.hs | 17 +- services/brig/src/Brig/API/Internal.hs | 101 +++--- services/brig/src/Brig/API/Public.hs | 137 ++++---- services/brig/src/Brig/API/User.hs | 301 +++------------- services/brig/src/Brig/API/Util.hs | 23 +- services/brig/src/Brig/App.hs | 8 + .../brig/src/Brig/CanonicalInterpreter.hs | 19 +- services/brig/src/Brig/Data/User.hs | 46 --- services/brig/src/Brig/Data/UserKey.hs | 6 +- services/brig/src/Brig/IO/Intra.hs | 18 +- .../brig/src/Brig/InternalEvent/Process.hs | 7 +- services/brig/src/Brig/Team/API.hs | 10 +- services/brig/src/Brig/User/API/Handle.hs | 13 +- services/brig/src/Brig/User/API/Search.hs | 9 +- services/brig/src/Brig/User/Auth.hs | 14 +- services/brig/src/Brig/User/EJPD.hs | 7 +- services/brig/src/Brig/User/Handle.hs | 100 ------ services/brig/test/integration/API/Team.hs | 17 +- .../brig/test/integration/API/User/Account.hs | 4 + 45 files changed, 1405 insertions(+), 713 deletions(-) create mode 100644 changelog.d/5-internal/WPB-8880 create mode 100644 libs/wire-subsystems/src/Wire/UserEvents.hs rename {services/brig/src/Brig => libs/wire-subsystems/src/Wire/UserStore}/Unique.hs (92%) rename services/brig/src/Brig/User/Handle/Blacklist.hs => libs/wire-subsystems/src/Wire/UserSubsystem/HandleBlacklist.hs (54%) delete mode 100644 services/brig/src/Brig/User/Handle.hs diff --git a/changelog.d/5-internal/WPB-8880 b/changelog.d/5-internal/WPB-8880 new file mode 100644 index 00000000000..3527e5de73b --- /dev/null +++ b/changelog.d/5-internal/WPB-8880 @@ -0,0 +1 @@ +Added profile update operations to the user subsystem. diff --git a/libs/bilge/src/Bilge/Response.hs b/libs/bilge/src/Bilge/Response.hs index 08c63c5be5d..a4e422094ae 100644 --- a/libs/bilge/src/Bilge/Response.hs +++ b/libs/bilge/src/Bilge/Response.hs @@ -131,7 +131,7 @@ responseJsonUnsafe :: (HasCallStack, Typeable a, FromJSON a) => ResponseLBS -> a -responseJsonUnsafe = responseJsonUnsafeWithMsg "" +responseJsonUnsafe resp = responseJsonUnsafeWithMsg (show resp) resp {-# INLINE responseJsonUnsafeWithMsg #-} responseJsonUnsafeWithMsg :: diff --git a/libs/types-common/src/Data/Handle.hs b/libs/types-common/src/Data/Handle.hs index 59854e89ec8..6c9a6884f3b 100644 --- a/libs/types-common/src/Data/Handle.hs +++ b/libs/types-common/src/Data/Handle.hs @@ -22,10 +22,12 @@ module Data.Handle parseHandle, parseHandleEither, isValidHandle, + BadHandle (..), ) where import Cassandra qualified as C +import Control.Lens (ix, (.~)) import Data.Aeson (FromJSON (..), ToJSON (..)) import Data.Attoparsec.ByteString.Char8 qualified as Atto import Data.Bifunctor (Bifunctor (first)) @@ -101,3 +103,24 @@ instance Arbitrary Handle where Handle . Text.pack <$> do len <- oneof [choose (2, 10), choose (2, 256)] -- prefer short handles replicateM len (elements $ ['a' .. 'z'] <> ['0' .. '9'] <> "_-.") + +-- | for testing +newtype BadHandle = BadHandle {fromBadHandle :: Text} + deriving newtype (Eq, Show) + +instance Arbitrary BadHandle where + arbitrary = oneof [tooShort, tooLong, badBytes] + where + tooShort = (BadHandle . Text.pack . (: [])) <$> elements validChar + tooLong = (BadHandle . Text.pack) <$> replicateM 258 (elements validChar) + badBytes = + BadHandle <$> do + totalLen :: Int <- choose (2, 256) + invalidCharPos :: Int <- choose (0, totalLen - 1) + invalidCharContent <- elements invalidChar + good :: Text <- Text.pack <$> replicateM totalLen (elements validChar) + let bad :: Text = good & ix invalidCharPos .~ invalidCharContent + pure bad + + validChar :: [Char] = ['a' .. 'z'] <> ['0' .. '9'] <> "_-." + invalidChar :: [Char] = [minBound ..] \\ validChar diff --git a/libs/types-common/test/Test/Handle.hs b/libs/types-common/test/Test/Handle.hs index d194cbe13b7..0f6bc8b3352 100644 --- a/libs/types-common/test/Test/Handle.hs +++ b/libs/types-common/test/Test/Handle.hs @@ -20,7 +20,7 @@ module Test.Handle ) where -import Data.Handle (Handle (fromHandle), parseHandleEither) +import Data.Handle (BadHandle (fromBadHandle), Handle (fromHandle), parseHandleEither) import Data.Text qualified as Text import Imports import Test.Tasty @@ -67,5 +67,8 @@ testHandleSerialization = Right parsed -> assertFailure $ "invalid handle parsed successfully: " <> show (h, parsed), testProperty "roundtrip for Handle" $ \(x :: Handle) -> - parseHandleEither (fromHandle x) === Right x + parseHandleEither (fromHandle x) === Right x, + testProperty "roundtrip for BadHandle" $ + \(x :: BadHandle) -> + property . isLeft . parseHandleEither $ fromBadHandle x ] diff --git a/libs/wire-api/default.nix b/libs/wire-api/default.nix index c55239a351b..8ca3c6f5b24 100644 --- a/libs/wire-api/default.nix +++ b/libs/wire-api/default.nix @@ -29,6 +29,7 @@ , crypton , crypton-x509 , currency-codes +, data-default , deriving-aeson , deriving-swagger2 , either @@ -139,6 +140,7 @@ mkDerivation { crypton crypton-x509 currency-codes + data-default deriving-aeson deriving-swagger2 either diff --git a/libs/wire-api/src/Wire/API/Error/Brig.hs b/libs/wire-api/src/Wire/API/Error/Brig.hs index ba1a227794b..1a9accdd1b8 100644 --- a/libs/wire-api/src/Wire/API/Error/Brig.hs +++ b/libs/wire-api/src/Wire/API/Error/Brig.hs @@ -65,6 +65,7 @@ data BrigError | UserKeyExists | NameManagedByScim | HandleManagedByScim + | LocaleManagedByScim | LastIdentity | NoPassword | ChangePasswordMustDiffer @@ -172,7 +173,7 @@ type instance MapError 'NoIdentity = 'StaticError 403 "no-identity" "The user ha type instance MapError 'HandleExists = 'StaticError 409 "handle-exists" "The given handle is already taken" -type instance MapError 'InvalidHandle = 'StaticError 400 "invalid-handle" "The given handle is invalid" +type instance MapError 'InvalidHandle = 'StaticError 400 "invalid-handle" "The given handle is invalid (less than 2 or more than 256 characters; chars not in \"a-z0-9_.-\"; or on the blocklist)" type instance MapError 'HandleNotFound = 'StaticError 404 "not-found" "Handle not found" @@ -238,9 +239,11 @@ type instance MapError 'AccountPending = 'StaticError 403 "pending-activation" " type instance MapError 'UserKeyExists = 'StaticError 409 "key-exists" "The given e-mail address or phone number is in use." -type instance MapError 'NameManagedByScim = 'StaticError 403 "managed-by-scim" "Updating name is not allowed, because it is managed by SCIM" +type instance MapError 'NameManagedByScim = 'StaticError 403 "managed-by-scim" "Updating name is not allowed, because it is managed by SCIM, or E2EId is enabled" -type instance MapError 'HandleManagedByScim = 'StaticError 403 "managed-by-scim" "Updating handle is not allowed, because it is managed by SCIM" +type instance MapError 'HandleManagedByScim = 'StaticError 403 "managed-by-scim" "Updating handle is not allowed, because it is managed by SCIM, or E2EId is enabled" + +type instance MapError 'LocaleManagedByScim = 'StaticError 403 "managed-by-scim" "Updating locale is not allowed, because it is managed by SCIM, or E2EId is enabled" type instance MapError 'LastIdentity = 'StaticError 403 "last-identity" "The last user identity (email or phone number) cannot be removed." diff --git a/libs/wire-api/src/Wire/API/Routes/Internal/Brig.hs b/libs/wire-api/src/Wire/API/Routes/Internal/Brig.hs index 43ca007abb1..3de1d1705eb 100644 --- a/libs/wire-api/src/Wire/API/Routes/Internal/Brig.hs +++ b/libs/wire-api/src/Wire/API/Routes/Internal/Brig.hs @@ -395,7 +395,7 @@ type AccountAPI = :> Put '[Servant.JSON] NoContent ) :<|> Named - "iPutHandle" + "iPutUserName" ( "users" :> Capture "uid" UserId :> "name" diff --git a/libs/wire-api/src/Wire/API/Routes/Public/Brig.hs b/libs/wire-api/src/Wire/API/Routes/Public/Brig.hs index f81d8f1a399..b90650fe891 100644 --- a/libs/wire-api/src/Wire/API/Routes/Public/Brig.hs +++ b/libs/wire-api/src/Wire/API/Routes/Public/Brig.hs @@ -297,7 +297,7 @@ type SelfAPI = "get-self" ( Summary "Get your own profile" :> DescriptionOAuthScope 'ReadSelf - :> ZUser + :> ZLocalUser :> "self" :> Get '[JSON] SelfProfile ) @@ -334,11 +334,11 @@ type SelfAPI = "put-self" ( Summary "Update your profile." :> MakesFederatedCall 'Brig "send-connection-action" - :> ZUser + :> ZLocalUser :> ZConn :> "self" :> ReqBody '[JSON] UserUpdate - :> MultiVerb 'PUT '[JSON] PutSelfResponses (Maybe UpdateProfileError) + :> MultiVerb1 'PUT '[JSON] (RespondEmpty 200 "User updated") ) :<|> Named "change-phone" @@ -409,24 +409,24 @@ type SelfAPI = "change-locale" ( Summary "Change your locale." :> MakesFederatedCall 'Brig "send-connection-action" - :> ZUser + :> ZLocalUser :> ZConn :> "self" :> "locale" :> ReqBody '[JSON] LocaleUpdate - :> MultiVerb 'PUT '[JSON] '[RespondEmpty 200 "Local Changed"] () + :> MultiVerb1 'PUT '[JSON] (RespondEmpty 200 "Local Changed") ) :<|> Named "change-handle" ( Summary "Change your handle." :> MakesFederatedCall 'Brig "send-connection-action" :> MakesFederatedCall 'Brig "send-connection-action" - :> ZUser + :> ZLocalUser :> ZConn :> "self" :> "handle" :> ReqBody '[JSON] HandleUpdate - :> MultiVerb 'PUT '[JSON] ChangeHandleResponses (Maybe ChangeHandleError) + :> MultiVerb1 'PUT '[JSON] (RespondEmpty 200 "Handle Changed") ) :<|> Named "change-supported-protocols" diff --git a/libs/wire-api/src/Wire/API/Team/Feature.hs b/libs/wire-api/src/Wire/API/Team/Feature.hs index 290170ee0a1..2376634db08 100644 --- a/libs/wire-api/src/Wire/API/Team/Feature.hs +++ b/libs/wire-api/src/Wire/API/Team/Feature.hs @@ -97,6 +97,7 @@ import Data.Attoparsec.ByteString qualified as Parser import Data.ByteString (fromStrict) import Data.ByteString.Conversion import Data.ByteString.UTF8 qualified as UTF8 +import Data.Default import Data.Domain (Domain) import Data.Either.Extra (maybeToEither) import Data.Id @@ -1242,6 +1243,31 @@ data AllFeatureConfigs = AllFeatureConfigs deriving stock (Eq, Show) deriving (FromJSON, ToJSON, S.ToSchema) via (Schema AllFeatureConfigs) +instance Default AllFeatureConfigs where + def = + AllFeatureConfigs + { afcLegalholdStatus = defFeatureStatus, + afcSSOStatus = defFeatureStatus, + afcTeamSearchVisibilityAvailable = defFeatureStatus, + afcSearchVisibilityInboundConfig = defFeatureStatus, + afcValidateSAMLEmails = defFeatureStatus, + afcDigitalSignatures = defFeatureStatus, + afcAppLock = defFeatureStatus, + afcFileSharing = defFeatureStatus, + afcClassifiedDomains = defFeatureStatus, + afcConferenceCalling = defFeatureStatus, + afcSelfDeletingMessages = defFeatureStatus, + afcGuestLink = defFeatureStatus, + afcSndFactorPasswordChallenge = defFeatureStatus, + afcMLS = defFeatureStatus, + afcExposeInvitationURLsToTeamAdmin = defFeatureStatus, + afcOutlookCalIntegration = defFeatureStatus, + afcMlsE2EId = defFeatureStatus, + afcMlsMigration = defFeatureStatus, + afcEnforceFileDownloadLocation = defFeatureStatus, + afcLimitedEventFanout = defFeatureStatus + } + instance ToSchema AllFeatureConfigs where schema = object "AllFeatureConfigs" $ diff --git a/libs/wire-api/src/Wire/API/User.hs b/libs/wire-api/src/Wire/API/User.hs index f74380e1dd0..2e3e6f0a017 100644 --- a/libs/wire-api/src/Wire/API/User.hs +++ b/libs/wire-api/src/Wire/API/User.hs @@ -2045,7 +2045,7 @@ instance ToSchema SendVerificationCode where -- Unlike 'ProtocolTag', this does not include any transitional protocols used -- for migration. data BaseProtocolTag = BaseProtocolProteusTag | BaseProtocolMLSTag - deriving stock (Eq, Ord, Show, Generic) + deriving stock (Eq, Ord, Enum, Bounded, Show, Generic) deriving (Arbitrary) via (GenericUniform BaseProtocolTag) deriving (FromJSON, ToJSON, S.ToSchema) via (Schema BaseProtocolTag) diff --git a/libs/wire-api/wire-api.cabal b/libs/wire-api/wire-api.cabal index 306f27e9b37..ec9ca0404e6 100644 --- a/libs/wire-api/wire-api.cabal +++ b/libs/wire-api/wire-api.cabal @@ -268,6 +268,7 @@ library , crypton , crypton-x509 , currency-codes >=2.0 + , data-default , deriving-aeson >=0.2 , deriving-swagger2 , either diff --git a/libs/wire-subsystems/default.nix b/libs/wire-subsystems/default.nix index 7d5e5e02060..0d37cbf39e9 100644 --- a/libs/wire-subsystems/default.nix +++ b/libs/wire-subsystems/default.nix @@ -18,6 +18,7 @@ , cql , currency-codes , data-default +, data-timeout , errors , exceptions , extended @@ -56,6 +57,7 @@ , transitive-anns , types-common , unliftio +, unordered-containers , uuid , wai-utilities , wire-api @@ -81,6 +83,7 @@ mkDerivation { cql currency-codes data-default + data-timeout errors exceptions extended @@ -114,6 +117,7 @@ mkDerivation { transitive-anns types-common unliftio + unordered-containers uuid wai-utilities wire-api @@ -127,11 +131,13 @@ mkDerivation { bytestring containers data-default + errors extended gundeck-types hspec imports iso639 + lens polysemy polysemy-plugin polysemy-time @@ -140,6 +146,7 @@ mkDerivation { quickcheck-instances servant-client-core string-conversions + text time transformers types-common diff --git a/libs/wire-subsystems/src/Wire/MiniBackend.hs b/libs/wire-subsystems/src/Wire/MiniBackend.hs index 9ff7e22e0b3..4a915049448 100644 --- a/libs/wire-subsystems/src/Wire/MiniBackend.hs +++ b/libs/wire-subsystems/src/Wire/MiniBackend.hs @@ -1,7 +1,28 @@ -module Wire.MiniBackend where +module Wire.MiniBackend + ( -- * Mini backends + MiniBackend (..), + AllErrors, + GetUserProfileEffects, + interpretFederationStack, + runFederationStack, + interpretNoFederationStack, + runNoFederationStack, + runAllErrorsUnsafe, + runErrorUnsafe, + miniLocale, + + -- * Mini events + MiniEvent (..), + + -- * Quickcheck helpers + NotPendingStoredUser (..), + PendingStoredUser (..), + ) +where import Data.Default (Default (def)) import Data.Domain +import Data.Handle (Handle) import Data.Id import Data.LanguageCodes (ISO639_1 (EN)) import Data.LegalHold (defUserLegalHoldStatus) @@ -9,13 +30,13 @@ import Data.Map.Lazy qualified as LM import Data.Map.Strict qualified as M import Data.Proxy import Data.Qualified -import Data.Set qualified as S import Data.Time import Data.Type.Equality import Imports import Polysemy import Polysemy.Error import Polysemy.Input +import Polysemy.Internal import Polysemy.State import Servant.Client.Core import Test.QuickCheck @@ -23,18 +44,21 @@ import Type.Reflection import Wire.API.Federation.API import Wire.API.Federation.Component import Wire.API.Federation.Error -import Wire.API.Team.Member -import Wire.API.User hiding (DeleteUser) +import Wire.API.Team.Feature +import Wire.API.Team.Member hiding (userId) +import Wire.API.User as User hiding (DeleteUser) +import Wire.API.UserEvent import Wire.DeleteQueue import Wire.DeleteQueue.InMemory import Wire.FederationAPIAccess import Wire.FederationAPIAccess.Interpreter as FI import Wire.GalleyAPIAccess -import Wire.InternalEvent +import Wire.InternalEvent hiding (DeleteUser) import Wire.Sem.Concurrency import Wire.Sem.Concurrency.Sequential -import Wire.Sem.Now +import Wire.Sem.Now hiding (get) import Wire.StoredUser +import Wire.UserEvents import Wire.UserStore import Wire.UserSubsystem import Wire.UserSubsystem.Interpreter @@ -52,28 +76,41 @@ newtype NotPendingStoredUser = NotPendingStoredUser StoredUser instance Arbitrary NotPendingStoredUser where arbitrary = do - user <- arbitrary + user <- arbitrary `suchThat` \user -> isJust user.identity notPendingStatus <- elements (Nothing : map Just [Active, Suspended, Deleted, Ephemeral]) pure $ NotPendingStoredUser (user {status = notPendingStatus}) +type AllErrors = + [ Error UserSubsystemError, + Error FederationError + ] + type GetUserProfileEffects = [ UserSubsystem, GalleyAPIAccess, UserStore, DeleteQueue, + UserEvents, State [InternalNotification], + State MiniBackend, + State [MiniEvent], Now, Input UserSubsystemConfig, FederationAPIAccess MiniFederationMonad, - Concurrency 'Unsafe, - Error FederationError + Concurrency 'Unsafe ] +data MiniEvent = MkMiniEvent + { userId :: UserId, + event :: UserEvent + } + deriving stock (Eq, Show) + -- | a type representing the state of a single backend data MiniBackend = MkMiniBackend { -- | this is morally the same as the users stored in the actual backend -- invariant: for each key, the user.id and the key are the same - users :: Set StoredUser + users :: [StoredUser] } instance Default MiniBackend where @@ -167,7 +204,7 @@ miniGetAllProfiles = do pure $ map (\u -> mkUserProfileWithEmail Nothing (mkUserFromStored dom miniLocale u) defUserLegalHoldStatus) - (S.toList users) + users miniGetUsersByIds :: [UserId] -> MiniFederationMonad 'Brig [UserProfile] miniGetUsersByIds userIds = runOnOwnBackend do @@ -195,59 +232,77 @@ interpretNowConst time = interpret \case Wire.Sem.Now.Get -> pure time runFederationStack :: - [StoredUser] -> + MiniBackend -> Map Domain MiniBackend -> Maybe TeamMember -> UserSubsystemConfig -> - Sem GetUserProfileEffects a -> + Sem (GetUserProfileEffects `Append` AllErrors) a -> a -runFederationStack allLocalUsers fedBackends teamMember cfg = - let unsafeError e = error $ "Unexpected error: " <> displayException e - in either unsafeError Imports.id - . runFederationStackEither - allLocalUsers - fedBackends - teamMember - cfg - -runFederationStackEither :: - [StoredUser] -> - -- | the available backend +runFederationStack localBackend fedBackends teamMember cfg = + runAllErrorsUnsafe + . interpretFederationStack + localBackend + fedBackends + teamMember + cfg + +interpretFederationStack :: + (Members AllErrors r) => + -- | the local backend + MiniBackend -> + -- | the available backends Map Domain MiniBackend -> Maybe TeamMember -> UserSubsystemConfig -> - Sem GetUserProfileEffects a -> - Either FederationError a -runFederationStackEither allLocalUsers backends teamMember cfg = - run - . runError - . sequentiallyPerformConcurrency + Sem (GetUserProfileEffects `Append` r) a -> + Sem r a +interpretFederationStack localBackend backends teamMember cfg = + sequentiallyPerformConcurrency . miniFederationAPIAccess backends . runInputConst cfg . interpretNowConst (UTCTime (ModifiedJulianDay 0) 0) . evalState [] + . evalState localBackend + . evalState [] + . miniEventInterpreter . inMemoryDeleteQueueInterpreter - . staticUserStoreInterpreter allLocalUsers - . miniGalleyAPIAccess teamMember + . staticUserStoreInterpreter + . miniGalleyAPIAccess teamMember def . runUserSubsystem cfg runNoFederationStack :: - [StoredUser] -> + MiniBackend -> Maybe TeamMember -> UserSubsystemConfig -> - Sem GetUserProfileEffects a -> + Sem (GetUserProfileEffects `Append` AllErrors) a -> a -runNoFederationStack allUsers teamMember cfg = - run - . runErrorUnsafe - . sequentiallyPerformConcurrency +runNoFederationStack localBackend teamMember cfg = + -- (A 'runNoFederationStackEither' variant of this that returns 'AllErrors' in an 'Either' + -- would be nice, but is complicated by the fact that we not only have 'UserSubsystemErrors', + -- but other errors as well. Maybe just wait with this until we have a better idea how we + -- want to do errors?) + runAllErrorsUnsafe . interpretNoFederationStack localBackend teamMember def cfg + +interpretNoFederationStack :: + (Members AllErrors r) => + MiniBackend -> + Maybe TeamMember -> + AllFeatureConfigs -> + UserSubsystemConfig -> + Sem (GetUserProfileEffects `Append` r) a -> + Sem r a +interpretNoFederationStack localBackend teamMember galleyConfigs cfg = + sequentiallyPerformConcurrency . emptyFederationAPIAcesss . runInputConst cfg . interpretNowConst (UTCTime (ModifiedJulianDay 0) 0) . evalState [] + . evalState localBackend + . evalState [] + . miniEventInterpreter . inMemoryDeleteQueueInterpreter - . staticUserStoreInterpreter allUsers - . miniGalleyAPIAccess teamMember + . staticUserStoreInterpreter + . miniGalleyAPIAccess teamMember galleyConfigs . runUserSubsystem cfg runErrorUnsafe :: Exception e => InterpreterFor (Error e) r @@ -257,6 +312,9 @@ runErrorUnsafe action = do Left e -> error $ "Unexpected error: " <> displayException e Right x -> pure x +runAllErrorsUnsafe :: forall a. Sem AllErrors a -> a +runAllErrorsUnsafe = run . runErrorUnsafe . runErrorUnsafe + emptyFederationAPIAcesss :: InterpreterFor (FederationAPIAccess MiniFederationMonad) r emptyFederationAPIAcesss = interpret $ \case _ -> error "uninterpreted effect: FederationAPIAccess" @@ -278,11 +336,78 @@ miniFederationAPIAccess online = do RunFederatedBucketed _domain _rpc -> error "unimplemented: RunFederatedBucketed" IsFederationConfigured -> pure True -staticUserStoreInterpreter :: [StoredUser] -> InterpreterFor UserStore r -staticUserStoreInterpreter allUsers = interpret $ \case - GetUser uid -> pure $ find (\user -> user.id == uid) allUsers +getLocalUsers :: Member (State MiniBackend) r => Sem r [StoredUser] +getLocalUsers = gets (.users) + +modifyLocalUsers :: + Member (State MiniBackend) r => + ([StoredUser] -> Sem r [StoredUser]) -> + Sem r () +modifyLocalUsers f = do + us <- gets (.users) + us' <- f us + modify $ \b -> b {users = us'} + +staticUserStoreInterpreter :: + forall r. + Member (State MiniBackend) r => + InterpreterFor UserStore r +staticUserStoreInterpreter = interpret $ \case + GetUser uid -> find (\user -> user.id == uid) <$> getLocalUsers + UpdateUser uid update -> modifyLocalUsers (pure . fmap doUpdate) + where + doUpdate :: StoredUser -> StoredUser + doUpdate u = + if u.id == uid + then + maybe Imports.id setStoredUserAccentId update.accentId + . maybe Imports.id setStoredUserAssets update.assets + . maybe Imports.id setStoredUserPict update.pict + . maybe Imports.id setStoredUserName update.name + . maybe Imports.id setStoredUserLocale update.locale + . maybe Imports.id setStoredUserSupportedProtocols update.supportedProtocols + $ u + else u + UpdateUserHandleEither uid hUpdate -> runError $ modifyLocalUsers (traverse doUpdate) + where + doUpdate :: StoredUser -> Sem (Error StoredUserUpdateError : r) StoredUser + doUpdate u + | u.id == uid = do + handles <- mapMaybe (.handle) <$> gets (.users) + when + ( hUpdate.old /= Just hUpdate.new + && elem hUpdate.new handles + ) + $ throw StoredUserUpdateHandleExists + pure $ setStoredUserHandle hUpdate.new u + doUpdate u = pure u + DeleteUser user -> modifyLocalUsers $ \us -> + pure $ filter (\u -> u.id /= User.userId user) us + LookupHandle h -> miniBackendLookupHandle h + GlimpseHandle h -> miniBackendLookupHandle h + +miniBackendLookupHandle :: + Member (State MiniBackend) r => + Handle -> + Sem r (Maybe UserId) +miniBackendLookupHandle h = do + users <- gets (.users) + pure $ fmap (.id) (find ((== Just h) . (.handle)) users) -miniGalleyAPIAccess :: Maybe TeamMember -> InterpreterFor GalleyAPIAccess r -miniGalleyAPIAccess member = interpret $ \case +-- | interprets galley by statically returning the values passed +miniGalleyAPIAccess :: + -- | what to return when calling GetTeamMember + Maybe TeamMember -> + -- | what to return when calling GetAllFeatureConfigsForUser + AllFeatureConfigs -> + InterpreterFor GalleyAPIAccess r +miniGalleyAPIAccess member configs = interpret $ \case GetTeamMember _ _ -> pure member + GetAllFeatureConfigsForUser _ -> pure configs _ -> error "uninterpreted effect: GalleyAPIAccess" + +miniEventInterpreter :: + Member (State [MiniEvent]) r => + InterpreterFor UserEvents r +miniEventInterpreter = interpret \case + GenerateUserEvent uid _mconn e -> modify (MkMiniEvent uid e :) diff --git a/libs/wire-subsystems/src/Wire/StoredUser.hs b/libs/wire-subsystems/src/Wire/StoredUser.hs index b6fb20cb073..5986ef8a864 100644 --- a/libs/wire-subsystems/src/Wire/StoredUser.hs +++ b/libs/wire-subsystems/src/Wire/StoredUser.hs @@ -7,7 +7,9 @@ import Data.Handle import Data.Id import Data.Json.Util import Data.Qualified +import Data.Set qualified as S import Database.CQL.Protocol (Record (..), TupleType, recordInstance) +import GHC.Records import Imports import Wire.API.Provider.Service import Wire.API.User @@ -39,19 +41,43 @@ data StoredUser = StoredUser recordInstance ''StoredUser +setStoredUserName :: Name -> StoredUser -> StoredUser +setStoredUserName newName user = user {name = newName} + +setStoredUserSupportedProtocols :: Set BaseProtocolTag -> StoredUser -> StoredUser +setStoredUserSupportedProtocols newProtocols user = user {supportedProtocols = Just newProtocols} + +setStoredUserPict :: Pict -> StoredUser -> StoredUser +setStoredUserPict newPict user = user {pict = Just newPict} + +setStoredUserAssets :: [Asset] -> StoredUser -> StoredUser +setStoredUserAssets newAssets user = user {assets = Just newAssets} + +setStoredUserAccentId :: ColourId -> StoredUser -> StoredUser +setStoredUserAccentId newAccentId user = user {accentId = newAccentId} + +setStoredUserLocale :: Locale -> StoredUser -> StoredUser +setStoredUserLocale newLocale user = + user + { language = Just newLocale.lLanguage, + country = newLocale.lCountry + } + +setStoredUserHandle :: Handle -> StoredUser -> StoredUser +setStoredUserHandle newHandle user = user {handle = Just newHandle} + hasPendingInvitation :: StoredUser -> Bool hasPendingInvitation u = u.status == Just PendingInvitation mkUserFromStored :: Domain -> Locale -> StoredUser -> User mkUserFromStored domain defaultLocale storedUser = - let ident = toIdentity storedUser.activated storedUser.email storedUser.phone storedUser.ssoId - deleted = Just Deleted == storedUser.status + let deleted = Just Deleted == storedUser.status expiration = if storedUser.status == Just Ephemeral then storedUser.expires else Nothing loc = toLocale defaultLocale (storedUser.language, storedUser.country) svc = newServiceRef <$> storedUser.serviceId <*> storedUser.providerId in User { userQualifiedId = (Qualified storedUser.id domain), - userIdentity = ident, + userIdentity = storedUser.identity, userDisplayName = storedUser.name, userPict = (fromMaybe noPict storedUser.pict), userAssets = (fromMaybe [] storedUser.assets), @@ -62,8 +88,10 @@ mkUserFromStored domain defaultLocale storedUser = userHandle = storedUser.handle, userExpire = expiration, userTeam = storedUser.teamId, - userManagedBy = (fromMaybe ManagedByWire storedUser.managedBy), - userSupportedProtocols = (fromMaybe defSupportedProtocols storedUser.supportedProtocols) + userManagedBy = fromMaybe ManagedByWire storedUser.managedBy, + userSupportedProtocols = case storedUser.supportedProtocols of + Nothing -> defSupportedProtocols + Just ps -> if S.null ps then defSupportedProtocols else ps } toLocale :: Locale -> (Maybe Language, Maybe Country) -> Locale @@ -89,3 +117,9 @@ toIdentity True Nothing (Just p) Nothing = Just $! PhoneIdentity p toIdentity True email phone (Just ssoid) = Just $! SSOIdentity ssoid email phone toIdentity True Nothing Nothing Nothing = Nothing toIdentity False _ _ _ = Nothing + +instance HasField "identity" StoredUser (Maybe UserIdentity) where + getField user = toIdentity user.activated user.email user.phone user.ssoId + +instance HasField "locale" StoredUser (Maybe Locale) where + getField user = Locale <$> user.language <*> pure user.country diff --git a/libs/wire-subsystems/src/Wire/UserEvents.hs b/libs/wire-subsystems/src/Wire/UserEvents.hs new file mode 100644 index 00000000000..0288dee8d92 --- /dev/null +++ b/libs/wire-subsystems/src/Wire/UserEvents.hs @@ -0,0 +1,13 @@ +{-# LANGUAGE TemplateHaskell #-} + +module Wire.UserEvents where + +import Data.Id +import Imports +import Polysemy +import Wire.API.UserEvent + +data UserEvents m a where + GenerateUserEvent :: UserId -> Maybe ConnId -> UserEvent -> UserEvents m () + +makeSem ''UserEvents diff --git a/libs/wire-subsystems/src/Wire/UserStore.hs b/libs/wire-subsystems/src/Wire/UserStore.hs index 7e7d689d691..231c24df6d0 100644 --- a/libs/wire-subsystems/src/Wire/UserStore.hs +++ b/libs/wire-subsystems/src/Wire/UserStore.hs @@ -1,13 +1,68 @@ {-# LANGUAGE TemplateHaskell #-} +{-# OPTIONS_GHC -Wno-ambiguous-fields #-} module Wire.UserStore where +import Data.Default +import Data.Handle import Data.Id import Imports import Polysemy +import Polysemy.Error +import Wire.API.User +import Wire.Arbitrary import Wire.StoredUser +-- | Update of any "simple" attributes (ones that do not involve locking, like handle, or +-- validation protocols, like email). +-- +-- | see 'UserProfileUpdate'. +data StoredUserUpdate = MkStoredUserUpdate + { name :: Maybe Name, + pict :: Maybe Pict, + assets :: Maybe [Asset], + accentId :: Maybe ColourId, + locale :: Maybe Locale, + supportedProtocols :: Maybe (Set BaseProtocolTag) + } + deriving stock (Eq, Ord, Show, Generic) + deriving (Arbitrary) via GenericUniform StoredUserUpdate + +instance Default StoredUserUpdate where + def = MkStoredUserUpdate Nothing Nothing Nothing Nothing Nothing Nothing + +-- | Update user handle (this involves several http requests for locking the required handle). +-- The old/previous handle (for deciding idempotency). +data StoredUserHandleUpdate = MkStoredUserHandleUpdate + { old :: Maybe Handle, + new :: Handle + } + deriving stock (Eq, Ord, Show, Generic) + deriving (Arbitrary) via GenericUniform StoredUserHandleUpdate + +data StoredUserUpdateError = StoredUserUpdateHandleExists + +-- | Effect containing database logic around 'StoredUser'. (Example: claim handle lock is +-- database logic; validate handle is application logic.) data UserStore m a where GetUser :: UserId -> UserStore m (Maybe StoredUser) + UpdateUser :: UserId -> StoredUserUpdate -> UserStore m () + UpdateUserHandleEither :: UserId -> StoredUserHandleUpdate -> UserStore m (Either StoredUserUpdateError ()) + DeleteUser :: User -> UserStore m () + -- | This operation looks up a handle but is guaranteed to not give you stale locks. + -- It is potentially slower and less resilient than 'GlimpseHandle'. + LookupHandle :: Handle -> UserStore m (Maybe UserId) + -- | The interpretation for 'LookupHandle' and 'GlimpseHandle' + -- may differ in terms of how consistent they are. If that + -- matters for the interpretation, this operation may give you stale locks, + -- but is faster and more resilient. + GlimpseHandle :: Handle -> UserStore m (Maybe UserId) makeSem ''UserStore + +updateUserHandle :: + (Member UserStore r, Member (Error StoredUserUpdateError) r) => + UserId -> + StoredUserHandleUpdate -> + Sem r () +updateUserHandle uid update = either throw pure =<< updateUserHandleEither uid update diff --git a/libs/wire-subsystems/src/Wire/UserStore/Cassandra.hs b/libs/wire-subsystems/src/Wire/UserStore/Cassandra.hs index c1715d0aa3d..15a649b7f1d 100644 --- a/libs/wire-subsystems/src/Wire/UserStore/Cassandra.hs +++ b/libs/wire-subsystems/src/Wire/UserStore/Cassandra.hs @@ -1,28 +1,155 @@ -module Wire.UserStore.Cassandra where +module Wire.UserStore.Cassandra (interpretUserStoreCassandra) where import Cassandra +import Data.Handle import Data.Id import Database.CQL.Protocol import Imports import Polysemy import Polysemy.Embed +import Polysemy.Error +import Wire.API.User hiding (DeleteUser) import Wire.StoredUser import Wire.UserStore +import Wire.UserStore.Unique interpretUserStoreCassandra :: Member (Embed IO) r => ClientState -> InterpreterFor UserStore r interpretUserStoreCassandra casClient = interpret $ runEmbedded (runClient casClient) . \case GetUser uid -> getUserImpl uid + UpdateUser uid update -> embed $ updateUserImpl uid update + UpdateUserHandleEither uid update -> embed $ updateUserHandleEitherImpl uid update + DeleteUser user -> embed $ deleteUserImpl user + LookupHandle hdl -> embed $ lookupHandleImpl LocalQuorum hdl + GlimpseHandle hdl -> embed $ lookupHandleImpl One hdl getUserImpl :: Member (Embed Client) r => UserId -> Sem r (Maybe StoredUser) getUserImpl uid = embed $ do mUserTuple <- retry x1 $ query1 selectUser (params LocalQuorum (Identity uid)) pure $ asRecord <$> mUserTuple +updateUserImpl :: UserId -> StoredUserUpdate -> Client () +updateUserImpl uid update = + retry x5 $ batch do + -- PERFORMANCE(fisx): if a user changes 4 attributes with one request, the database will + -- be hit with one request for each attribute. this is probably fine, since this + -- operation is not heavily used. (also, the four operations are batched, which may or + -- may not help.) + setType BatchLogged + setConsistency LocalQuorum + for_ update.name \n -> addPrepQuery userDisplayNameUpdate (n, uid) + for_ update.pict \p -> addPrepQuery userPictUpdate (p, uid) + for_ update.assets \a -> addPrepQuery userAssetsUpdate (a, uid) + for_ update.locale \a -> addPrepQuery userLocaleUpdate (a.lLanguage, a.lCountry, uid) + for_ update.accentId \c -> addPrepQuery userAccentIdUpdate (c, uid) + for_ update.supportedProtocols \a -> addPrepQuery userSupportedProtocolsUpdate (a, uid) + +updateUserHandleEitherImpl :: UserId -> StoredUserHandleUpdate -> Client (Either StoredUserUpdateError ()) +updateUserHandleEitherImpl uid update = + runM $ runError do + claimed <- embed $ claimHandleImpl uid update.old update.new + unless claimed $ throw StoredUserUpdateHandleExists + +-- | Claim a new handle for an existing 'User': validate it, and in case of success, assign it +-- to user and mark it as taken. +claimHandleImpl :: UserId -> Maybe Handle -> Handle -> Client Bool +claimHandleImpl uid oldHandle newHandle = + isJust <$> do + owner <- lookupHandleImpl LocalQuorum newHandle + case owner of + Just uid' | uid /= uid' -> pure Nothing + _ -> do + let key = "@" <> fromHandle newHandle + withClaim uid key (30 # Minute) $ + do + -- Record ownership + retry x5 $ write handleInsert (params LocalQuorum (newHandle, uid)) + -- Update profile + result <- updateHandle uid newHandle + -- Free old handle (if it changed) + for_ (mfilter (/= newHandle) oldHandle) $ + freeHandleImpl uid + pure result + where + updateHandle :: UserId -> Handle -> Client () + updateHandle u h = retry x5 $ write userHandleUpdate (params LocalQuorum (h, u)) + +-- | Free a 'Handle', making it available to be claimed again. +freeHandleImpl :: UserId -> Handle -> Client () +freeHandleImpl uid h = do + mbHandleUid <- lookupHandleImpl LocalQuorum h + case mbHandleUid of + Just handleUid | handleUid == uid -> do + retry x5 $ write handleDelete (params LocalQuorum (Identity h)) + let key = "@" <> fromHandle h + deleteClaim uid key (30 # Minute) + _ -> pure () -- this shouldn't happen, the call side should always check that `h` and `uid` belong to the same account. + +-- | Sending an empty 'Handle' here causes C* to throw "Key may not be empty" +-- error. +-- +-- FUTUREWORK: This should ideally be tackled by hiding constructor for 'Handle' +-- and only allowing it to be parsed. +lookupHandleImpl :: Consistency -> Handle -> Client (Maybe UserId) +lookupHandleImpl consistencyLevel h = do + (runIdentity =<<) + <$> retry x1 (query1 handleSelect (params consistencyLevel (Identity h))) + +deleteUserImpl :: User -> Client () +deleteUserImpl user = do + for_ (userHandle user) \h -> + freeHandleImpl (userId user) h + retry x5 $ + write + updateUserToTombstone + ( params + LocalQuorum + (Deleted, Name "default", defaultAccentId, noPict, [], userId user) + ) + +-------------------------------------------------------------------------------- +-- Queries + selectUser :: PrepQuery R (Identity UserId) (TupleType StoredUser) selectUser = "SELECT id, name, picture, email, phone, sso_id, accent_id, assets, \ \activated, status, expires, language, country, provider, service, \ \handle, team, managed_by, supported_protocols \ \FROM user where id = ?" + +userDisplayNameUpdate :: PrepQuery W (Name, UserId) () +userDisplayNameUpdate = "UPDATE user SET name = ? WHERE id = ?" + +userPictUpdate :: PrepQuery W (Pict, UserId) () +userPictUpdate = "UPDATE user SET picture = ? WHERE id = ?" + +userAssetsUpdate :: PrepQuery W ([Asset], UserId) () +userAssetsUpdate = "UPDATE user SET assets = ? WHERE id = ?" + +userAccentIdUpdate :: PrepQuery W (ColourId, UserId) () +userAccentIdUpdate = "UPDATE user SET accent_id = ? WHERE id = ?" + +userLocaleUpdate :: PrepQuery W (Language, Maybe Country, UserId) () +userLocaleUpdate = "UPDATE user SET language = ?, country = ? WHERE id = ?" + +userSupportedProtocolsUpdate :: PrepQuery W (Imports.Set BaseProtocolTag, UserId) () +userSupportedProtocolsUpdate = "UPDATE user SET supported_protocols = ? WHERE id = ?" + +handleInsert :: PrepQuery W (Handle, UserId) () +handleInsert = "INSERT INTO user_handle (handle, user) VALUES (?, ?)" + +handleSelect :: PrepQuery R (Identity Handle) (Identity (Maybe UserId)) +handleSelect = "SELECT user FROM user_handle WHERE handle = ?" + +handleDelete :: PrepQuery W (Identity Handle) () +handleDelete = "DELETE FROM user_handle WHERE handle = ?" + +userHandleUpdate :: PrepQuery W (Handle, UserId) () +userHandleUpdate = "UPDATE user SET handle = ? WHERE id = ?" + +updateUserToTombstone :: PrepQuery W (AccountStatus, Name, ColourId, Pict, [Asset], UserId) () +updateUserToTombstone = + "UPDATE user SET status = ?, name = ?,\ + \ accent_id = ?, picture = ?, assets = ?, handle = null, country = null,\ + \ language = null, email = null, phone = null, sso_id = null WHERE id = ?" diff --git a/services/brig/src/Brig/Unique.hs b/libs/wire-subsystems/src/Wire/UserStore/Unique.hs similarity index 92% rename from services/brig/src/Brig/Unique.hs rename to libs/wire-subsystems/src/Wire/UserStore/Unique.hs index 58c95630a8a..f85b26fd4a0 100644 --- a/services/brig/src/Brig/Unique.hs +++ b/libs/wire-subsystems/src/Wire/UserStore/Unique.hs @@ -17,7 +17,7 @@ -- | Temporary exclusive claims on 'Text'ual values which may be subject -- to contention, i.e. where strong guarantees on uniqueness are desired. -module Brig.Unique +module Wire.UserStore.Unique ( withClaim, deleteClaim, lookupClaims, @@ -43,7 +43,6 @@ import Imports -- and is responsible for turning the temporary claim into permanent -- ownership, if desired. withClaim :: - MonadClient m => -- | The 'Id' associated with the claim. Id a -> -- | The value on which to acquire the claim. @@ -51,11 +50,11 @@ withClaim :: -- | The minimum timeout (i.e. duration) of the claim. Timeout -> -- | The computation to run with a successful claim. - IO b -> + Client b -> -- | 'Just b' if the claim was successful and the 'IO' -- computation completed within the given timeout. - m (Maybe b) -withClaim u v t io = do + Client (Maybe b) +withClaim u v t act = do claims <- lookupClaims v case claims of [] -> claim -- Free @@ -68,13 +67,14 @@ withClaim u v t io = do retry x5 $ write upsertQuery $ params LocalQuorum (ttl * 2, C.Set [u], v) claimed <- (== [u]) <$> lookupClaims v if claimed - then liftIO $ timeout (fromIntegral ttl # Second) io + then do + act' <- clientToIO act + liftIO $ timeout (fromIntegral ttl # Second) act' else pure Nothing upsertQuery :: PrepQuery W (Int32, C.Set (Id a), Text) () upsertQuery = "UPDATE unique_claims USING TTL ? SET claims = claims + ? WHERE value = ?" deleteClaim :: - MonadClient m => -- | The 'Id' associated with the claim. Id a -> -- | The value on which to acquire the claim. @@ -84,13 +84,13 @@ deleteClaim :: -- never use), so removing a claim is an update operation on the database. -- Therefore, we reset the TTL the same way we reset it in 'withClaim'.) Timeout -> - m () + Client () deleteClaim u v t = do let ttl = max minTtl (fromIntegral (t #> Second)) retry x5 $ write cql $ params LocalQuorum (ttl * 2, C.Set [u], v) where cql :: PrepQuery W (Int32, C.Set (Id a), Text) () - cql = {- `IF EXISTS`, but that requires benchmarking -} "UPDATE unique_claims USING TTL ? SET claims = claims - ? WHERE value = ?" + cql = "UPDATE unique_claims USING TTL ? SET claims = claims - ? WHERE value = ?" -- | Lookup the current claims on a value. lookupClaims :: MonadClient m => Text -> m [Id a] @@ -103,6 +103,11 @@ lookupClaims v = cql :: PrepQuery R (Identity Text) (Identity (C.Set (Id a))) cql = "SELECT claims FROM unique_claims WHERE value = ?" +clientToIO :: Client a -> Client (IO a) +clientToIO act = do + s <- ask + pure $ runClient s act + minTtl :: Int32 minTtl = 60 -- Seconds diff --git a/libs/wire-subsystems/src/Wire/UserSubsystem.hs b/libs/wire-subsystems/src/Wire/UserSubsystem.hs index ae344ec3361..7c7df86d92b 100644 --- a/libs/wire-subsystems/src/Wire/UserSubsystem.hs +++ b/libs/wire-subsystems/src/Wire/UserSubsystem.hs @@ -2,21 +2,107 @@ module Wire.UserSubsystem where +import Data.Default +import Data.Handle (Handle) import Data.Id import Data.Qualified import Imports +import Network.Wai.Utilities qualified as Wai import Polysemy +import Wire.API.Error +import Wire.API.Error.Brig qualified as E import Wire.API.Federation.Error import Wire.API.User +import Wire.Arbitrary + +-- | All errors that are thrown by the user subsystem are subsumed under this sum type. +data UserSubsystemError + = -- | user is managed by scim or e2ei is enabled + -- FUTUREWORK(mangoiv): the name should probably resemble that + UserSubsystemDisplayNameManagedByScim + | UserSubsystemHandleManagedByScim + | UserSubsystemLocaleManagedByScim + | UserSubsystemNoIdentity + | UserSubsystemHandleExists + | UserSubsystemInvalidHandle + | UserSubsystemProfileNotFound + deriving (Eq, Show) + +userSubsystemErrorToWai :: UserSubsystemError -> Wai.Error +userSubsystemErrorToWai = + dynErrorToWai . \case + UserSubsystemProfileNotFound -> dynError @(MapError E.UserNotFound) + UserSubsystemDisplayNameManagedByScim -> dynError @(MapError E.NameManagedByScim) + UserSubsystemLocaleManagedByScim -> dynError @(MapError E.LocaleManagedByScim) + UserSubsystemNoIdentity -> dynError @(MapError E.NoIdentity) + UserSubsystemHandleExists -> dynError @(MapError E.HandleExists) + UserSubsystemInvalidHandle -> dynError @(MapError E.InvalidHandle) + UserSubsystemHandleManagedByScim -> dynError @(MapError E.HandleManagedByScim) + +instance Exception UserSubsystemError + +-- | Who is performing this update operation? (Single source of truth: users managed by SCIM +-- can't be updated by clients and vice versa.) +data UpdateOriginType + = -- | Call originates from the SCIM api in spar. + UpdateOriginScim + | -- | Call originates from wire client (mobile, web, or team-management). + UpdateOriginWireClient + deriving (Show, Eq, Ord, Generic) + deriving (Arbitrary) via GenericUniform UpdateOriginType + +-- | Simple updates (as opposed to, eg., handle, where we need to manage locks). +-- +-- This is isomorphic to 'StoredUserUpdate', but we keep the two types separate because they +-- belong to different abstractions / levels (UserSubsystem vs. UserStore), and they may +-- change independently in the future ('UserStoreUpdate' may grow more fields for other +-- operations). +data UserProfileUpdate = MkUserProfileUpdate + { name :: Maybe Name, + pict :: Maybe Pict, -- DEPRECATED + assets :: Maybe [Asset], + accentId :: Maybe ColourId, + locale :: Maybe Locale, + supportedProtocols :: Maybe (Set BaseProtocolTag) + } + deriving stock (Eq, Ord, Show, Generic) + deriving (Arbitrary) via GenericUniform UserProfileUpdate + +instance Default UserProfileUpdate where + def = + MkUserProfileUpdate + { name = Nothing, + pict = Nothing, -- DEPRECATED + assets = Nothing, + accentId = Nothing, + locale = Nothing, + supportedProtocols = Nothing + } data UserSubsystem m a where -- | First arg is for authorization only. GetUserProfiles :: Local UserId -> [Qualified UserId] -> UserSubsystem m [UserProfile] -- | Sometimes we don't have any identity of a requesting user, and local profiles are public. GetLocalUserProfiles :: Local [UserId] -> UserSubsystem m [UserProfile] + -- | Self profile contains things not present in Profile. + GetSelfProfile :: Local UserId -> UserSubsystem m (Maybe SelfProfile) -- | These give us partial success and hide concurrency in the interpreter. -- FUTUREWORK: it would be better to return errors as `Map Domain FederationError`, but would clients like that? GetUserProfilesWithErrors :: Local UserId -> [Qualified UserId] -> UserSubsystem m ([(Qualified UserId, FederationError)], [UserProfile]) + -- | Simple updates (as opposed to, eg., handle, where we need to manage locks). Empty fields are ignored (not deleted). + UpdateUserProfile :: Local UserId -> Maybe ConnId -> UpdateOriginType -> UserProfileUpdate -> UserSubsystem m () + -- | parse and lookup a handle, return what the operation has found + CheckHandle :: Text {- use Handle here? -} -> UserSubsystem m CheckHandleResp + -- | checks a number of 'Handle's for availability and returns at most 'Word' amount of them + CheckHandles :: [Handle] -> Word -> UserSubsystem m [Handle] + -- | parses a handle, this may fail so it's effectful + UpdateHandle :: Local UserId -> Maybe ConnId -> UpdateOriginType -> Text {- use Handle here? -} -> UserSubsystem m () + +-- | the return type of 'CheckHandle' +data CheckHandleResp + = CheckHandleFound + | CheckHandleNotFound + deriving stock (Eq, Ord, Show) makeSem ''UserSubsystem @@ -27,3 +113,6 @@ getUserProfile luid targetUser = getLocalUserProfile :: Member UserSubsystem r => Local UserId -> Sem r (Maybe UserProfile) getLocalUserProfile targetUser = listToMaybe <$> getLocalUserProfiles ((: []) <$> targetUser) + +updateSupportedProtocols :: Member UserSubsystem r => Local UserId -> UpdateOriginType -> Set BaseProtocolTag -> Sem r () +updateSupportedProtocols uid mb prots = updateUserProfile uid Nothing mb (def {supportedProtocols = Just prots}) diff --git a/services/brig/src/Brig/User/Handle/Blacklist.hs b/libs/wire-subsystems/src/Wire/UserSubsystem/HandleBlacklist.hs similarity index 54% rename from services/brig/src/Brig/User/Handle/Blacklist.hs rename to libs/wire-subsystems/src/Wire/UserSubsystem/HandleBlacklist.hs index 2f51a8cfa01..e6ac6fba97a 100644 --- a/services/brig/src/Brig/User/Handle/Blacklist.hs +++ b/libs/wire-subsystems/src/Wire/UserSubsystem/HandleBlacklist.hs @@ -1,21 +1,4 @@ --- This file is part of the Wire Server implementation. --- --- Copyright (C) 2022 Wire Swiss GmbH --- --- This program is free software: you can redistribute it and/or modify it under --- the terms of the GNU Affero General Public License as published by the Free --- Software Foundation, either version 3 of the License, or (at your option) any --- later version. --- --- This program is distributed in the hope that it will be useful, but WITHOUT --- ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS --- FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for more --- details. --- --- You should have received a copy of the GNU Affero General Public License along --- with this program. If not, see . - -module Brig.User.Handle.Blacklist +module Wire.UserSubsystem.HandleBlacklist ( isBlacklistedHandle, ) where diff --git a/libs/wire-subsystems/src/Wire/UserSubsystem/Interpreter.hs b/libs/wire-subsystems/src/Wire/UserSubsystem/Interpreter.hs index 948d4689b24..688818f6a99 100644 --- a/libs/wire-subsystems/src/Wire/UserSubsystem/Interpreter.hs +++ b/libs/wire-subsystems/src/Wire/UserSubsystem/Interpreter.hs @@ -1,3 +1,7 @@ +{-# LANGUAGE PartialTypeSignatures #-} +{-# LANGUAGE RecordWildCards #-} +{-# OPTIONS_GHC -Wno-partial-type-signatures #-} + module Wire.UserSubsystem.Interpreter ( runUserSubsystem, UserSubsystemConfig (..), @@ -7,6 +11,8 @@ where import Control.Lens (view) import Control.Monad.Trans.Maybe import Data.Either.Extra +import Data.Handle (Handle) +import Data.Handle qualified as Handle import Data.Id import Data.Json.Util import Data.LegalHold @@ -19,8 +25,11 @@ import Polysemy.Input import Servant.Client.Core import Wire.API.Federation.API import Wire.API.Federation.Error -import Wire.API.Team.Member +import Wire.API.Team.Feature +import Wire.API.Team.Member hiding (userId) import Wire.API.User +import Wire.API.UserEvent +import Wire.Arbitrary import Wire.DeleteQueue import Wire.FederationAPIAccess import Wire.GalleyAPIAccess @@ -28,21 +37,29 @@ import Wire.Sem.Concurrency import Wire.Sem.Now (Now) import Wire.Sem.Now qualified as Now import Wire.StoredUser -import Wire.UserStore -import Wire.UserSubsystem (UserSubsystem (..)) +import Wire.UserEvents +import Wire.UserStore as US +import Wire.UserSubsystem +import Wire.UserSubsystem.HandleBlacklist data UserSubsystemConfig = UserSubsystemConfig { emailVisibilityConfig :: EmailVisibilityConfig, defaultLocale :: Locale } + deriving (Show) + +instance Arbitrary UserSubsystemConfig where + arbitrary = UserSubsystemConfig <$> arbitrary <*> arbitrary runUserSubsystem :: ( Member GalleyAPIAccess r, Member UserStore r, Member (Concurrency 'Unsafe) r, -- FUTUREWORK: subsystems should implement concurrency inside interpreters, not depend on this dangerous effect. Member (Error FederationError) r, + Member (Error UserSubsystemError) r, Member (FederationAPIAccess fedM) r, Member DeleteQueue r, + Member UserEvents r, Member Now r, RunClient (fedM 'Brig), FederationMonad fedM, @@ -50,10 +67,33 @@ runUserSubsystem :: ) => UserSubsystemConfig -> InterpreterFor UserSubsystem r -runUserSubsystem cfg = interpret $ \case - GetUserProfiles self others -> runInputConst cfg $ getUserProfilesImpl self others - GetLocalUserProfiles others -> runInputConst cfg $ getLocalUserProfilesImpl others - GetUserProfilesWithErrors self others -> runInputConst cfg $ getUserProfilesWithErrorsImpl self others +runUserSubsystem cfg = runInputConst cfg . interpretUserSubsystem . raiseUnder + +interpretUserSubsystem :: + ( Member GalleyAPIAccess r, + Member UserStore r, + Member (Concurrency 'Unsafe) r, + Member (Error FederationError) r, + Member (Error UserSubsystemError) r, + Member (FederationAPIAccess fedM) r, + Member (Input UserSubsystemConfig) r, + Member DeleteQueue r, + Member UserEvents r, + Member Now r, + RunClient (fedM 'Brig), + FederationMonad fedM, + Typeable fedM + ) => + InterpreterFor UserSubsystem r +interpretUserSubsystem = interpret \case + GetUserProfiles self others -> getUserProfilesImpl self others + GetLocalUserProfiles others -> getLocalUserProfilesImpl others + GetSelfProfile self -> getSelfProfileImpl self + GetUserProfilesWithErrors self others -> getUserProfilesWithErrorsImpl self others + UpdateUserProfile self mconn mb update -> updateUserProfileImpl self mconn mb update + CheckHandle uhandle -> checkHandleImpl uhandle + CheckHandles hdls cnt -> checkHandlesImpl hdls cnt + UpdateHandle uid mconn mb uhandle -> updateHandleImpl uid mconn mb uhandle -- | Obtain user profiles for a list of users as they can be seen by -- a given user 'self'. If 'self' is an unknown 'UserId', return '[]'. @@ -149,7 +189,7 @@ getUserProfilesLocalPart requestingUser luids = do <$> traverse getRequestingUserInfo requestingUser -- FUTUREWORK: (in the interpreters where it makes sense) pull paginated lists from the DB, -- not just single rows. - catMaybes <$> traverse (getLocalUserProfile emailVisibilityConfigWithViewer) (sequence luids) + catMaybes <$> traverse (getLocalUserProfileImpl emailVisibilityConfigWithViewer) (sequence luids) where getRequestingUserInfo :: Local UserId -> Sem r (Maybe (TeamId, TeamMember)) getRequestingUserInfo self = do @@ -165,7 +205,7 @@ getUserProfilesLocalPart requestingUser luids = do Nothing -> pure Nothing Just tid -> (tid,) <$$> getTeamMember (tUnqualified self) tid -getLocalUserProfile :: +getLocalUserProfileImpl :: forall r. ( Member UserStore r, Member GalleyAPIAccess r, @@ -176,7 +216,7 @@ getLocalUserProfile :: EmailVisibilityConfigWithViewer -> Local UserId -> Sem r (Maybe UserProfile) -getLocalUserProfile emailVisibilityConfigWithViewer luid = do +getLocalUserProfileImpl emailVisibilityConfigWithViewer luid = do let domain = tDomain luid locale <- inputs defaultLocale runMaybeT $ do @@ -190,6 +230,35 @@ getLocalUserProfile emailVisibilityConfigWithViewer luid = do lift $ deleteLocalIfExpired user pure usrProfile +getSelfProfileImpl :: + ( Member (Input UserSubsystemConfig) r, + Member UserStore r, + Member GalleyAPIAccess r + ) => + Local UserId -> + Sem r (Maybe SelfProfile) +getSelfProfileImpl self = do + defLocale <- inputs defaultLocale + mStoredUser <- getUser (tUnqualified self) + mHackedUser <- traverse hackForBlockingHandleChangeForE2EIdTeams mStoredUser + let mUser = mkUserFromStored (tDomain self) defLocale <$> mHackedUser + pure (SelfProfile <$> mUser) + where + -- \| This is a hack! + -- + -- Background: + -- - https://wearezeta.atlassian.net/browse/WPB-6189. + -- - comments in `testUpdateHandle` in `/integration`. + -- + -- FUTUREWORK: figure out a better way for clients to detect E2EId (V6?) + hackForBlockingHandleChangeForE2EIdTeams :: Member GalleyAPIAccess r => StoredUser -> Sem r StoredUser + hackForBlockingHandleChangeForE2EIdTeams user = do + e2eid <- hasE2EId user + pure $ + if e2eid && isJust user.handle + then user {managedBy = Just ManagedByScim} + else user + -- | ephemeral users past their expiry date are queued for deletion deleteLocalIfExpired :: forall r. (Member DeleteQueue r, Member Now r) => User -> Sem r () deleteLocalIfExpired user = @@ -238,3 +307,147 @@ getUserProfilesWithErrorsImpl self others = do renderBucketError :: (FederationError, Qualified [UserId]) -> [(Qualified UserId, FederationError)] renderBucketError (err, qlist) = (,err) . (flip Qualified (qDomain qlist)) <$> qUnqualified qlist + +-- | Some fields cannot be overwritten by clients for scim-managed users; some others if e2eid +-- is used. If a client attempts to overwrite any of these, throw `UserSubsystem*ManagedByScim`. +guardLockedFields :: + ( Member (Error UserSubsystemError) r, + Member GalleyAPIAccess r + ) => + StoredUser -> + UpdateOriginType -> + UserProfileUpdate -> + Sem r () +guardLockedFields user updateOrigin (MkUserProfileUpdate {..}) = do + let idempName = isNothing name || name == Just user.name + idempLocale = isNothing locale || locale == user.locale + scim = updateOrigin == UpdateOriginWireClient && user.managedBy == Just ManagedByScim + e2eid <- hasE2EId user + when ((scim || e2eid) && not idempName) do + throw UserSubsystemDisplayNameManagedByScim + when (scim {- e2eid does not matter, it's not part of the e2eid cert! -} && not idempLocale) do + throw UserSubsystemLocaleManagedByScim + +guardLockedHandleField :: + ( Member GalleyAPIAccess r, + Member (Error UserSubsystemError) r + ) => + StoredUser -> + UpdateOriginType -> + Handle -> + Sem r () +guardLockedHandleField user updateOrigin handle = do + let idemp = Just handle == user.handle + scim = updateOrigin == UpdateOriginWireClient && user.managedBy == Just ManagedByScim + hasHandle = isJust user.handle + e2eid <- hasE2EId user + when ((scim || (e2eid && hasHandle)) && not idemp) do + throw UserSubsystemHandleManagedByScim + +updateUserProfileImpl :: + ( Member UserStore r, + Member (Error UserSubsystemError) r, + Member UserEvents r, + Member GalleyAPIAccess r + ) => + Local UserId -> + Maybe ConnId -> + UpdateOriginType -> + UserProfileUpdate -> + Sem r () +updateUserProfileImpl (tUnqualified -> uid) mconn updateOrigin update = do + user <- getUser uid >>= note UserSubsystemProfileNotFound + guardLockedFields user updateOrigin update + mapError (\StoredUserUpdateHandleExists -> UserSubsystemHandleExists) $ + updateUser uid (storedUserUpdate update) + generateUserEvent uid mconn (mkProfileUpdateEvent uid update) + +storedUserUpdate :: UserProfileUpdate -> StoredUserUpdate +storedUserUpdate update = + MkStoredUserUpdate + { name = update.name, + pict = update.pict, + assets = update.assets, + accentId = update.accentId, + locale = update.locale, + supportedProtocols = update.supportedProtocols + } + +mkProfileUpdateEvent :: UserId -> UserProfileUpdate -> UserEvent +mkProfileUpdateEvent uid update = + UserUpdated $ + (emptyUserUpdatedData uid) + { eupName = update.name, + eupPict = update.pict, + eupAccentId = update.accentId, + eupAssets = update.assets, + eupLocale = update.locale, + eupSupportedProtocols = update.supportedProtocols + } + +mkProfileUpdateHandleEvent :: UserId -> Handle -> UserEvent +mkProfileUpdateHandleEvent uid handle = + UserUpdated $ (emptyUserUpdatedData uid) {eupHandle = Just handle} + +-------------------------------------------------------------------------------- +-- Check Handle + +updateHandleImpl :: + ( Member (Error UserSubsystemError) r, + Member GalleyAPIAccess r, + Member UserEvents r, + Member UserStore r + ) => + Local UserId -> + Maybe ConnId -> + UpdateOriginType -> + Text -> + Sem r () +updateHandleImpl (tUnqualified -> uid) mconn updateOrigin uhandle = do + newHandle :: Handle <- note UserSubsystemInvalidHandle $ Handle.parseHandle uhandle + when (isBlacklistedHandle newHandle) $ + throw UserSubsystemInvalidHandle + user <- getUser uid >>= note UserSubsystemNoIdentity + guardLockedHandleField user updateOrigin newHandle + when (isNothing user.identity) $ + throw UserSubsystemNoIdentity + mapError (\StoredUserUpdateHandleExists -> UserSubsystemHandleExists) $ + US.updateUserHandle uid (MkStoredUserHandleUpdate user.handle newHandle) + generateUserEvent uid mconn (mkProfileUpdateHandleEvent uid newHandle) + +checkHandleImpl :: (Member (Error UserSubsystemError) r, Member UserStore r) => Text -> Sem r CheckHandleResp +checkHandleImpl uhandle = do + xhandle :: Handle <- Handle.parseHandle uhandle & maybe (throw UserSubsystemInvalidHandle) pure + when (isBlacklistedHandle xhandle) $ + throw UserSubsystemInvalidHandle + owner <- lookupHandle xhandle + if isJust owner + then -- Handle is taken (=> getHandleInfo will return 200) + pure CheckHandleFound + else -- Handle is free and can be taken + pure CheckHandleNotFound + +hasE2EId :: Member GalleyAPIAccess r => StoredUser -> Sem r Bool +hasE2EId user = + wsStatus . afcMlsE2EId <$> getAllFeatureConfigsForUser (Just user.id) <&> \case + FeatureStatusEnabled -> True + FeatureStatusDisabled -> False + +-------------------------------------------------------------------------------- +-- Check Handles + +-- | checks for handles @check@ to be available and returns +-- at maximum @num@ of them +checkHandlesImpl :: _ => [Handle] -> Word -> Sem r [Handle] +checkHandlesImpl check num = reverse <$> collectFree [] check num + where + collectFree free _ 0 = pure free + collectFree free [] _ = pure free + collectFree free (h : hs) n = + if isBlacklistedHandle h + then collectFree free hs n + else do + owner <- glimpseHandle h + case owner of + Nothing -> collectFree (h : free) hs (n - 1) + Just _ -> collectFree free hs n diff --git a/libs/wire-subsystems/test/unit/Wire/UserSubsystem/InterpreterSpec.hs b/libs/wire-subsystems/test/unit/Wire/UserSubsystem/InterpreterSpec.hs index 1e2f399b658..dd8b97ed592 100644 --- a/libs/wire-subsystems/test/unit/Wire/UserSubsystem/InterpreterSpec.hs +++ b/libs/wire-subsystems/test/unit/Wire/UserSubsystem/InterpreterSpec.hs @@ -1,27 +1,37 @@ {-# LANGUAGE OverloadedLists #-} +{-# OPTIONS_GHC -Wno-ambiguous-fields -Wno-incomplete-uni-patterns #-} module Wire.UserSubsystem.InterpreterSpec (spec) where +import Control.Lens.At () import Data.Bifunctor (first) import Data.Coerce import Data.Default (Default (def)) import Data.Domain +import Data.Handle import Data.Id import Data.LegalHold (defUserLegalHoldStatus) import Data.Qualified import Data.Set qualified as S import Imports +import Polysemy +import Polysemy.Error +import Polysemy.Internal +import Polysemy.State import Test.Hspec import Test.Hspec.QuickCheck import Test.QuickCheck import Wire.API.Federation.Error +import Wire.API.Team.Feature import Wire.API.Team.Member import Wire.API.Team.Permission import Wire.API.User hiding (DeleteUser) +import Wire.API.UserEvent import Wire.MiniBackend -import Wire.StoredUser -import Wire.UserSubsystem -import Wire.UserSubsystem.Interpreter +import Wire.StoredUser as SU +import Wire.UserSubsystem as US +import Wire.UserSubsystem.HandleBlacklist +import Wire.UserSubsystem.Interpreter (UserSubsystemConfig (..)) spec :: Spec spec = describe "UserSubsystem.Interpreter" do @@ -34,16 +44,15 @@ spec = describe "UserSubsystem.Interpreter" do viewer = viewerTeam {teamId = Nothing} -- Having teams adds complications in email visibility, -- all that stuff is tested in [without federation] tests - localTargetUsers = - S.fromList $ - map (\user -> (coerce user) {teamId = Nothing}) localTargetUsersNotPending + localTargetUsers = map (\user -> (coerce user) {teamId = Nothing}) localTargetUsersNotPending federation = [(remoteDomain1, remoteBackend1), (remoteDomain2, remoteBackend2)] - mkUserIds domain = map (flip Qualified domain . (.id)) . S.toList + mkUserIds domain = map (flip Qualified domain . (.id)) localTargets = mkUserIds localDomain localTargetUsers target1 = mkUserIds remoteDomain1 targetUsers1 target2 = mkUserIds remoteDomain2 targetUsers2 + localBackend = def {users = [viewer] <> localTargetUsers} retrievedProfiles = - runFederationStack ([viewer] <> S.toList localTargetUsers) federation Nothing (UserSubsystemConfig visibility miniLocale) $ + runFederationStack localBackend federation Nothing (UserSubsystemConfig visibility miniLocale) $ getUserProfiles (toLocalUnsafe localDomain viewer.id) (localTargets <> target1 <> target2) @@ -52,7 +61,7 @@ spec = describe "UserSubsystem.Interpreter" do Nothing (mkUserFromStored domain miniLocale targetUser) defUserLegalHoldStatus - | targetUser <- S.toList users + | targetUser <- users ] expectedLocalProfiles = mkExpectedProfiles localDomain localTargetUsers expectedProfiles1 = mkExpectedProfiles remoteDomain1 targetUsers1 @@ -63,23 +72,27 @@ spec = describe "UserSubsystem.Interpreter" do === sortOn (.profileQualifiedId) expectedProfiles prop "fails when a backend is offline or returns an error" $ - \viewer onlineTargetUsers (offlineTargetUsers :: Set StoredUser) visibility localDomain onlineDomain (offlineDomain :: Domain) -> do + \viewer onlineTargetUsers (offlineTargetUsers :: [StoredUser]) visibility localDomain onlineDomain (offlineDomain :: Domain) -> do let onlineRemoteBackend = def {users = onlineTargetUsers} online = [(onlineDomain, onlineRemoteBackend)] - mkUserIds domain users = map (flip Qualified domain . (.id)) (S.toList users) + mkUserIds domain users = map (flip Qualified domain . (.id)) users onlineUsers = mkUserIds onlineDomain onlineTargetUsers offlineUsers = mkUserIds offlineDomain offlineTargetUsers config = UserSubsystemConfig visibility miniLocale - + localBackend = def {users = [viewer]} result = - runFederationStackEither [viewer] online Nothing config $ - getUserProfiles + run + . runErrorUnsafe @UserSubsystemError + . runError @FederationError + . interpretFederationStack localBackend online Nothing config + $ getUserProfiles (toLocalUnsafe localDomain viewer.id) (onlineUsers <> offlineUsers) - localDomain /= offlineDomain && offlineTargetUsers /= [] ==> + + localDomain /= offlineDomain && not (null offlineTargetUsers) ==> -- The FederationError doesn't have an instance -- for Eq because of dependency on HTTP2Error - first (displayException) result + first displayException result === Left (displayException (FederationUnexpectedError "RunFederatedEither")) describe "[without federation]" do @@ -87,7 +100,7 @@ spec = describe "UserSubsystem.Interpreter" do \viewer targetUserIds visibility domain locale -> let config = UserSubsystemConfig visibility locale retrievedProfiles = - runNoFederationStack [] Nothing config $ + runNoFederationStack def Nothing config $ getUserProfiles (toLocalUnsafe domain viewer) (map (`Qualified` domain) targetUserIds) in retrievedProfiles === [] @@ -96,8 +109,9 @@ spec = describe "UserSubsystem.Interpreter" do let teamMember = mkTeamMember viewer.id fullPermissions Nothing defUserLegalHoldStatus targetUser = if sameTeam then targetUserNoTeam {teamId = viewer.teamId} else targetUserNoTeam config = UserSubsystemConfig visibility locale + localBackend = def {users = [targetUser, viewer]} retrievedProfiles = - runNoFederationStack [targetUser, viewer] (Just teamMember) config $ + runNoFederationStack localBackend (Just teamMember) config $ getUserProfiles (toLocalUnsafe domain viewer.id) [Qualified targetUser.id domain] in retrievedProfiles === [ mkUserProfile @@ -111,8 +125,9 @@ spec = describe "UserSubsystem.Interpreter" do let teamMember = mkTeamMember viewer.id fullPermissions Nothing defUserLegalHoldStatus targetUser = if sameTeam then targetUserNoTeam {teamId = viewer.teamId} else targetUserNoTeam config = UserSubsystemConfig visibility locale + localBackend = def {users = [targetUser, viewer]} retrievedProfile = - runNoFederationStack [targetUser, viewer] (Just teamMember) config $ + runNoFederationStack localBackend (Just teamMember) config $ getUserProfiles (toLocalUnsafe domain viewer.id) [Qualified targetUser.id domain] in retrievedProfile === [ mkUserProfile @@ -125,8 +140,9 @@ spec = describe "UserSubsystem.Interpreter" do \viewer (PendingStoredUser targetUser) visibility domain locale -> let teamMember = mkTeamMember viewer.id fullPermissions Nothing defUserLegalHoldStatus config = UserSubsystemConfig visibility locale + localBackend = def {users = [targetUser, viewer]} retrievedProfile = - runNoFederationStack [targetUser, viewer] (Just teamMember) config $ + runNoFederationStack localBackend (Just teamMember) config $ getLocalUserProfiles (toLocalUnsafe domain [targetUser.id]) in retrievedProfile === [] @@ -136,20 +152,17 @@ spec = describe "UserSubsystem.Interpreter" do let remoteBackend = def {users = targetUsers} federation = [(remoteDomain, remoteBackend)] config = UserSubsystemConfig visibility miniLocale + localBackend = def {users = [viewer]} retrievedProfilesWithErrors :: ([(Qualified UserId, FederationError)], [UserProfile]) = - runFederationStack [viewer] federation Nothing config $ + runFederationStack localBackend federation Nothing config $ getUserProfilesWithErrors (toLocalUnsafe domain viewer.id) - ( map (flip Qualified remoteDomain . (.id)) $ - S.toList targetUsers - ) + (map (flip Qualified remoteDomain . (.id)) targetUsers) retrievedProfiles :: [UserProfile] = - runFederationStack [viewer] federation Nothing config $ + runFederationStack localBackend federation Nothing config $ getUserProfiles (toLocalUnsafe domain viewer.id) - ( map (flip Qualified remoteDomain . (.id)) $ - S.toList targetUsers - ) + (map (flip Qualified remoteDomain . (.id)) targetUsers) remoteDomain /= domain ==> counterexample ("Retrieved profiles with errors: " <> show retrievedProfilesWithErrors) do length (fst retrievedProfilesWithErrors) === 0 @@ -160,8 +173,9 @@ spec = describe "UserSubsystem.Interpreter" do \viewer (targetUsers :: Set StoredUser) visibility domain remoteDomain -> do let online = mempty config = UserSubsystemConfig visibility miniLocale + localBackend = def {users = [viewer]} retrievedProfilesWithErrors :: ([(Qualified UserId, FederationError)], [UserProfile]) = - runFederationStack [viewer] online Nothing config $ + runFederationStack localBackend online Nothing config $ getUserProfilesWithErrors (toLocalUnsafe domain viewer.id) ( map (flip Qualified remoteDomain . (.id)) $ @@ -176,14 +190,261 @@ spec = describe "UserSubsystem.Interpreter" do let remoteBackendA = def {users = targetUsers} online = [(remoteDomainA, remoteBackendA)] allDomains = [domain, remoteDomainA, remoteDomainB] - remoteAUsers = map (flip Qualified remoteDomainA . (.id)) (S.toList targetUsers) - remoteBUsers = map (flip Qualified remoteDomainB . (.id)) (S.toList targetUsers) + remoteAUsers = map (flip Qualified remoteDomainA . (.id)) targetUsers + remoteBUsers = map (flip Qualified remoteDomainB . (.id)) targetUsers config = UserSubsystemConfig visibility miniLocale + localBackend = def {users = [viewer]} retrievedProfilesWithErrors :: ([(Qualified UserId, FederationError)], [UserProfile]) = - runFederationStack [viewer] online Nothing config $ + runFederationStack localBackend online Nothing config $ getUserProfilesWithErrors (toLocalUnsafe domain viewer.id) (remoteAUsers <> remoteBUsers) nub allDomains == allDomains ==> length (fst retrievedProfilesWithErrors) === length remoteBUsers .&&. length (snd retrievedProfilesWithErrors) === length remoteAUsers + + describe "getSelfProfile" $ do + prop "should retrieve a user which exists in the DB" \storedSelf otherStoredUsers domain config -> + let localBackend = def {users = storedSelf : filter (\u -> u.id /= storedSelf.id) otherStoredUsers} + retrievedProfile = + runNoFederationStack localBackend Nothing config $ + getSelfProfile (toLocalUnsafe domain storedSelf.id) + in retrievedProfile === Just (SelfProfile $ mkUserFromStored domain config.defaultLocale storedSelf) + + prop "should fail when the user does not exist in the DB" \selfId otherStoredUsers domain config -> + let localBackend = def {users = filter (\u -> u.id /= selfId) otherStoredUsers} + retrievedProfile = + runNoFederationStack localBackend Nothing config $ + getSelfProfile (toLocalUnsafe domain selfId) + in retrievedProfile === Nothing + + prop "should mark user as managed by scim if E2EId is enabled for the user and they have a handle" \storedSelf domain susbsystemConfig mlsE2EIdConfig -> + let localBackend = def {users = [storedSelf]} + allFeatureConfigs = def {afcMlsE2EId = withStatus FeatureStatusEnabled LockStatusUnlocked mlsE2EIdConfig FeatureTTLUnlimited} + SelfProfile retrievedUser = + fromJust + . runAllErrorsUnsafe + . interpretNoFederationStack localBackend Nothing allFeatureConfigs susbsystemConfig + $ getSelfProfile (toLocalUnsafe domain storedSelf.id) + expectedManagedBy = case storedSelf.handle of + Nothing -> fromMaybe ManagedByWire storedSelf.managedBy + Just _ -> ManagedByScim + in retrievedUser.userManagedBy === expectedManagedBy + + describe "updateUserProfile" $ do + prop "Update user" $ + \(NotPendingStoredUser alice) localDomain update config -> do + let lusr = toLocalUnsafe localDomain alice.id + localBackend = def {users = [alice {managedBy = Just ManagedByWire}]} + userBeforeUpdate = mkUserFromStored localDomain config.defaultLocale alice + (SelfProfile userAfterUpdate) = fromJust $ runNoFederationStack localBackend Nothing config do + updateUserProfile lusr Nothing UpdateOriginScim update + getSelfProfile lusr + in userAfterUpdate.userQualifiedId === tUntagged lusr + .&&. userAfterUpdate.userDisplayName === fromMaybe userBeforeUpdate.userDisplayName update.name + .&&. userAfterUpdate.userPict === fromMaybe userBeforeUpdate.userPict update.pict + .&&. userAfterUpdate.userAssets === fromMaybe userBeforeUpdate.userAssets update.assets + .&&. userAfterUpdate.userAccentId === fromMaybe userBeforeUpdate.userAccentId update.accentId + .&&. userAfterUpdate.userLocale === fromMaybe userBeforeUpdate.userLocale update.locale + + prop "Update user events" $ + \(NotPendingStoredUser alice) localDomain update config -> do + let lusr = toLocalUnsafe localDomain alice.id + localBackend = def {users = [alice {managedBy = Just ManagedByWire}]} + events = runNoFederationStack localBackend Nothing config do + updateUserProfile lusr Nothing UpdateOriginScim update + get @[MiniEvent] + in events + === [ MkMiniEvent + alice.id + ( UserUpdated $ + (emptyUserUpdatedData alice.id) + { eupName = update.name, + eupPict = update.pict, + eupAccentId = update.accentId, + eupAssets = update.assets, + eupLocale = update.locale, + eupSupportedProtocols = update.supportedProtocols + } + ) + ] + + describe "user managed by scim doesn't allow certain update operations, but allows others" $ do + prop "happy" $ + \(NotPendingStoredUser alice) localDomain update config -> + let lusr = toLocalUnsafe localDomain alice.id + localBackend = def {users = [alice {managedBy = Just ManagedByScim}]} + profileErr :: Either UserSubsystemError (Maybe UserProfile) = + run + . runErrorUnsafe + . runError + $ interpretNoFederationStack localBackend Nothing def config do + updateUserProfile lusr Nothing UpdateOriginWireClient update {name = Nothing, locale = Nothing} + getUserProfile lusr (tUntagged lusr) + in counterexample (show profileErr) $ isRight profileErr === True + + prop "name" $ + \(NotPendingStoredUser alice) localDomain name config -> + alice.name /= name ==> + let lusr = toLocalUnsafe localDomain alice.id + localBackend = def {users = [alice {managedBy = Just ManagedByScim}]} + profileErr :: Either UserSubsystemError (Maybe UserProfile) = + run + . runErrorUnsafe + . runError + $ interpretNoFederationStack localBackend Nothing def config do + updateUserProfile lusr Nothing UpdateOriginWireClient def {name = Just name} + getUserProfile lusr (tUntagged lusr) + in profileErr === Left UserSubsystemDisplayNameManagedByScim + + prop "locale" $ + \(NotPendingStoredUser alice) localDomain locale config -> + alice.locale /= Just locale ==> + let lusr = toLocalUnsafe localDomain alice.id + localBackend = def {users = [alice {managedBy = Just ManagedByScim}]} + profileErr :: Either UserSubsystemError (Maybe UserProfile) = + run + . runErrorUnsafe + . runError + $ interpretNoFederationStack localBackend Nothing def config do + updateUserProfile lusr Nothing UpdateOriginWireClient def {locale = Just locale} + getUserProfile lusr (tUntagged lusr) + in profileErr === Left UserSubsystemLocaleManagedByScim + + prop + "if e2e identity is activated, the user name cannot be updated" + \(NotPendingStoredUser alice) localDomain (newName :: Name) config -> + (alice.name /= newName) ==> + let lusr = toLocalUnsafe localDomain alice.id + localBackend = def {users = [alice]} + profileErr :: Either UserSubsystemError (Maybe UserProfile) = + run + . runErrorUnsafe + . runError + $ interpretNoFederationStack localBackend Nothing def {afcMlsE2EId = setStatus FeatureStatusEnabled defFeatureStatus} config do + updateUserProfile lusr Nothing UpdateOriginScim (def {name = Just newName}) + getUserProfile lusr (tUntagged lusr) + in profileErr === Left UserSubsystemDisplayNameManagedByScim + + prop + "CheckHandle succeeds if there is a user with that handle" + \((NotPendingStoredUser alice, handle :: Handle), config) -> + not (isBlacklistedHandle handle) ==> + let localBackend = def {users = [alice {managedBy = Just ManagedByWire, handle = Just handle}]} + checkHandleResp = + runNoFederationStack localBackend Nothing config $ checkHandle (fromHandle handle) + in checkHandleResp === CheckHandleFound + + prop + "CheckHandle fails if there is no user with that handle" + \(Handle handle, config) -> + not (isBlacklistedHandle (Handle handle)) ==> + let localBackend = def {users = []} + checkHandleResp = + runNoFederationStack localBackend Nothing config $ checkHandle handle + in checkHandleResp === CheckHandleNotFound + + prop + "CheckHandles returns available handles from a list of handles, up to X" + \((storedUsersAndHandles :: [(StoredUser, Handle)], randomHandles :: Set Handle), maxCount :: Word, config) -> + not (any isBlacklistedHandle ((snd <$> storedUsersAndHandles) <> (S.toList randomHandles))) ==> + let users = (\(u, h) -> u {handle = Just h, managedBy = Just ManagedByWire}) <$> storedUsersAndHandles + localBackend = def {users = users} + + runCheckHandles :: [Handle] -> [Handle] + runCheckHandles handles = runNoFederationStack localBackend Nothing config do + checkHandles handles maxCount + + takenHandles = snd <$> storedUsersAndHandles + freeHandles = runCheckHandles (S.toList randomHandles) + in runCheckHandles takenHandles === [] + .&&. freeHandles `intersect` takenHandles === mempty + .&&. counterexample (show (freeHandles, maxCount)) (length freeHandles <= fromIntegral maxCount) + .&&. counterexample (show (freeHandles, randomHandles)) ((S.fromList freeHandles) `S.isSubsetOf` randomHandles) + + describe "Scim+UpdateProfileUpdate" do + prop + "Updating handles fails when UpdateOriginWireClient" + \(alice, Handle newHandle, domain, config) -> + not (isBlacklistedHandle (Handle newHandle)) ==> + let res :: Either UserSubsystemError () + res = run + . runErrorUnsafe + . runError + $ interpretNoFederationStack localBackend Nothing def config do + updateHandle (toLocalUnsafe domain alice.id) Nothing UpdateOriginWireClient newHandle + + localBackend = def {users = [alice {managedBy = Just ManagedByScim}]} + in res === Left UserSubsystemHandleManagedByScim + + prop + "Updating handles succeeds when UpdateOriginScim" + \(alice, ssoId, email :: Maybe Email, Handle newHandle, domain, config) -> + not (isBlacklistedHandle (Handle newHandle)) ==> + let res :: Either UserSubsystemError () = run + . runErrorUnsafe + . runError + $ interpretNoFederationStack localBackend Nothing def config do + updateHandle (toLocalUnsafe domain alice.id) Nothing UpdateOriginScim newHandle + localBackend = + def + { users = + [ alice + { managedBy = Just ManagedByScim, + email = email, + ssoId = Just ssoId, + activated = True + } + ] + } + in res === Right () + + prop + "update valid handles succeeds" + \(storedUser :: StoredUser, newHandle@(Handle rawNewHandle), config) -> + (isJust storedUser.identity && not (isBlacklistedHandle newHandle)) ==> + let updateResult :: Either UserSubsystemError () = run + . runErrorUnsafe + . runError + $ interpretNoFederationStack (def {users = [storedUser]}) Nothing def config do + let luid = toLocalUnsafe dom storedUser.id + dom = Domain "localdomain" + updateHandle luid Nothing UpdateOriginScim rawNewHandle + in updateResult === Right () + + prop + "update invalid handles fails" + \(storedUser :: StoredUser, BadHandle badHandle, config) -> + isJust storedUser.identity ==> + let updateResult :: Either UserSubsystemError () = run + . runErrorUnsafe + . runError + $ interpretNoFederationStack localBackend Nothing def config do + let luid = toLocalUnsafe dom storedUser.id + dom = Domain "localdomain" + updateHandle luid Nothing UpdateOriginScim badHandle + localBackend = def {users = [storedUser]} + in updateResult === Left UserSubsystemInvalidHandle + + prop "update / read supported-protocols" \(storedUser, config, newSupportedProtocols) -> + not (hasPendingInvitation storedUser) ==> + let luid :: Local UserId + luid = toLocalUnsafe dom storedUser.id + where + dom = Domain "localdomain" + + operation :: Monad m => Sem (GetUserProfileEffects `Append` AllErrors) a -> m a + operation op = result `seq` pure result + where + result = runNoFederationStack localBackend Nothing config op + localBackend = def {users = [storedUser]} + + actualSupportedProtocols = runIdentity $ operation do + () <- updateUserProfile luid Nothing UpdateOriginWireClient (def {supportedProtocols = Just newSupportedProtocols}) + profileSupportedProtocols . fromJust <$> getUserProfile luid (tUntagged luid) + + expectedSupportedProtocols = + if S.null newSupportedProtocols + then defSupportedProtocols + else newSupportedProtocols + in actualSupportedProtocols === expectedSupportedProtocols diff --git a/libs/wire-subsystems/wire-subsystems.cabal b/libs/wire-subsystems/wire-subsystems.cabal index c959beac511..4ed2a43d58c 100644 --- a/libs/wire-subsystems/wire-subsystems.cabal +++ b/libs/wire-subsystems/wire-subsystems.cabal @@ -83,9 +83,12 @@ library Wire.ParseException Wire.Rpc Wire.StoredUser + Wire.UserEvents Wire.UserStore Wire.UserStore.Cassandra + Wire.UserStore.Unique Wire.UserSubsystem + Wire.UserSubsystem.HandleBlacklist Wire.UserSubsystem.Interpreter hs-source-dirs: src @@ -105,6 +108,7 @@ library , cql , currency-codes , data-default + , data-timeout , errors , exceptions , extended @@ -138,6 +142,7 @@ library , transitive-anns , types-common , unliftio + , unordered-containers , uuid , wai-utilities , wire-api @@ -169,11 +174,13 @@ test-suite wire-subsystems-tests , bytestring , containers , data-default + , errors , extended , gundeck-types , hspec , imports , iso639 + , lens , polysemy , polysemy-plugin , polysemy-time @@ -182,6 +189,7 @@ test-suite wire-subsystems-tests , quickcheck-instances , servant-client-core , string-conversions + , text , time , transformers , types-common diff --git a/services/brig/brig.cabal b/services/brig/brig.cabal index 29d5d17791a..b5938bdc426 100644 --- a/services/brig/brig.cabal +++ b/services/brig/brig.cabal @@ -208,7 +208,6 @@ library Brig.Team.Template Brig.Team.Util Brig.Template - Brig.Unique Brig.User.API.Handle Brig.User.API.Search Brig.User.Auth @@ -218,8 +217,6 @@ library Brig.User.Auth.DB.Instances Brig.User.EJPD Brig.User.Email - Brig.User.Handle - Brig.User.Handle.Blacklist Brig.User.Phone Brig.User.Search.Index Brig.User.Search.Index.Types @@ -264,7 +261,7 @@ library , cql , cryptobox-haskell >=0.1.1 , currency-codes >=2.0 - , data-timeout >=0.3 + , data-default , dns , dns-util , enclosed-exceptions >=1.0 diff --git a/services/brig/default.nix b/services/brig/default.nix index a7c6a8cfdb9..793d7af919b 100644 --- a/services/brig/default.nix +++ b/services/brig/default.nix @@ -194,7 +194,7 @@ mkDerivation { cql cryptobox-haskell currency-codes - data-timeout + data-default dns dns-util enclosed-exceptions diff --git a/services/brig/src/Brig/API/Auth.hs b/services/brig/src/Brig/API/Auth.hs index bc88f31413b..66e65b4354d 100644 --- a/services/brig/src/Brig/API/Auth.hs +++ b/services/brig/src/Brig/API/Auth.hs @@ -54,6 +54,7 @@ import Wire.API.User.Auth.Sso import Wire.GalleyAPIAccess import Wire.NotificationSubsystem import Wire.Sem.Paging.Cassandra (InternalPaging) +import Wire.UserSubsystem accessH :: ( Member TinyLog r, @@ -139,7 +140,7 @@ changeSelfEmailH uts' mat' up = do toks <- partitionTokens uts mat usr <- either (uncurry validateCredentials) (uncurry validateCredentials) toks let email = euEmail up - changeSelfEmail usr email ForbidSCIMUpdates + changeSelfEmail usr email UpdateOriginWireClient validateCredentials :: TokenPair u a => diff --git a/services/brig/src/Brig/API/Federation.hs b/services/brig/src/Brig/API/Federation.hs index b48dd6e10fd..8d4ec27088c 100644 --- a/services/brig/src/Brig/API/Federation.hs +++ b/services/brig/src/Brig/API/Federation.hs @@ -41,7 +41,8 @@ import Control.Error.Util import Control.Lens ((^.)) import Control.Monad.Trans.Except import Data.Domain -import Data.Handle (Handle (..), parseHandle) +import Data.Handle (Handle (..)) +import Data.Handle qualified as Handle import Data.Id (ClientId, TeamId, UserId) import Data.List.NonEmpty (nonEmpty) import Data.Qualified @@ -73,6 +74,7 @@ import Wire.DeleteQueue import Wire.GalleyAPIAccess (GalleyAPIAccess) import Wire.NotificationSubsystem import Wire.Sem.Concurrency +import Wire.UserStore import Wire.UserSubsystem type FederationAPI = "federation" :> BrigApi @@ -83,6 +85,7 @@ federationSitemap :: Member FederationConfigStore r, Member NotificationSubsystem r, Member UserSubsystem r, + Member UserStore r, Member DeleteQueue r ) => ServerT FederationAPI (Handler r) @@ -139,7 +142,8 @@ sendConnectionAction originDomain NewConnectionRequest {..} = do getUserByHandle :: ( Member FederationConfigStore r, - Member UserSubsystem r + Member UserSubsystem r, + Member UserStore r ) => Domain -> Handle -> @@ -155,7 +159,7 @@ getUserByHandle domain handle = do if not performHandleLookup then pure Nothing else lift $ do - maybeOwnerId <- wrapClient $ API.lookupHandle handle + maybeOwnerId <- liftSem $ API.lookupHandle handle case maybeOwnerId of Nothing -> pure Nothing @@ -202,7 +206,8 @@ fedClaimKeyPackages domain ckpr = searchUsers :: forall r. ( Member FederationConfigStore r, - Member UserSubsystem r + Member UserSubsystem r, + Member UserStore r ) => Domain -> SearchRequest -> @@ -237,8 +242,8 @@ searchUsers domain (SearchRequest searchTerm mTeam mOnlyInTeams) = do exactHandleSearch :: Int -> ExceptT Error (AppT r) [Contact] exactHandleSearch n | n > 0 = do - let maybeHandle = parseHandle searchTerm - maybeOwnerId <- maybe (pure Nothing) (wrapHttpClientE . API.lookupHandle) maybeHandle + let maybeHandle = Handle.parseHandle searchTerm + maybeOwnerId <- maybe (pure Nothing) (lift . liftSem . API.lookupHandle) maybeHandle case maybeOwnerId of Nothing -> pure [] Just foundUser -> do diff --git a/services/brig/src/Brig/API/Internal.hs b/services/brig/src/Brig/API/Internal.hs index 0cbe0829f48..038e9956d2b 100644 --- a/services/brig/src/Brig/API/Internal.hs +++ b/services/brig/src/Brig/API/Internal.hs @@ -1,3 +1,5 @@ +{-# OPTIONS_GHC -Wno-ambiguous-fields #-} + -- This file is part of the Wire Server implementation. -- -- Copyright (C) 2022 Wire Swiss GmbH @@ -29,7 +31,6 @@ import Brig.API.MLS.KeyPackages.Validation import Brig.API.OAuth (internalOauthAPI) import Brig.API.Types import Brig.API.User qualified as API -import Brig.API.Util import Brig.App import Brig.Code qualified as Code import Brig.Data.Activation @@ -41,7 +42,12 @@ import Brig.Effects.BlacklistPhonePrefixStore (BlacklistPhonePrefixStore) import Brig.Effects.BlacklistStore (BlacklistStore) import Brig.Effects.CodeStore (CodeStore) import Brig.Effects.ConnectionStore (ConnectionStore) -import Brig.Effects.FederationConfigStore (AddFederationRemoteResult (..), AddFederationRemoteTeamResult (..), FederationConfigStore, UpdateFederationResult (..)) +import Brig.Effects.FederationConfigStore + ( AddFederationRemoteResult (..), + AddFederationRemoteTeamResult (..), + FederationConfigStore, + UpdateFederationResult (..), + ) import Brig.Effects.FederationConfigStore qualified as E import Brig.Effects.PasswordResetStore (PasswordResetStore) import Brig.Effects.UserPendingActivationStore (UserPendingActivationStore) @@ -61,6 +67,7 @@ import Control.Error hiding (bool) import Control.Lens (view) import Data.ByteString.Conversion (toByteString) import Data.CommaSeparatedList +import Data.Default import Data.Domain (Domain) import Data.Handle import Data.Id as Id @@ -102,6 +109,9 @@ import Wire.NotificationSubsystem import Wire.Rpc import Wire.Sem.Concurrency import Wire.Sem.Paging.Cassandra (InternalPaging) +import Wire.UserStore +import Wire.UserSubsystem +import Wire.UserSubsystem qualified as UserSubsystem servantSitemap :: forall r p. @@ -117,6 +127,8 @@ servantSitemap :: Member (Input (Local ())) r, Member (Input UTCTime) r, Member NotificationSubsystem r, + Member UserSubsystem r, + Member UserStore r, Member PasswordResetStore r, Member Rpc r, Member TinyLog r, @@ -144,6 +156,7 @@ istatusAPI = Named @"get-status" (pure NoContent) ejpdAPI :: ( Member GalleyAPIAccess r, Member NotificationSubsystem r, + Member UserStore r, Member Rpc r ) => ServerT BrigIRoutes.EJPDRequest (Handler r) @@ -163,6 +176,8 @@ accountAPI :: Member (UserPendingActivationStore p) r, Member (Embed HttpClientIO) r, Member NotificationSubsystem r, + Member UserSubsystem r, + Member UserStore r, Member TinyLog r, Member (Input (Local ())) r, Member (Input UTCTime) r, @@ -197,7 +212,7 @@ accountAPI = :<|> Named @"iPutManagedBy" updateManagedByH :<|> Named @"iPutRichInfo" updateRichInfoH :<|> Named @"iPutHandle" updateHandleH - :<|> Named @"iPutHandle" updateUserNameH + :<|> Named @"iPutUserName" updateUserNameH :<|> Named @"iGetRichInfo" getRichInfoH :<|> Named @"iGetRichInfoMulti" getRichInfoMultiH :<|> Named @"iHeadHandle" checkHandleInternalH @@ -230,7 +245,7 @@ teamsAPI = :<|> Named @"team-size" Team.teamSize :<|> Named @"create-invitations-via-scim" Team.createInvitationViaScim -userAPI :: ServerT BrigIRoutes.UserAPI (Handler r) +userAPI :: Member UserSubsystem r => ServerT BrigIRoutes.UserAPI (Handler r) userAPI = updateLocale :<|> deleteLocale @@ -464,6 +479,7 @@ createUserNoVerifySpar :: ( Member GalleyAPIAccess r, Member (Embed HttpClientIO) r, Member NotificationSubsystem r, + Member UserSubsystem r, Member TinyLog r, Member (Input (Local ())) r, Member (Input UTCTime) r, @@ -488,6 +504,7 @@ createUserNoVerifySpar uData = deleteUserNoAuthH :: ( Member (Embed HttpClientIO) r, Member NotificationSubsystem r, + Member UserStore r, Member TinyLog r, Member (Input (Local ())) r, Member (Input UTCTime) r, @@ -505,11 +522,11 @@ deleteUserNoAuthH uid = do changeSelfEmailMaybeSendH :: (Member BlacklistStore r) => UserId -> EmailUpdate -> Maybe Bool -> (Handler r) ChangeEmailResponse changeSelfEmailMaybeSendH u body (fromMaybe False -> validate) = do let email = euEmail body - changeSelfEmailMaybeSend u (if validate then ActuallySendEmail else DoNotSendEmail) email API.AllowSCIMUpdates + changeSelfEmailMaybeSend u (if validate then ActuallySendEmail else DoNotSendEmail) email UpdateOriginScim data MaybeSendEmail = ActuallySendEmail | DoNotSendEmail -changeSelfEmailMaybeSend :: (Member BlacklistStore r) => UserId -> MaybeSendEmail -> Email -> API.AllowSCIMUpdates -> (Handler r) ChangeEmailResponse +changeSelfEmailMaybeSend :: (Member BlacklistStore r) => UserId -> MaybeSendEmail -> Email -> UpdateOriginType -> (Handler r) ChangeEmailResponse changeSelfEmailMaybeSend u ActuallySendEmail email allowScim = do API.changeSelfEmail u email allowScim changeSelfEmailMaybeSend u DoNotSendEmail email allowScim = do @@ -522,7 +539,7 @@ changeSelfEmailMaybeSend u DoNotSendEmail email allowScim = do -- handler allows up to 4 lists of various user keys, and returns the union of the lookups. -- Empty list is forbidden for backwards compatibility. listActivatedAccountsH :: - Member DeleteQueue r => + (Member DeleteQueue r, Member UserStore r) => Maybe (CommaSeparatedList UserId) -> Maybe (CommaSeparatedList Handle) -> Maybe (CommaSeparatedList Email) -> @@ -544,17 +561,18 @@ listActivatedAccountsH u4 <- (\phone -> API.lookupAccountsByIdentity (Right phone) includePendingInvitations) `mapM` phones pure $ u1 <> u2 <> join u3 <> join u4 +-- FUTUREWORK: this should use UserStore only through UserSubsystem. listActivatedAccounts :: - Member DeleteQueue r => + (Member DeleteQueue r, Member UserStore r) => Either [UserId] [Handle] -> Bool -> - (AppT r) [UserAccount] + AppT r [UserAccount] listActivatedAccounts elh includePendingInvitations = do Log.debug (Log.msg $ "listActivatedAccounts: " <> show (elh, includePendingInvitations)) case elh of Left us -> byIds us Right hs -> do - us <- mapM (wrapClient . API.lookupHandle) hs + us <- liftSem $ mapM API.lookupHandle hs byIds (catMaybes us) where byIds :: Member DeleteQueue r => [UserId] -> (AppT r) [UserAccount] @@ -673,7 +691,8 @@ revokeIdentityH :: Member TinyLog r, Member (Input (Local ())) r, Member (Input UTCTime) r, - Member (ConnectionStore InternalPaging) r + Member (ConnectionStore InternalPaging) r, + Member UserSubsystem r ) => Maybe Email -> Maybe Phone -> @@ -801,15 +820,18 @@ updateRichInfoH uid rup = -- Intra.onUserEvent uid (Just conn) (richInfoUpdate uid ri) lift $ wrapClient $ Data.updateRichInfo uid (mkRichInfoAssocList richInfo) -updateLocale :: UserId -> LocaleUpdate -> (Handler r) LocaleUpdate -updateLocale uid locale = do - lift $ wrapClient $ Data.updateLocale uid (luLocale locale) - pure locale +updateLocale :: Member UserSubsystem r => UserId -> LocaleUpdate -> (Handler r) LocaleUpdate +updateLocale uid upd@(LocaleUpdate locale) = do + qUid <- qualifyLocal uid + lift . liftSem $ updateUserProfile qUid Nothing UpdateOriginScim def {locale = Just locale} + pure upd -deleteLocale :: UserId -> (Handler r) NoContent +deleteLocale :: Member UserSubsystem r => UserId -> (Handler r) NoContent deleteLocale uid = do defLoc <- setDefaultUserLocale <$> view settings - lift $ wrapClient $ Data.updateLocale uid defLoc $> NoContent + qUid <- qualifyLocal uid + lift . liftSem $ updateUserProfile qUid Nothing UpdateOriginScim def {locale = Just defLoc} + pure NoContent getDefaultUserLocale :: (Handler r) LocaleUpdate getDefaultUserLocale = do @@ -837,54 +859,33 @@ getRichInfoMultiH (maybe [] fromCommaSeparatedList -> uids) = lift $ wrapClient $ API.lookupRichInfoMultiUsers uids updateHandleH :: - ( Member (Embed HttpClientIO) r, - Member NotificationSubsystem r, - Member GalleyAPIAccess r, - Member TinyLog r, - Member (Input (Local ())) r, - Member (Input UTCTime) r, - Member (ConnectionStore InternalPaging) r - ) => + Member UserSubsystem r => UserId -> HandleUpdate -> - (Handler r) NoContent + Handler r NoContent updateHandleH uid (HandleUpdate handleUpd) = NoContent <$ do - handle <- validateHandle handleUpd - API.changeHandle uid Nothing handle API.AllowSCIMUpdates !>> changeHandleError + quid <- qualifyLocal uid + lift . liftSem $ UserSubsystem.updateHandle quid Nothing UpdateOriginScim handleUpd updateUserNameH :: - ( Member (Embed HttpClientIO) r, - Member NotificationSubsystem r, - Member GalleyAPIAccess r, - Member TinyLog r, - Member (Input (Local ())) r, - Member (Input UTCTime) r, - Member (ConnectionStore InternalPaging) r - ) => + Member UserSubsystem r => UserId -> NameUpdate -> (Handler r) NoContent updateUserNameH uid (NameUpdate nameUpd) = NoContent <$ do + luid <- qualifyLocal uid name <- either (const $ throwStd (errorToWai @'E.InvalidUser)) pure $ mkName nameUpd - let uu = - UserUpdate - { uupName = Just name, - uupPict = Nothing, - uupAssets = Nothing, - uupAccentId = Nothing - } lift (wrapClient $ Data.lookupUser WithPendingInvitations uid) >>= \case - Just _ -> API.updateUser uid Nothing uu API.AllowSCIMUpdates !>> updateProfileError + Just _ -> lift . liftSem $ updateUserProfile luid Nothing UpdateOriginScim (def {name = Just name}) Nothing -> throwStd (errorToWai @'E.InvalidUser) -checkHandleInternalH :: Handle -> (Handler r) CheckHandleResponse -checkHandleInternalH (Handle h) = - API.checkHandle h >>= \case - API.CheckHandleInvalid -> throwE (StdError (errorToWai @'E.InvalidHandle)) - API.CheckHandleFound -> pure CheckHandleResponseFound - API.CheckHandleNotFound -> pure CheckHandleResponseNotFound +checkHandleInternalH :: Member UserSubsystem r => Handle -> Handler r CheckHandleResponse +checkHandleInternalH (Handle h) = lift $ liftSem do + API.checkHandle h <&> \case + API.CheckHandleFound -> CheckHandleResponseFound + API.CheckHandleNotFound -> CheckHandleResponseNotFound getContactListH :: UserId -> (Handler r) UserIds getContactListH uid = lift . wrapClient $ UserIds <$> API.lookupContactList uid diff --git a/services/brig/src/Brig/API/Public.hs b/services/brig/src/Brig/API/Public.hs index 3549efff504..be850469eab 100644 --- a/services/brig/src/Brig/API/Public.hs +++ b/services/brig/src/Brig/API/Public.hs @@ -37,7 +37,6 @@ import Brig.API.Public.Swagger import Brig.API.Types import Brig.API.User qualified as API import Brig.API.Util -import Brig.API.Util qualified as API import Brig.App import Brig.Calling.API qualified as Calling import Brig.Code qualified as Code @@ -70,7 +69,7 @@ import Brig.User.Email import Brig.User.Phone import Cassandra qualified as C import Cassandra qualified as Data -import Control.Error hiding (bool) +import Control.Error hiding (bool, note) import Control.Lens (view, (.~), (?~), (^.)) import Control.Monad.Catch (throwM) import Control.Monad.Except @@ -81,9 +80,11 @@ import Data.ByteString.Lazy qualified as Lazy import Data.ByteString.Lazy.Char8 qualified as LBS import Data.ByteString.UTF8 qualified as UTF8 import Data.CommaSeparatedList +import Data.Default import Data.Domain import Data.FileEmbed -import Data.Handle (Handle, parseHandle) +import Data.Handle (Handle) +import Data.Handle qualified as Handle import Data.Id import Data.Id qualified as Id import Data.List.NonEmpty (nonEmpty) @@ -164,7 +165,9 @@ import Wire.Sem.Concurrency import Wire.Sem.Jwk (Jwk) import Wire.Sem.Now (Now) import Wire.Sem.Paging.Cassandra (InternalPaging) -import Wire.UserSubsystem +import Wire.UserStore (UserStore) +import Wire.UserSubsystem hiding (checkHandle, checkHandles) +import Wire.UserSubsystem qualified as UserSubsystem -- User API ----------------------------------------------------------- @@ -292,6 +295,7 @@ servantSitemap :: Member JwtTools r, Member NotificationSubsystem r, Member UserSubsystem r, + Member UserStore r, Member Now r, Member PasswordResetStore r, Member PublicKeyBundle r, @@ -808,11 +812,10 @@ createUser (Public.NewUserPublic new) = lift . runExceptT $ do Public.NewTeamMemberSSO _ -> Team.sendMemberWelcomeMail e t n l -getSelf :: Member GalleyAPIAccess r => UserId -> (Handler r) Public.SelfProfile +getSelf :: Member UserSubsystem r => Local UserId -> Handler r Public.SelfProfile getSelf self = - lift (API.lookupSelfProfile self) + lift (liftSem (getSelfProfile self)) >>= ifNothing (errorToWai @'E.UserNotFound) - >>= lift . liftSem . API.hackForBlockingHandleChangeForE2EIdTeams getUserProfileH :: (Member UserSubsystem r) => @@ -832,7 +835,7 @@ getUserUnqualifiedH self uid = do -- FUTUREWORK: Make servant understand that at least one of these is required listUsersByUnqualifiedIdsOrHandles :: - (Member UserSubsystem r) => + (Member UserSubsystem r, Member UserStore r) => UserId -> Maybe (CommaSeparatedList UserId) -> Maybe (Range 1 4 (CommaSeparatedList Handle)) -> @@ -852,20 +855,27 @@ listUsersByUnqualifiedIdsOrHandles self mUids mHandles = do in listUsersByIdsOrHandlesV3 self (Public.ListUsersByHandles qualifiedRangedList) (Nothing, Nothing) -> throwStd $ badRequest "at least one ids or handles must be provided" -listUsersByIdsOrHandlesGetIds :: [Handle] -> (Handler r) [Qualified UserId] +listUsersByIdsOrHandlesGetIds :: + Member UserStore r => + [Handle] -> + Handler r [Qualified UserId] listUsersByIdsOrHandlesGetIds localHandles = do - localUsers <- catMaybes <$> traverse (lift . wrapClient . API.lookupHandle) localHandles + localUsers <- catMaybes <$> traverse (lift . liftSem . API.lookupHandle) localHandles domain <- viewFederationDomain pure $ map (`Qualified` domain) localUsers -listUsersByIdsOrHandlesGetUsers :: Local x -> Range n m [Qualified Handle] -> Handler r [Qualified UserId] +listUsersByIdsOrHandlesGetUsers :: + Member UserStore r => + Local x -> + Range n m [Qualified Handle] -> + Handler r [Qualified UserId] listUsersByIdsOrHandlesGetUsers lself hs = do let (localHandles, _) = partitionQualified lself (fromRange hs) listUsersByIdsOrHandlesGetIds localHandles listUsersByIdsOrHandlesV3 :: forall r. - (Member UserSubsystem r) => + (Member UserSubsystem r, Member UserStore r) => UserId -> Public.ListUsersQuery -> (Handler r) [Public.UserProfile] @@ -888,7 +898,7 @@ listUsersByIdsOrHandlesV3 self q = do -- using a new return type listUsersByIdsOrHandles :: forall r. - (Member UserSubsystem r) => + (Member UserSubsystem r, Member UserStore r) => UserId -> Public.ListUsersQuery -> Handler r ListUsersById @@ -917,21 +927,21 @@ instance ToJSON GetActivationCodeResp where toJSON (GetActivationCodeResp (k, c)) = object ["key" .= k, "code" .= c] updateUser :: - ( Member (Embed HttpClientIO) r, - Member NotificationSubsystem r, - Member GalleyAPIAccess r, - Member TinyLog r, - Member (Input (Local ())) r, - Member (Input UTCTime) r, - Member (ConnectionStore InternalPaging) r - ) => - UserId -> + Member UserSubsystem r => + Local UserId -> ConnId -> Public.UserUpdate -> - (Handler r) (Maybe Public.UpdateProfileError) + Handler r () updateUser uid conn uu = do - eithErr <- lift $ runExceptT $ API.updateUser uid (Just conn) uu API.ForbidSCIMUpdates - pure $ either Just (const Nothing) eithErr + let update = + def + { name = uu.uupName, + pict = uu.uupPict, + assets = uu.uupAssets, + accentId = uu.uupAccentId + } + lift . liftSem $ + updateUserProfile uid (Just conn) UpdateOriginWireClient update changePhone :: ( Member BlacklistStore r, @@ -953,7 +963,8 @@ removePhone :: Member TinyLog r, Member (Input (Local ())) r, Member (Input UTCTime) r, - Member (ConnectionStore InternalPaging) r + Member (ConnectionStore InternalPaging) r, + Member UserSubsystem r ) => UserId -> ConnId -> @@ -967,7 +978,8 @@ removeEmail :: Member TinyLog r, Member (Input (Local ())) r, Member (Input UTCTime) r, - Member (ConnectionStore InternalPaging) r + Member (ConnectionStore InternalPaging) r, + Member UserSubsystem r ) => UserId -> ConnId -> @@ -982,56 +994,52 @@ changePassword :: UserId -> Public.PasswordChange -> (Handler r) (Maybe Public.C changePassword u cp = lift . exceptTToMaybe $ API.changePassword u cp changeLocale :: - ( Member (Embed HttpClientIO) r, - Member NotificationSubsystem r, - Member TinyLog r, - Member (Input (Local ())) r, - Member (Input UTCTime) r, - Member (ConnectionStore InternalPaging) r - ) => - UserId -> + Member UserSubsystem r => + Local UserId -> ConnId -> Public.LocaleUpdate -> (Handler r) () -changeLocale u conn l = lift $ API.changeLocale u conn l +changeLocale lusr conn l = + lift . liftSem $ + updateUserProfile + lusr + (Just conn) + UserSubsystem.UpdateOriginWireClient + def {locale = Just l.luLocale} changeSupportedProtocols :: - ( Member (Embed HttpClientIO) r, - Member NotificationSubsystem r, - Member TinyLog r, - Member (Input (Local ())) r, - Member (Input UTCTime) r, - Member (ConnectionStore InternalPaging) r - ) => + (Member UserSubsystem r) => Local UserId -> ConnId -> Public.SupportedProtocolUpdate -> Handler r () -changeSupportedProtocols (tUnqualified -> u) conn (Public.SupportedProtocolUpdate prots) = - lift $ API.changeSupportedProtocols u conn prots +changeSupportedProtocols u conn (Public.SupportedProtocolUpdate prots) = + lift . liftSem $ UserSubsystem.updateUserProfile u (Just conn) UpdateOriginWireClient upd + where + upd = def {supportedProtocols = Just prots} -- | (zusr is ignored by this handler, ie. checking handles is allowed as long as you have -- *any* account.) -checkHandle :: UserId -> Text -> Handler r () +checkHandle :: Member UserSubsystem r => UserId -> Text -> Handler r () checkHandle _uid hndl = - API.checkHandle hndl >>= \case - API.CheckHandleInvalid -> throwStd (errorToWai @'E.InvalidHandle) + lift (liftSem $ UserSubsystem.checkHandle hndl) >>= \case API.CheckHandleFound -> pure () API.CheckHandleNotFound -> throwStd (errorToWai @'E.HandleNotFound) -- | (zusr is ignored by this handler, ie. checking handles is allowed as long as you have -- *any* account.) -checkHandles :: UserId -> Public.CheckHandles -> Handler r [Handle] +checkHandles :: Member UserSubsystem r => UserId -> Public.CheckHandles -> Handler r [Handle] checkHandles _ (Public.CheckHandles hs num) = do - let handles = mapMaybe parseHandle (fromRange hs) - lift $ wrapHttpClient $ API.checkHandles handles (fromRange num) + let handles = mapMaybe Handle.parseHandle (fromRange hs) + lift $ liftSem $ API.checkHandles handles (fromRange num) -- | This endpoint returns UserHandleInfo instead of UserProfile for backwards -- compatibility, whereas the corresponding qualified endpoint (implemented by -- 'Handle.getHandleInfo') returns UserProfile to reduce traffic between backends -- in a federated scenario. getHandleInfoUnqualifiedH :: - ( Member UserSubsystem r + ( Member UserSubsystem r, + Member UserStore r ) => UserId -> Handle -> @@ -1041,27 +1049,14 @@ getHandleInfoUnqualifiedH self handle = do Public.UserHandleInfo . Public.profileQualifiedId <$$> Handle.getHandleInfo self (Qualified handle domain) -changeHandle :: - ( Member (Embed HttpClientIO) r, - Member NotificationSubsystem r, - Member GalleyAPIAccess r, - Member TinyLog r, - Member (Input (Local ())) r, - Member (Input UTCTime) r, - Member (ConnectionStore InternalPaging) r - ) => - UserId -> - ConnId -> - Public.HandleUpdate -> - (Handler r) (Maybe Public.ChangeHandleError) -changeHandle u conn (Public.HandleUpdate h) = lift . exceptTToMaybe $ do - handle <- maybe (throwError Public.ChangeHandleInvalid) pure $ parseHandle h - API.changeHandle u (Just conn) handle API.ForbidSCIMUpdates +changeHandle :: (Member UserSubsystem r) => Local UserId -> ConnId -> Public.HandleUpdate -> Handler r () +changeHandle u conn (Public.HandleUpdate h) = lift $ liftSem do + UserSubsystem.updateHandle u (Just conn) UpdateOriginWireClient h beginPasswordReset :: (Member PasswordResetStore r, Member TinyLog r) => Public.NewPasswordReset -> - (Handler r) () + Handler r () beginPasswordReset (Public.NewPasswordReset target) = do checkAllowlist target (u, pair) <- API.beginPasswordReset target !>> pwResetError @@ -1237,6 +1232,7 @@ deleteSelfUser :: Member TinyLog r, Member (Embed HttpClientIO) r, Member NotificationSubsystem r, + Member UserStore r, Member (Input (Local ())) r, Member (Input UTCTime) r, Member (ConnectionStore InternalPaging) r @@ -1250,6 +1246,7 @@ deleteSelfUser u body = do verifyDeleteUser :: ( Member (Embed HttpClientIO) r, Member NotificationSubsystem r, + Member UserStore r, Member TinyLog r, Member (Input (Local ())) r, Member (Input UTCTime) r, @@ -1273,7 +1270,7 @@ updateUserEmail zuserId emailOwnerId (Public.EmailUpdate email) = do whenM (not <$> assertHasPerm maybeZuserTeamId) $ throwStd insufficientTeamPermissions maybeEmailOwnerTeamId <- lift $ wrapClient $ Data.lookupUserTeam emailOwnerId checkSameTeam maybeZuserTeamId maybeEmailOwnerTeamId - void $ API.changeSelfEmail emailOwnerId email API.ForbidSCIMUpdates + void $ API.changeSelfEmail emailOwnerId email UpdateOriginWireClient where checkSameTeam :: Maybe TeamId -> Maybe TeamId -> (Handler r) () checkSameTeam (Just zuserTeamId) maybeEmailOwnerTeamId = diff --git a/services/brig/src/Brig/API/User.hs b/services/brig/src/Brig/API/User.hs index c80dd866ff6..08ffc85d785 100644 --- a/services/brig/src/Brig/API/User.hs +++ b/services/brig/src/Brig/API/User.hs @@ -1,3 +1,5 @@ +{-# OPTIONS_GHC -Wno-ambiguous-fields #-} + -- This file is part of the Wire Server implementation. -- -- Copyright (C) 2022 Wire Swiss GmbH @@ -22,17 +24,13 @@ module Brig.API.User createUserSpar, createUserInviteViaScim, checkRestrictedUserCreation, - Brig.API.User.updateUser, - changeLocale, changeSelfEmail, changeEmail, changePhone, - changeHandle, CheckHandleResp (..), checkHandle, lookupHandle, changeManagedBy, - changeSupportedProtocols, changeAccountStatus, changeSingleAccountStatus, Data.lookupAccounts, @@ -58,7 +56,6 @@ module Brig.API.User checkHandles, isBlacklistedHandle, Data.reauthenticate, - AllowSCIMUpdates (..), -- * Activation sendActivationCode, @@ -86,12 +83,11 @@ module Brig.API.User -- * Utilities fetchUserIdentity, - hackForBlockingHandleChangeForE2EIdTeams, ) where import Brig.API.Error qualified as Error -import Brig.API.Handler qualified as API (Handler, UserNotAllowedToJoinTeam (..)) +import Brig.API.Handler qualified as API (UserNotAllowedToJoinTeam (..)) import Brig.API.Types import Brig.API.Util import Brig.App @@ -125,8 +121,6 @@ import Brig.Types.Connection import Brig.Types.Intra import Brig.User.Auth.Cookie (listCookies, revokeAllCookies) import Brig.User.Email -import Brig.User.Handle -import Brig.User.Handle.Blacklist import Brig.User.Phone import Brig.User.Search.Index (reindex) import Brig.User.Search.TeamSize qualified as TeamSize @@ -137,7 +131,7 @@ import Control.Monad.Catch import Data.ByteString.Conversion import Data.Code import Data.Currency qualified as Currency -import Data.Handle (Handle (fromHandle), parseHandle) +import Data.Handle (Handle (fromHandle)) import Data.Id as Id import Data.Json.Util import Data.LegalHold (UserLegalHoldStatus (..), defUserLegalHoldStatus) @@ -181,12 +175,9 @@ import Wire.GalleyAPIAccess as GalleyAPIAccess import Wire.NotificationSubsystem import Wire.Sem.Concurrency import Wire.Sem.Paging.Cassandra (InternalPaging) -import Wire.UserSubsystem - -data AllowSCIMUpdates - = AllowSCIMUpdates - | ForbidSCIMUpdates - deriving (Show, Eq, Ord) +import Wire.UserStore +import Wire.UserSubsystem as User +import Wire.UserSubsystem.HandleBlacklist ------------------------------------------------------------------------------- -- Create User @@ -228,6 +219,7 @@ createUserSpar :: Member TinyLog r, Member (Input (Local ())) r, Member (Input UTCTime) r, + Member UserSubsystem r, Member (ConnectionStore InternalPaging) r ) => NewUserSpar -> @@ -258,20 +250,18 @@ createUserSpar new = do userTeam <- withExceptT CreateUserSparRegistrationError $ addUserToTeamSSO account tid (SSOIdentity ident Nothing Nothing) (newUserSparRole new) -- Set up feature flags - let uid = userId (accountUser account) - lift $ initAccountFeatureConfig uid + luid <- lift $ ensureLocal (userQualifiedId (accountUser account)) + lift $ initAccountFeatureConfig (tUnqualified luid) -- Set handle - updateHandle' uid handle' + lift $ updateHandle' luid handle' pure $! CreateUserResult account Nothing Nothing (Just userTeam) where - updateHandle' :: UserId -> Maybe Handle -> ExceptT CreateUserSparError (AppT r) () + updateHandle' :: Local UserId -> Maybe Handle -> AppT r () updateHandle' _ Nothing = pure () - updateHandle' uid (Just h) = do - case parseHandle . fromHandle $ h of - Just handl -> withExceptT CreateUserSparHandleError $ changeHandle uid Nothing handl AllowSCIMUpdates - Nothing -> throwE $ CreateUserSparHandleError ChangeHandleInvalid + updateHandle' luid (Just h) = + liftSem $ User.updateHandle luid Nothing UpdateOriginScim (fromHandle h) addUserToTeamSSO :: UserAccount -> TeamId -> UserIdentity -> Role -> ExceptT RegisterError (AppT r) CreateUserTeam addUserToTeamSSO account tid ident role = do @@ -540,7 +530,7 @@ initAccountFeatureConfig uid = do mbCciDefNew <- view (settings . getAfcConferenceCallingDefNewMaybe) forM_ (forgetLock <$> mbCciDefNew) $ wrapClient . Data.updateFeatureConferenceCalling uid . Just --- | 'createUser' is becoming hard to maintian, and instead of adding more case distinctions +-- | 'createUser' is becoming hard to maintain, and instead of adding more case distinctions -- all over the place there, we add a new function that handles just the one new flow where -- users are invited to the team via scim. createUserInviteViaScim :: @@ -584,60 +574,6 @@ checkRestrictedUserCreation new = do ) $ throwE RegisterErrorUserCreationRestricted -------------------------------------------------------------------------------- --- Update Profile - -updateUser :: - ( Member (Embed HttpClientIO) r, - Member NotificationSubsystem r, - Member GalleyAPIAccess r, - Member TinyLog r, - Member (Input (Local ())) r, - Member (Input UTCTime) r, - Member (ConnectionStore InternalPaging) r - ) => - UserId -> - Maybe ConnId -> - UserUpdate -> - AllowSCIMUpdates -> - ExceptT UpdateProfileError (AppT r) () -updateUser uid mconn uu allowScim = do - for_ (uupName uu) $ \newName -> do - mbUser <- lift . wrapClient $ Data.lookupUser WithPendingInvitations uid - user <- maybe (throwE ProfileNotFound) pure mbUser - unless - ( userManagedBy user /= ManagedByScim - || userDisplayName user == newName - || allowScim == AllowSCIMUpdates - ) - $ throwE DisplayNameManagedByScim - hasE2EId <- lift . liftSem . userUnderE2EId $ uid - when (hasE2EId && newName /= userDisplayName user) $ - throwE DisplayNameManagedByScim - - lift $ do - wrapClient $ Data.updateUser uid uu - liftSem $ Intra.onUserEvent uid mconn (profileUpdated uid uu) - -------------------------------------------------------------------------------- --- Update Locale - -changeLocale :: - ( Member (Embed HttpClientIO) r, - Member NotificationSubsystem r, - Member TinyLog r, - Member (Input (Local ())) r, - Member (Input UTCTime) r, - Member (ConnectionStore InternalPaging) r - ) => - UserId -> - ConnId -> - LocaleUpdate -> - (AppT r) () -changeLocale uid conn (LocaleUpdate loc) = do - wrapClient $ Data.updateLocale uid loc - liftSem $ Intra.onUserEvent uid (Just conn) (localeUpdate uid loc) - ------------------------------------------------------------------------------- -- Update ManagedBy @@ -657,118 +593,12 @@ changeManagedBy uid conn (ManagedByUpdate mb) = do wrapClient $ Data.updateManagedBy uid mb liftSem $ Intra.onUserEvent uid (Just conn) (managedByUpdate uid mb) -------------------------------------------------------------------------------- --- Update supported protocols - -changeSupportedProtocols :: - ( Member (Embed HttpClientIO) r, - Member NotificationSubsystem r, - Member TinyLog r, - Member (Input (Local ())) r, - Member (Input UTCTime) r, - Member (ConnectionStore InternalPaging) r - ) => - UserId -> - ConnId -> - Set BaseProtocolTag -> - AppT r () -changeSupportedProtocols uid conn prots = do - wrapClient $ Data.updateSupportedProtocols uid prots - liftSem $ Intra.onUserEvent uid (Just conn) (supportedProtocolUpdate uid prots) - --------------------------------------------------------------------------------- --- Change Handle - -changeHandle :: - ( Member (Embed HttpClientIO) r, - Member NotificationSubsystem r, - Member GalleyAPIAccess r, - Member TinyLog r, - Member (Input (Local ())) r, - Member (Input UTCTime) r, - Member (ConnectionStore InternalPaging) r - ) => - UserId -> - Maybe ConnId -> - Handle -> - AllowSCIMUpdates -> - ExceptT ChangeHandleError (AppT r) () -changeHandle uid mconn hdl allowScim = do - when (isBlacklistedHandle hdl) $ - throwE ChangeHandleInvalid - usr <- lift $ wrapClient $ Data.lookupUser WithPendingInvitations uid - case usr of - Nothing -> throwE ChangeHandleNoIdentity - Just u -> do - unless - ( userManagedBy u /= ManagedByScim - || Just hdl == userHandle u - || allowScim == AllowSCIMUpdates - ) - $ throwE ChangeHandleManagedByScim - hasE2EId <- lift . liftSem . userUnderE2EId . userId $ u - when (hasE2EId && userHandle u `notElem` [Nothing, Just hdl]) $ - throwE ChangeHandleManagedByScim - claim u - where - claim u = do - unless (isJust (userIdentity u)) $ - throwE ChangeHandleNoIdentity - claimed <- lift . wrapClient $ claimHandle (userId u) (userHandle u) hdl - unless claimed $ - throwE ChangeHandleExists - lift $ liftSem $ Intra.onUserEvent uid mconn (handleUpdated uid hdl) - --------------------------------------------------------------------------------- --- Check Handle - -data CheckHandleResp - = CheckHandleInvalid - | CheckHandleFound - | CheckHandleNotFound - -checkHandle :: Text -> API.Handler r CheckHandleResp -checkHandle uhandle = do - xhandle <- validateHandle uhandle - owner <- lift . wrapClient $ lookupHandle xhandle - if - | isJust owner -> - -- Handle is taken (=> getHandleInfo will return 200) - pure CheckHandleFound - | isBlacklistedHandle xhandle -> - -- Handle is free but cannot be taken - -- - -- FUTUREWORK: i wonder if this is correct? isn't this the error for malformed - -- handles? shouldn't we throw not-found here? or should there be a fourth case - -- 'CheckHandleBlacklisted'? - pure CheckHandleInvalid - | otherwise -> - -- Handle is free and can be taken - pure CheckHandleNotFound - --------------------------------------------------------------------------------- --- Check Handles - -checkHandles :: MonadClient m => [Handle] -> Word -> m [Handle] -checkHandles check num = reverse <$> collectFree [] check num - where - collectFree free _ 0 = pure free - collectFree free [] _ = pure free - collectFree free (h : hs) n = - if isBlacklistedHandle h - then collectFree free hs n - else do - owner <- glimpseHandle h - case owner of - Nothing -> collectFree (h : free) hs (n - 1) - Just _ -> collectFree free hs n - ------------------------------------------------------------------------------- -- Change Email -- | Call 'changeEmail' and process result: if email changes to itself, succeed, if not, send -- validation email. -changeSelfEmail :: Member BlacklistStore r => UserId -> Email -> AllowSCIMUpdates -> ExceptT Error.Error (AppT r) ChangeEmailResponse +changeSelfEmail :: Member BlacklistStore r => UserId -> Email -> UpdateOriginType -> ExceptT Error.Error (AppT r) ChangeEmailResponse changeSelfEmail u email allowScim = do changeEmail u email allowScim !>> Error.changeEmailError >>= \case ChangeEmailIdempotent -> @@ -788,8 +618,8 @@ changeSelfEmail u email allowScim = do (userIdentity usr) -- | Prepare changing the email (checking a number of invariants). -changeEmail :: Member BlacklistStore r => UserId -> Email -> AllowSCIMUpdates -> ExceptT ChangeEmailError (AppT r) ChangeEmailResult -changeEmail u email allowScim = do +changeEmail :: Member BlacklistStore r => UserId -> Email -> UpdateOriginType -> ExceptT ChangeEmailError (AppT r) ChangeEmailResult +changeEmail u email updateOrigin = do em <- either (throwE . InvalidNewEmail email) @@ -808,11 +638,8 @@ changeEmail u email allowScim = do -- The user already has an email address and the new one is exactly the same Just current | current == em -> pure ChangeEmailIdempotent _ -> do - unless - ( userManagedBy usr /= ManagedByScim - || allowScim == AllowSCIMUpdates - ) - $ throwE EmailManagedByScim + unless (userManagedBy usr /= ManagedByScim || updateOrigin == UpdateOriginScim) $ + throwE EmailManagedByScim timeout <- setActivationTimeout <$> view settings act <- lift . wrapClient $ Data.newActivation ek timeout (Just u) pure $ ChangeEmailNeedsActivation (usr, act, em) @@ -857,7 +684,8 @@ removeEmail :: Member TinyLog r, Member (Input (Local ())) r, Member (Input UTCTime) r, - Member (ConnectionStore InternalPaging) r + Member (ConnectionStore InternalPaging) r, + Member UserSubsystem r ) => UserId -> ConnId -> @@ -881,7 +709,8 @@ removePhone :: Member TinyLog r, Member (Input (Local ())) r, Member (Input UTCTime) r, - Member (ConnectionStore InternalPaging) r + Member (ConnectionStore InternalPaging) r, + Member UserSubsystem r ) => UserId -> ConnId -> @@ -910,7 +739,8 @@ revokeIdentity :: Member TinyLog r, Member (Input (Local ())) r, Member (Input UTCTime) r, - Member (ConnectionStore InternalPaging) r + Member (ConnectionStore InternalPaging) r, + Member UserSubsystem r ) => Either Email Phone -> AppT r () @@ -1298,6 +1128,9 @@ mkPasswordResetKey ident = case ident of -- delete them in the team settings. This protects teams against orphanhood. -- -- TODO: communicate deletions of SSO users to SSO service. +-- +-- FUTUREWORK(mangoiv): this uses 'UserStore', hence it must be moved to 'UserSubsystem' +-- as an effet operation deleteSelfUser :: forall r. ( Member GalleyAPIAccess r, @@ -1305,6 +1138,7 @@ deleteSelfUser :: Member (Embed HttpClientIO) r, Member NotificationSubsystem r, Member (Input (Local ())) r, + Member UserStore r, Member (Input UTCTime) r, Member (ConnectionStore InternalPaging) r ) => @@ -1384,11 +1218,15 @@ deleteSelfUser uid pwd = do -- | Conclude validation and scheduling of user's deletion request that was initiated in -- 'deleteUser'. Called via @post /delete@. +-- +-- FUTUREWORK(mangoiv): this uses 'UserStore', hence it must be moved to 'UserSubsystem' +-- as an effet operation verifyDeleteUser :: ( Member (Embed HttpClientIO) r, Member NotificationSubsystem r, Member TinyLog r, Member (Input (Local ())) r, + Member UserStore r, Member (Input UTCTime) r, Member (ConnectionStore InternalPaging) r ) => @@ -1405,13 +1243,17 @@ verifyDeleteUser d = do -- | Check if `deleteAccount` succeeded and run it again if needed. -- Called via @delete /i/user/:uid@. +-- +-- FUTUREWORK(mangoiv): this uses 'UserStore', hence it must be moved to 'UserSubsystem' +-- as an effet operation ensureAccountDeleted :: ( Member (Embed HttpClientIO) r, Member NotificationSubsystem r, Member TinyLog r, Member (Input (Local ())) r, Member (Input UTCTime) r, - Member (ConnectionStore InternalPaging) r + Member (ConnectionStore InternalPaging) r, + Member UserStore r ) => UserId -> AppT r DeleteUserResult @@ -1448,54 +1290,42 @@ ensureAccountDeleted uid = do -- N.B.: As Cassandra doesn't support transactions, the order of database -- statements matters! Other functions reason upon some states to imply other -- states. Please change this order only with care! +-- +-- FUTUREWORK(mangoiv): this uses 'UserStore', hence it must be moved to 'UserSubsystem' +-- as an effet operation +-- FUTUREWORK: this does not need the whole UserAccount structure, only the User. deleteAccount :: ( Member (Embed HttpClientIO) r, Member NotificationSubsystem r, Member TinyLog r, Member (Input (Local ())) r, + Member UserStore r, Member (Input UTCTime) r, Member (ConnectionStore InternalPaging) r ) => UserAccount -> Sem r () -deleteAccount account@(accountUser -> user) = do +deleteAccount (accountUser -> user) = do let uid = userId user Log.info $ field "user" (toByteString uid) . msg (val "Deleting account") - embed $ do + do -- Free unique keys - for_ (userEmail user) $ deleteKeyForUser uid . userEmailKey - for_ (userPhone user) $ deleteKeyForUser uid . userPhoneKey - for_ (userHandle user) $ freeHandle (userId user) - -- Wipe data - Data.clearProperties uid - tombstone <- mkTombstone - Data.insertAccount tombstone Nothing Nothing False + for_ (userEmail user) $ embed . deleteKeyForUser uid . userEmailKey + for_ (userPhone user) $ embed . deleteKeyForUser uid . userPhoneKey + + embed $ Data.clearProperties uid + + deleteUser user + Intra.rmUser uid (userAssets user) embed $ Data.lookupClients uid >>= mapM_ (Data.rmClient uid . clientId) luid <- embed $ qualifyLocal uid Intra.onUserEvent uid Nothing (UserDeleted (tUntagged luid)) - embed $ do + embed do -- Note: Connections can only be deleted afterwards, since -- they need to be notified. Data.deleteConnections uid revokeAllCookies uid - where - mkTombstone = do - defLoc <- setDefaultUserLocale <$> view settings - pure $ - account - { accountStatus = Deleted, - accountUser = - user - { userDisplayName = Name "default", - userAccentId = defaultAccentId, - userPict = noPict, - userAssets = [], - userHandle = Nothing, - userLocale = defLoc, - userIdentity = Nothing - } - } ------------------------------------------------------------------------------- -- Lookups @@ -1572,7 +1402,7 @@ getLegalHoldStatus' user = -- | Find user accounts for a given identity, both activated and those -- currently pending activation. -lookupAccountsByIdentity :: Either Email Phone -> Bool -> (AppT r) [UserAccount] +lookupAccountsByIdentity :: Either Email Phone -> Bool -> AppT r [UserAccount] lookupAccountsByIdentity emailOrPhone includePendingInvitations = do let uk = either userEmailKey userPhoneKey emailOrPhone activeUid <- wrapClient $ Data.lookupKey uk @@ -1605,24 +1435,3 @@ phonePrefixDelete = liftSem . BlacklistPhonePrefixStore.delete phonePrefixInsert :: Member BlacklistPhonePrefixStore r => ExcludedPrefix -> (AppT r) () phonePrefixInsert = liftSem . BlacklistPhonePrefixStore.insert - -userUnderE2EId :: Member GalleyAPIAccess r => UserId -> Sem r Bool -userUnderE2EId uid = do - wsStatus . afcMlsE2EId <$> getAllFeatureConfigsForUser (Just uid) <&> \case - FeatureStatusEnabled -> True - FeatureStatusDisabled -> False - --- | This is a hack! --- --- Background: --- - https://wearezeta.atlassian.net/browse/WPB-6189. --- - comments in `testUpdateHandle` in `/integration`. --- --- FUTUREWORK: figure out a better way for clients to detect E2EId (V6?) -hackForBlockingHandleChangeForE2EIdTeams :: Member GalleyAPIAccess r => SelfProfile -> Sem r SelfProfile -hackForBlockingHandleChangeForE2EIdTeams (SelfProfile user) = do - hasE2EId <- userUnderE2EId . userId $ user - pure . SelfProfile $ - if (hasE2EId && isJust (userHandle user)) - then user {userManagedBy = ManagedByScim} - else user diff --git a/services/brig/src/Brig/API/Util.hs b/services/brig/src/Brig/API/Util.hs index 54f04975a51..947f761a511 100644 --- a/services/brig/src/Brig/API/Util.hs +++ b/services/brig/src/Brig/API/Util.hs @@ -18,7 +18,6 @@ module Brig.API.Util ( fetchUserIdentity, lookupProfilesMaybeFilterSameTeamOnly, - lookupSelfProfile, logInvitationCode, validateHandle, logEmail, @@ -47,7 +46,6 @@ import Data.Bifunctor import Data.Handle (Handle, parseHandle) import Data.Id import Data.Maybe -import Data.Qualified import Data.Text qualified as T import Data.Text.Ascii (AsciiText (toText)) import Imports @@ -60,9 +58,9 @@ import UnliftIO.Exception (throwIO, try) import Util.Logging (sha256String) import Wire.API.Error import Wire.API.Error.Brig -import Wire.API.Federation.Error import Wire.API.User import Wire.Sem.Concurrency qualified as C +import Wire.UserSubsystem lookupProfilesMaybeFilterSameTeamOnly :: UserId -> [UserProfile] -> (Handler r) [UserProfile] lookupProfilesMaybeFilterSameTeamOnly self us = do @@ -71,19 +69,14 @@ lookupProfilesMaybeFilterSameTeamOnly self us = do Just team -> filter (\x -> profileTeam x == Just team) us Nothing -> us -fetchUserIdentity :: UserId -> (AppT r) (Maybe UserIdentity) -fetchUserIdentity uid = - lookupSelfProfile uid +fetchUserIdentity :: Member UserSubsystem r => UserId -> AppT r (Maybe UserIdentity) +fetchUserIdentity uid = do + luid <- qualifyLocal uid + liftSem (getSelfProfile luid) >>= maybe (throwM $ UserProfileNotFound uid) (pure . userIdentity . selfUser) --- | Obtain a profile for a user as he can see himself. -lookupSelfProfile :: UserId -> (AppT r) (Maybe SelfProfile) -lookupSelfProfile = fmap (fmap mk) . wrapClient . Data.lookupAccount - where - mk a = SelfProfile (accountUser a) - validateHandle :: Text -> (Handler r) Handle validateHandle = maybe (throwStd (errorToWai @'InvalidHandle)) pure . parseHandle @@ -163,12 +156,6 @@ traverseConcurrentlyWithErrorsAppT f t = do exceptTToMaybe :: Monad m => ExceptT e m () -> m (Maybe e) exceptTToMaybe = (pure . either Just (const Nothing)) <=< runExceptT --- | Convert a qualified value into a local one. Throw if the value is not actually local. -ensureLocal :: Qualified a -> AppT r (Local a) -ensureLocal x = do - loc <- qualifyLocal () - foldQualified loc pure (\_ -> throwM federationNotImplemented) x - tryInsertVerificationCode :: Code.Code -> (RetryAfter -> e) -> ExceptT e (AppT r) () tryInsertVerificationCode code e = do ttl <- set2FACodeGenerationDelaySecs <$> view settings diff --git a/services/brig/src/Brig/App.hs b/services/brig/src/Brig/App.hs index 5c0547b26c1..643c2191749 100644 --- a/services/brig/src/Brig/App.hs +++ b/services/brig/src/Brig/App.hs @@ -73,6 +73,7 @@ module Brig.App viewFederationDomain, qualifyLocal, qualifyLocal', + ensureLocal, -- * Crutches that should be removed once Brig has been completely transitioned to Polysemy wrapClient, @@ -151,6 +152,7 @@ import System.Logger.Class hiding (Settings, settings) import System.Logger.Class qualified as LC import System.Logger.Extended qualified as Log import Util.Options +import Wire.API.Federation.Error (federationNotImplemented) import Wire.API.Routes.Version import Wire.API.User.Identity (Email) import Wire.API.User.Profile (Locale) @@ -636,3 +638,9 @@ qualifyLocal a = toLocalUnsafe <$> viewFederationDomain <*> pure a -- FUTUREWORK: rename to 'qualifyLocalPoly' qualifyLocal' :: (Member (Input (Local ()))) r => a -> Sem r (Local a) qualifyLocal' a = flip toLocalUnsafe a . tDomain <$> input + +-- | Convert a qualified value into a local one. Throw if the value is not actually local. +ensureLocal :: Qualified a -> AppT r (Local a) +ensureLocal x = do + loc <- qualifyLocal () + foldQualified loc pure (\_ -> throwM federationNotImplemented) x diff --git a/services/brig/src/Brig/CanonicalInterpreter.hs b/services/brig/src/Brig/CanonicalInterpreter.hs index f4ab597711e..e4d1da5f636 100644 --- a/services/brig/src/Brig/CanonicalInterpreter.hs +++ b/services/brig/src/Brig/CanonicalInterpreter.hs @@ -19,6 +19,7 @@ import Brig.Effects.PublicKeyBundle import Brig.Effects.SFT (SFT, interpretSFT) import Brig.Effects.UserPendingActivationStore (UserPendingActivationStore) import Brig.Effects.UserPendingActivationStore.Cassandra (userPendingActivationStoreToCassandra) +import Brig.IO.Intra (runUserEvents) import Brig.Options (ImplicitNoFederationRestriction (federationDomainConfig), federationDomainConfigs, federationStrategy) import Brig.Options qualified as Opt import Cassandra qualified as Cas @@ -28,6 +29,7 @@ import Control.Monad.Catch (throwM) import Data.Qualified (Local, toLocalUnsafe) import Data.Time.Clock (UTCTime, getCurrentTime) import Imports +import Network.Wai.Utilities qualified as Wai import Polysemy import Polysemy.Async import Polysemy.Conc @@ -55,6 +57,7 @@ import Wire.Sem.Logger.TinyLog (loggerToTinyLog) import Wire.Sem.Now (Now) import Wire.Sem.Now.IO (nowToIOAction) import Wire.Sem.Paging.Cassandra (InternalPaging) +import Wire.UserEvents import Wire.UserStore import Wire.UserStore.Cassandra import Wire.UserSubsystem @@ -63,7 +66,10 @@ import Wire.UserSubsystem.Interpreter type BrigCanonicalEffects = '[ UserSubsystem, DeleteQueue, + UserEvents, + Error UserSubsystemError, Error Wire.API.Federation.Error.FederationError, + Error Wai.Error, Wire.FederationAPIAccess.FederationAPIAccess Wire.API.Federation.Client.FederatorClient, UserStore, SFT, @@ -145,16 +151,19 @@ runBrigToIO e (AppT ma) = do . interpretSFT (e ^. httpManager) . interpretUserStoreCassandra (e ^. casClient) . interpretFederationAPIAccess federationApiAccessConfig - . throwFederationErrorAsWaiError + . rethrowWaiErrorIO + . mapError federationErrorToWai + . mapError userSubsystemErrorToWai + . runUserEvents . runDeleteQueue (e ^. internalEvents) . runUserSubsystem userSubsystemConfig ) ) $ runReaderT ma e -throwFederationErrorAsWaiError :: Member (Final IO) r => InterpreterFor (Error FederationError) r -throwFederationErrorAsWaiError action = do - eithError <- errorToIOFinal action +rethrowWaiErrorIO :: Member (Final IO) r => InterpreterFor (Error Wai.Error) r +rethrowWaiErrorIO act = do + eithError <- errorToIOFinal act case eithError of - Left err -> embedToFinal $ throwM $ federationErrorToWai err + Left err -> embedToFinal $ throwM $ err Right a -> pure a diff --git a/services/brig/src/Brig/Data/User.hs b/services/brig/src/Brig/Data/User.hs index 5eb86970276..f4b495e1c99 100644 --- a/services/brig/src/Brig/Data/User.hs +++ b/services/brig/src/Brig/Data/User.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE RecordWildCards #-} {-# OPTIONS_GHC -fno-warn-orphans #-} -- This file is part of the Wire Server implementation. @@ -51,7 +50,6 @@ module Brig.Data.User userExists, -- * Updates - updateUser, updateEmail, updateEmailUnvalidated, updatePhone, @@ -59,11 +57,8 @@ module Brig.Data.User updateManagedBy, activateUser, deactivateUser, - updateLocale, updatePassword, updateStatus, - updateHandle, - updateSupportedProtocols, updateRichInfo, updateFeatureConferenceCalling, @@ -283,18 +278,6 @@ insertAccount (UserAccount u status) mbConv password activated = retry x5 . batc "INSERT INTO service_team (provider, service, user, conv, team) \ \VALUES (?, ?, ?, ?, ?)" -updateLocale :: MonadClient m => UserId -> Locale -> m () -updateLocale u (Locale l c) = write userLocaleUpdate (params LocalQuorum (l, c, u)) - -updateUser :: MonadClient m => UserId -> UserUpdate -> m () -updateUser u UserUpdate {..} = retry x5 . batch $ do - setType BatchLogged - setConsistency LocalQuorum - for_ uupName $ \n -> addPrepQuery userDisplayNameUpdate (n, u) - for_ uupPict $ \p -> addPrepQuery userPictUpdate (p, u) - for_ uupAssets $ \a -> addPrepQuery userAssetsUpdate (a, u) - for_ uupAccentId $ \c -> addPrepQuery userAccentIdUpdate (c, u) - updateEmail :: MonadClient m => UserId -> Email -> m () updateEmail u e = retry x5 $ write userEmailUpdate (params LocalQuorum (e, u)) @@ -316,14 +299,6 @@ updateSSOId u ssoid = do updateManagedBy :: MonadClient m => UserId -> ManagedBy -> m () updateManagedBy u h = retry x5 $ write userManagedByUpdate (params LocalQuorum (h, u)) -updateHandle :: MonadClient m => UserId -> Handle -> m () -updateHandle u h = retry x5 $ write userHandleUpdate (params LocalQuorum (h, u)) - -updateSupportedProtocols :: MonadClient m => UserId -> Set BaseProtocolTag -> m () -updateSupportedProtocols u prots = - retry x5 $ - write userSupportedProtocolUpdate (params LocalQuorum (prots, u)) - updatePassword :: MonadClient m => UserId -> PlainTextPassword8 -> m () updatePassword u t = do p <- liftIO $ mkSafePassword t @@ -624,18 +599,6 @@ userInsert = \country, provider, service, handle, team, managed_by, supported_protocols) \ \VALUES (?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?)" -userDisplayNameUpdate :: PrepQuery W (Name, UserId) () -userDisplayNameUpdate = {- `IF EXISTS`, but that requires benchmarking -} "UPDATE user SET name = ? WHERE id = ?" - -userPictUpdate :: PrepQuery W (Pict, UserId) () -userPictUpdate = {- `IF EXISTS`, but that requires benchmarking -} "UPDATE user SET picture = ? WHERE id = ?" - -userAssetsUpdate :: PrepQuery W ([Asset], UserId) () -userAssetsUpdate = {- `IF EXISTS`, but that requires benchmarking -} "UPDATE user SET assets = ? WHERE id = ?" - -userAccentIdUpdate :: PrepQuery W (ColourId, UserId) () -userAccentIdUpdate = {- `IF EXISTS`, but that requires benchmarking -} "UPDATE user SET accent_id = ? WHERE id = ?" - userEmailUpdate :: PrepQuery W (Email, UserId) () userEmailUpdate = {- `IF EXISTS`, but that requires benchmarking -} "UPDATE user SET email = ? WHERE id = ?" @@ -654,12 +617,6 @@ userSSOIdUpdate = {- `IF EXISTS`, but that requires benchmarking -} "UPDATE user userManagedByUpdate :: PrepQuery W (ManagedBy, UserId) () userManagedByUpdate = {- `IF EXISTS`, but that requires benchmarking -} "UPDATE user SET managed_by = ? WHERE id = ?" -userHandleUpdate :: PrepQuery W (Handle, UserId) () -userHandleUpdate = {- `IF EXISTS`, but that requires benchmarking -} "UPDATE user SET handle = ? WHERE id = ?" - -userSupportedProtocolUpdate :: PrepQuery W (Set BaseProtocolTag, UserId) () -userSupportedProtocolUpdate = {- `IF EXISTS`, but that requires benchmarking -} "UPDATE user SET supported_protocols = ? WHERE id = ?" - userPasswordUpdate :: PrepQuery W (Password, UserId) () userPasswordUpdate = {- `IF EXISTS`, but that requires benchmarking -} "UPDATE user SET password = ? WHERE id = ?" @@ -672,9 +629,6 @@ userDeactivatedUpdate = {- `IF EXISTS`, but that requires benchmarking -} "UPDAT userActivatedUpdate :: PrepQuery W (Maybe Email, Maybe Phone, UserId) () userActivatedUpdate = {- `IF EXISTS`, but that requires benchmarking -} "UPDATE user SET activated = true, email = ?, phone = ? WHERE id = ?" -userLocaleUpdate :: PrepQuery W (Language, Maybe Country, UserId) () -userLocaleUpdate = {- `IF EXISTS`, but that requires benchmarking -} "UPDATE user SET language = ?, country = ? WHERE id = ?" - userEmailDelete :: PrepQuery W (Identity UserId) () userEmailDelete = {- `IF EXISTS`, but that requires benchmarking -} "UPDATE user SET email = null WHERE id = ?" diff --git a/services/brig/src/Brig/Data/UserKey.hs b/services/brig/src/Brig/Data/UserKey.hs index 11128014a24..a1769c68421 100644 --- a/services/brig/src/Brig/Data/UserKey.hs +++ b/services/brig/src/Brig/Data/UserKey.hs @@ -45,11 +45,7 @@ import Wire.API.User (fromEmail) data UserKey = UserEmailKey !EmailKey | UserPhoneKey !PhoneKey - -instance Eq UserKey where - (UserEmailKey k) == (UserEmailKey k') = k == k' - (UserPhoneKey k) == (UserPhoneKey k') = k == k' - _ == _ = False + deriving stock (Eq, Show) userEmailKey :: Email -> UserKey userEmailKey = UserEmailKey . mkEmailKey diff --git a/services/brig/src/Brig/IO/Intra.hs b/services/brig/src/Brig/IO/Intra.hs index c8e82c586d0..b550a667ab9 100644 --- a/services/brig/src/Brig/IO/Intra.hs +++ b/services/brig/src/Brig/IO/Intra.hs @@ -25,6 +25,9 @@ module Brig.IO.Intra onPropertyEvent, onClientEvent, + -- * user subsystem interpretation for user events + runUserEvents, + -- * Conversations createConnectConv, acceptConnectConv, @@ -49,7 +52,6 @@ import Bilge hiding (head, options, requestId) import Bilge.RPC import Brig.API.Error (internalServerError) import Brig.API.Types -import Brig.API.Util import Brig.App import Brig.Data.Connection import Brig.Data.Connection qualified as Data @@ -102,6 +104,7 @@ import Wire.Rpc import Wire.Sem.Logger qualified as Log import Wire.Sem.Paging qualified as P import Wire.Sem.Paging.Cassandra (InternalPaging) +import Wire.UserEvents ----------------------------------------------------------------------------- -- Event Handlers @@ -123,6 +126,19 @@ onUserEvent orig conn e = *> dispatchNotifications orig conn e *> embed (journalEvent orig e) +runUserEvents :: + ( Member (Embed HttpClientIO) r, + Member NotificationSubsystem r, + Member TinyLog r, + Member (Input (Local ())) r, + Member (Input UTCTime) r, + Member (ConnectionStore InternalPaging) r + ) => + InterpreterFor UserEvents r +runUserEvents = interpret \case + -- FUTUREWORK(mangoiv): should this be in another module? + GenerateUserEvent uid mconnid event -> onUserEvent uid mconnid event + onConnectionEvent :: (Member NotificationSubsystem r) => -- | Originator of the event. diff --git a/services/brig/src/Brig/InternalEvent/Process.hs b/services/brig/src/Brig/InternalEvent/Process.hs index b0e0ba1c870..484e4026e11 100644 --- a/services/brig/src/Brig/InternalEvent/Process.hs +++ b/services/brig/src/Brig/InternalEvent/Process.hs @@ -15,10 +15,7 @@ -- You should have received a copy of the GNU Affero General Public License along -- with this program. If not, see . -module Brig.InternalEvent.Process - ( onEvent, - ) -where +module Brig.InternalEvent.Process (onEvent) where import Brig.API.User qualified as API import Brig.App @@ -44,6 +41,7 @@ import Wire.API.UserEvent import Wire.NotificationSubsystem import Wire.Sem.Delay import Wire.Sem.Paging.Cassandra (InternalPaging) +import Wire.UserStore (UserStore) -- | Handle an internal event. -- @@ -56,6 +54,7 @@ onEvent :: Member Race r, Member (Input (Local ())) r, Member (Input UTCTime) r, + Member UserStore r, Member (ConnectionStore InternalPaging) r ) => InternalNotification -> diff --git a/services/brig/src/Brig/Team/API.hs b/services/brig/src/Brig/Team/API.hs index 46ce343f9e4..c488e657111 100644 --- a/services/brig/src/Brig/Team/API.hs +++ b/services/brig/src/Brig/Team/API.hs @@ -85,10 +85,12 @@ import Wire.GalleyAPIAccess qualified as GalleyAPIAccess import Wire.NotificationSubsystem import Wire.Sem.Concurrency import Wire.Sem.Paging.Cassandra (InternalPaging) +import Wire.UserSubsystem servantAPI :: ( Member BlacklistStore r, - Member GalleyAPIAccess r + Member GalleyAPIAccess r, + Member UserSubsystem r ) => ServerT TeamsAPI (Handler r) servantAPI = @@ -115,7 +117,8 @@ getInvitationCode t r = do createInvitationPublicH :: ( Member BlacklistStore r, - Member GalleyAPIAccess r + Member GalleyAPIAccess r, + Member UserSubsystem r ) => UserId -> TeamId -> @@ -137,7 +140,8 @@ data CreateInvitationInviter = CreateInvitationInviter createInvitationPublic :: ( Member BlacklistStore r, - Member GalleyAPIAccess r + Member GalleyAPIAccess r, + Member UserSubsystem r ) => UserId -> TeamId -> diff --git a/services/brig/src/Brig/User/API/Handle.hs b/services/brig/src/Brig/User/API/Handle.hs index f39fa56a7b0..bfa3407059a 100644 --- a/services/brig/src/Brig/User/API/Handle.hs +++ b/services/brig/src/Brig/User/API/Handle.hs @@ -42,13 +42,14 @@ import Wire.API.User import Wire.API.User qualified as Public import Wire.API.User.Search import Wire.API.User.Search qualified as Public +import Wire.UserStore (UserStore) import Wire.UserSubsystem getHandleInfo :: - (Member UserSubsystem r) => + (Member UserSubsystem r, Member UserStore r) => UserId -> Qualified Handle -> - (Handler r) (Maybe Public.UserProfile) + Handler r (Maybe Public.UserProfile) getHandleInfo self handle = do lself <- qualifyLocal self foldQualified @@ -57,7 +58,7 @@ getHandleInfo self handle = do getRemoteHandleInfo handle -getRemoteHandleInfo :: Remote Handle -> (Handler r) (Maybe Public.UserProfile) +getRemoteHandleInfo :: Remote Handle -> Handler r (Maybe Public.UserProfile) getRemoteHandleInfo handle = do lift . Log.info $ Log.msg (Log.val "getHandleInfo - remote lookup") @@ -65,13 +66,13 @@ getRemoteHandleInfo handle = do Federation.getUserHandleInfo handle !>> fedError getLocalHandleInfo :: - (Member UserSubsystem r) => + (Member UserSubsystem r, Member UserStore r) => Local UserId -> Handle -> - (Handler r) (Maybe Public.UserProfile) + Handler r (Maybe Public.UserProfile) getLocalHandleInfo self handle = do lift . Log.info $ Log.msg $ Log.val "getHandleInfo - local lookup" - maybeOwnerId <- lift . wrapClient $ API.lookupHandle handle + maybeOwnerId <- lift . liftSem $ API.lookupHandle handle case maybeOwnerId of Nothing -> pure Nothing Just ownerId -> do diff --git a/services/brig/src/Brig/User/API/Search.hs b/services/brig/src/Brig/User/API/Search.hs index 2d77a5e9119..4d9ae68862c 100644 --- a/services/brig/src/Brig/User/API/Search.hs +++ b/services/brig/src/Brig/User/API/Search.hs @@ -40,7 +40,7 @@ import Brig.User.Search.SearchIndex qualified as Q import Brig.User.Search.TeamUserSearch qualified as Q import Control.Lens (view) import Data.Domain (Domain) -import Data.Handle (parseHandle) +import Data.Handle qualified as Handle import Data.Id import Data.Range import Imports @@ -59,6 +59,7 @@ import Wire.API.User.Search import Wire.API.User.Search qualified as Public import Wire.GalleyAPIAccess (GalleyAPIAccess) import Wire.GalleyAPIAccess qualified as GalleyAPIAccess +import Wire.UserStore (UserStore) import Wire.UserSubsystem -- FUTUREWORK: Consider augmenting 'SearchResult' with full user profiles @@ -66,6 +67,7 @@ import Wire.UserSubsystem search :: ( Member GalleyAPIAccess r, Member FederationConfigStore r, + Member UserStore r, Member UserSubsystem r ) => UserId -> @@ -116,7 +118,8 @@ searchRemotely domain mTid searchTerm = do searchLocally :: forall r. ( Member GalleyAPIAccess r, - Member UserSubsystem r + Member UserSubsystem r, + Member UserStore r ) => UserId -> Text -> @@ -165,7 +168,7 @@ searchLocally searcherId searchTerm maybeMaxResults = do exactHandleSearch :: (Handler r) (Maybe Contact) exactHandleSearch = do lsearcherId <- qualifyLocal searcherId - case parseHandle searchTerm of + case Handle.parseHandle searchTerm of Nothing -> pure Nothing Just handle -> do HandleAPI.contactFromProfile diff --git a/services/brig/src/Brig/User/Auth.hs b/services/brig/src/Brig/User/Auth.hs index 481a8b8cafa..12447d3e336 100644 --- a/services/brig/src/Brig/User/Auth.hs +++ b/services/brig/src/Brig/User/Auth.hs @@ -53,7 +53,6 @@ import Brig.Options qualified as Opt import Brig.Phone import Brig.Types.Intra import Brig.User.Auth.Cookie -import Brig.User.Handle import Brig.User.Phone import Brig.ZAuth qualified as ZAuth import Cassandra @@ -87,6 +86,8 @@ import Wire.GalleyAPIAccess (GalleyAPIAccess) import Wire.GalleyAPIAccess qualified as GalleyAPIAccess import Wire.NotificationSubsystem import Wire.Sem.Paging.Cassandra (InternalPaging) +import Wire.UserStore +import Wire.UserStore.Cassandra (interpretUserStoreCassandra) sendLoginCode :: (Member TinyLog r) => @@ -163,7 +164,7 @@ login (PasswordLogin (PasswordLoginData li pw label code)) typ = do VerificationCodeRequired -> wrapHttpClientE $ loginFailedWith LoginCodeRequired uid VerificationCodeNoEmail -> wrapHttpClientE $ loginFailed uid login (SmsLogin (SmsLoginData phone code label)) typ = do - uid <- wrapHttpClientE $ resolveLoginId (LoginByPhone phone) + uid <- wrapClientE $ resolveLoginId (LoginByPhone phone) lift . liftSem . Log.debug $ field "user" (toByteString uid) . field "action" (val "User.login") wrapHttpClientE $ checkRetryLimit uid ok <- wrapHttpClientE $ Data.verifyLoginCode uid code @@ -329,9 +330,14 @@ newAccess uid cid ct cl = do t <- lift $ newAccessToken @u @a ck Nothing pure $ Access t (Just ck) -resolveLoginId :: (MonadClient m, MonadReader Env m) => LoginId -> ExceptT LoginError m UserId +resolveLoginId :: forall m. (MonadClient m, MonadReader Env m) => LoginId -> ExceptT LoginError m UserId resolveLoginId li = do - usr <- validateLoginId li >>= lift . either lookupKey lookupHandle + let adhocInterpreter :: Sem '[UserStore, Embed IO] a -> m a + adhocInterpreter action = do + clientState <- asks (view casClient) + liftIO (runM (interpretUserStoreCassandra clientState action)) + + usr <- validateLoginId li >>= lift . either lookupKey (adhocInterpreter . lookupHandle) case usr of Nothing -> do pending <- lift $ isPendingActivation li diff --git a/services/brig/src/Brig/User/EJPD.hs b/services/brig/src/Brig/User/EJPD.hs index 713d4dedc22..4b9ec8fcb4b 100644 --- a/services/brig/src/Brig/User/EJPD.hs +++ b/services/brig/src/Brig/User/EJPD.hs @@ -48,11 +48,14 @@ import Wire.GalleyAPIAccess (GalleyAPIAccess) import Wire.GalleyAPIAccess qualified as GalleyAPIAccess import Wire.NotificationSubsystem import Wire.Rpc +import Wire.UserStore (UserStore) +-- FUTUREWORK(mangoiv): this uses 'UserStore' and should hence go to 'UserSubSystem' ejpdRequest :: forall r. ( Member GalleyAPIAccess r, Member NotificationSubsystem r, + Member UserStore r, Member Rpc r ) => Maybe Bool -> @@ -62,9 +65,9 @@ ejpdRequest (fromMaybe False -> includeContacts) (EJPDRequestBody handles) = do ExceptT $ Right . EJPDResponseBody . catMaybes <$> forM handles responseItemForHandle where -- find uid given handle - responseItemForHandle :: Handle -> (AppT r) (Maybe EJPDResponseItemRoot) + responseItemForHandle :: Handle -> AppT r (Maybe EJPDResponseItemRoot) responseItemForHandle hdl = do - mbUid <- wrapClient $ lookupHandle hdl + mbUid <- liftSem $ lookupHandle hdl mbUsr <- maybe (pure Nothing) (wrapClient . lookupUser NoPendingInvitations) mbUid maybe (pure Nothing) (fmap Just . responseItemForExistingUser includeContacts) mbUsr diff --git a/services/brig/src/Brig/User/Handle.hs b/services/brig/src/Brig/User/Handle.hs deleted file mode 100644 index fd62c770c3c..00000000000 --- a/services/brig/src/Brig/User/Handle.hs +++ /dev/null @@ -1,100 +0,0 @@ --- This file is part of the Wire Server implementation. --- --- Copyright (C) 2022 Wire Swiss GmbH --- --- This program is free software: you can redistribute it and/or modify it under --- the terms of the GNU Affero General Public License as published by the Free --- Software Foundation, either version 3 of the License, or (at your option) any --- later version. --- --- This program is distributed in the hope that it will be useful, but WITHOUT --- ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS --- FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for more --- details. --- --- You should have received a copy of the GNU Affero General Public License along --- with this program. If not, see . - --- | Ownership of unique user handles. -module Brig.User.Handle - ( claimHandle, - freeHandle, - lookupHandle, - glimpseHandle, - ) -where - -import Brig.App -import Brig.CanonicalInterpreter (runBrigToIO) -import Brig.Data.User qualified as User -import Brig.Unique -import Cassandra -import Data.Handle (Handle, fromHandle) -import Data.Id -import Imports - --- | Claim a new handle for an existing 'User'. -claimHandle :: (MonadClient m, MonadReader Env m) => UserId -> Maybe Handle -> Handle -> m Bool -claimHandle uid oldHandle newHandle = - isJust <$> do - owner <- lookupHandle newHandle - case owner of - Just uid' | uid /= uid' -> pure Nothing - _ -> do - env <- ask - let key = "@" <> fromHandle newHandle - withClaim uid key (30 # Minute) $ - runBrigToIO env $ - do - -- Record ownership - wrapClient $ retry x5 $ write handleInsert (params LocalQuorum (newHandle, uid)) - -- Update profile - result <- wrapClient $ User.updateHandle uid newHandle - -- Free old handle (if it changed) - for_ (mfilter (/= newHandle) oldHandle) $ - wrapClient . freeHandle uid - pure result - --- | Free a 'Handle', making it available to be claimed again. -freeHandle :: MonadClient m => UserId -> Handle -> m () -freeHandle uid h = do - mbHandleUid <- lookupHandle h - case mbHandleUid of - Just handleUid | handleUid == uid -> do - retry x5 $ write handleDelete (params LocalQuorum (Identity h)) - let key = "@" <> fromHandle h - deleteClaim uid key (30 # Minute) - _ -> pure () -- this shouldn't happen, the call side should always check that `h` and `uid` belong to the same account. - --- | Lookup the current owner of a 'Handle'. -lookupHandle :: MonadClient m => Handle -> m (Maybe UserId) -lookupHandle = lookupHandleWithPolicy LocalQuorum - --- | A weaker version of 'lookupHandle' that trades availability --- (and potentially speed) for the possibility of returning stale data. -glimpseHandle :: MonadClient m => Handle -> m (Maybe UserId) -glimpseHandle = lookupHandleWithPolicy One - -{-# INLINE lookupHandleWithPolicy #-} - --- | Sending an empty 'Handle' here causes C* to throw "Key may not be empty" --- error. --- --- FUTUREWORK: This should ideally be tackled by hiding constructor for 'Handle' --- and only allowing it to be parsed. -lookupHandleWithPolicy :: MonadClient m => Consistency -> Handle -> m (Maybe UserId) -lookupHandleWithPolicy policy h = do - (runIdentity =<<) - <$> retry x1 (query1 handleSelect (params policy (Identity h))) - --------------------------------------------------------------------------------- --- Queries - -handleInsert :: PrepQuery W (Handle, UserId) () -handleInsert = "INSERT INTO user_handle (handle, user) VALUES (?, ?)" - -handleSelect :: PrepQuery R (Identity Handle) (Identity (Maybe UserId)) -handleSelect = "SELECT user FROM user_handle WHERE handle = ?" - -handleDelete :: PrepQuery W (Identity Handle) () -handleDelete = "DELETE FROM user_handle WHERE handle = ?" diff --git a/services/brig/test/integration/API/Team.hs b/services/brig/test/integration/API/Team.hs index 350fb894d66..5b56b4f414b 100644 --- a/services/brig/test/integration/API/Team.hs +++ b/services/brig/test/integration/API/Team.hs @@ -35,10 +35,12 @@ import Control.Monad.Catch (MonadCatch) import Data.Aeson import Data.ByteString.Conversion import Data.ByteString.Lazy (toStrict) +import Data.Default (def) import Data.Either.Extra (eitherToMaybe) import Data.Id import Data.Json.Util (UTCTimeMillis, toUTCTimeMillis) import Data.LegalHold (UserLegalHoldStatus (UserLegalHoldDisabled)) +import Data.String.Conversions (cs) import Data.Text qualified as Text import Data.Text.Ascii qualified as Ascii import Data.Text.Encoding (encodeUtf8) @@ -269,7 +271,7 @@ invitationUrlGalleyMock :: UserId -> ReceivedRequest -> MockT IO Wai.Response -invitationUrlGalleyMock featureStatus tid inviter (ReceivedRequest mth pth _body) +invitationUrlGalleyMock featureStatus tid inviter (ReceivedRequest mth pth body_) | mth == "GET" && pth == ["i", "teams", Text.pack (show tid), "features", "exposeInvitationURLsToTeamAdmin"] = pure . Wai.responseLBS HTTP.status200 mempty $ @@ -284,7 +286,18 @@ invitationUrlGalleyMock featureStatus tid inviter (ReceivedRequest mth pth _body && pth == ["i", "teams", Text.pack (show tid), "members", Text.pack (show inviter)] = pure . Wai.responseLBS HTTP.status200 mempty $ encode (mkTeamMember inviter fullPermissions Nothing UserLegalHoldDisabled) - | otherwise = pure $ Wai.responseLBS HTTP.status500 mempty "Unexpected request to mocked galley" + | mth == "GET" + && pth == ["i", "feature-configs"] = + pure $ Wai.responseLBS HTTP.status200 mempty (encode (def @AllFeatureConfigs)) + | otherwise = + let errBody = + encode . object $ + [ "msg" .= ("unexpecUnexpected request to mocked galley" :: Text), + "method" .= show mth, + "path" .= pth, + "body" .= (cs @_ @Text body_) + ] + in pure $ Wai.responseLBS HTTP.status500 mempty errBody -- FUTUREWORK: This test should be rewritten to be free of mocks once Galley is -- inlined into Brig. diff --git a/services/brig/test/integration/API/User/Account.hs b/services/brig/test/integration/API/User/Account.hs index ecf78a9a474..388a4a97fa2 100644 --- a/services/brig/test/integration/API/User/Account.hs +++ b/services/brig/test/integration/API/User/Account.hs @@ -1062,6 +1062,10 @@ testUserLocaleUpdate brig userJournalWatcher = do let locEN = fromMaybe (error "Failed to parse locale") $ parseLocale "en-US" put (brig . path "/self/locale" . contentJson . zUser uid . zConn "c" . locale locEN) !!! const 200 === statusCode + get (brig . path "/self" . contentJson . zUser uid . zConn "c") + !!! do + const 200 === statusCode + const (Just locEN) === (Just . userLocale . selfUser <=< responseJsonMaybe) Util.assertLocaleUpdateJournaled userJournalWatcher uid locEN "user update" -- update locale info with locale NOT supported in templates let locPT = fromMaybe (error "Failed to parse locale") $ parseLocale "pt-PT" From 520964b8b337354a4e1ac7328089f039b7abbd61 Mon Sep 17 00:00:00 2001 From: Matthias Fischmann Date: Thu, 6 Jun 2024 17:10:02 +0200 Subject: [PATCH 22/64] Make Handle newtype abstract (#4076) --- changelog.d/5-internal/make-handle-abstract | 1 + libs/types-common/src/Data/Handle.hs | 2 +- .../Golden/Generated/BotUserView_provider.hs | 65 ++++++------------- .../Wire/API/Golden/Generated/LoginId_user.hs | 20 +++--- .../Wire/API/Golden/Generated/Login_user.hs | 15 ++--- .../Generated/NewBotRequest_provider.hs | 50 +++++--------- .../API/Golden/Generated/SelfProfile_user.hs | 4 +- .../API/Golden/Generated/UserProfile_user.hs | 9 +-- .../Wire/API/Golden/Generated/User_user.hs | 18 ++--- .../src/Wire/UserStore/Cassandra.hs | 3 - .../src/Wire/UserSubsystem/HandleBlacklist.hs | 12 ++-- .../Wire/UserSubsystem/InterpreterSpec.hs | 18 ++--- services/brig/src/Brig/API/Internal.hs | 4 +- .../brig/test/integration/API/Federation.hs | 4 +- .../brig/test/integration/API/Provider.hs | 4 +- .../brig/test/integration/API/User/Account.hs | 4 +- .../brig/test/integration/API/User/Auth.hs | 4 +- .../brig/test/integration/API/User/Handles.hs | 8 +-- .../brig/test/integration/API/User/Util.hs | 4 +- services/spar/src/Spar/Intra/BrigApp.hs | 4 +- services/spar/src/Spar/Scim/User.hs | 4 +- .../Test/Spar/Scim/UserSpec.hs | 12 ++-- services/spar/test-integration/Util/Core.hs | 4 +- services/spar/test-integration/Util/Scim.hs | 4 +- tools/stern/test/integration/API.hs | 4 +- 25 files changed, 107 insertions(+), 174 deletions(-) create mode 100644 changelog.d/5-internal/make-handle-abstract diff --git a/changelog.d/5-internal/make-handle-abstract b/changelog.d/5-internal/make-handle-abstract new file mode 100644 index 00000000000..5816db8a58b --- /dev/null +++ b/changelog.d/5-internal/make-handle-abstract @@ -0,0 +1 @@ +Make `Handle` type abstract to guarantee it always contains *valid* Handles. \ No newline at end of file diff --git a/libs/types-common/src/Data/Handle.hs b/libs/types-common/src/Data/Handle.hs index 6c9a6884f3b..64842b51e70 100644 --- a/libs/types-common/src/Data/Handle.hs +++ b/libs/types-common/src/Data/Handle.hs @@ -18,7 +18,7 @@ -- with this program. If not, see . module Data.Handle - ( Handle (..), + ( Handle (fromHandle), parseHandle, parseHandleEither, isValidHandle, diff --git a/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated/BotUserView_provider.hs b/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated/BotUserView_provider.hs index ea1d54154e9..b7f8b05f8c9 100644 --- a/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated/BotUserView_provider.hs +++ b/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated/BotUserView_provider.hs @@ -17,7 +17,7 @@ module Test.Wire.API.Golden.Generated.BotUserView_provider where -import Data.Handle (Handle (Handle, fromHandle)) +import Data.Handle (parseHandle) import Data.Id (Id (Id)) import Data.UUID qualified as UUID (fromString) import Imports (Maybe (Just, Nothing), fromJust) @@ -34,7 +34,7 @@ testObject_BotUserView_provider_1 = "\DC1\26122U5z$\CAN\GS t1\RS\\\STX\163323_4K\1108113\1030339\78439)\DC3\171456\FS\1039863\1089420n\7092\1008914\\4Nn;\171427)\182846y\SO\n|\DEL1#pK\51301b\t\132598+\SOH\5517\DELjJ\179985\191367Z `$" }, botUserViewColour = ColourId {fromColourId = -8}, - botUserViewHandle = Just (Handle {fromHandle = "fpa2vx"}), + botUserViewHandle = Just (fromJust (parseHandle "fpa2vx")), botUserViewTeam = Just (Id (fromJust (UUID.fromString "00000000-0000-0002-0000-000200000002"))) } @@ -48,7 +48,7 @@ testObject_BotUserView_provider_2 = "v\1099438\1020222\SOM\989617\t\ETB\\\1068888\187702nE7?\SOH:\r\1050763m \1065605}Y\989133b_\DLEDVa\1054567uJJ|\1086658\US)\DC3C" }, botUserViewColour = ColourId {fromColourId = -5}, - botUserViewHandle = Just (Handle {fromHandle = "mz"}), + botUserViewHandle = Just (fromJust (parseHandle "mz")), botUserViewTeam = Nothing } @@ -68,7 +68,7 @@ testObject_BotUserView_provider_4 = { botUserViewId = Id (fromJust (UUID.fromString "00000008-0000-0004-0000-000300000007")), botUserViewName = Name {fromName = "\SUB\STX)gKj\FS\1076685\v6cg\f]N!t\\\1017810\&8\70320\&7I\ETXCS\DC4e\FS\FS"}, botUserViewColour = ColourId {fromColourId = -2}, - botUserViewHandle = Just (Handle {fromHandle = "7.w"}), + botUserViewHandle = Just (fromJust (parseHandle "7.w")), botUserViewTeam = Just (Id (fromJust (UUID.fromString "00000004-0000-0000-0000-000200000000"))) } @@ -78,7 +78,7 @@ testObject_BotUserView_provider_5 = { botUserViewId = Id (fromJust (UUID.fromString "00000002-0000-0001-0000-000500000008")), botUserViewName = Name {fromName = "w"}, botUserViewColour = ColourId {fromColourId = -1}, - botUserViewHandle = Just (Handle {fromHandle = "tidlyhr"}), + botUserViewHandle = Just (fromJust (parseHandle "tidlyhr")), botUserViewTeam = Just (Id (fromJust (UUID.fromString "00000002-0000-0004-0000-000800000005"))) } @@ -93,7 +93,7 @@ testObject_BotUserView_provider_6 = }, botUserViewColour = ColourId {fromColourId = -5}, botUserViewHandle = - Just (Handle {fromHandle = "uz3cgdxtkev-40624m0eh_y06g-c9isv-ob.r84rneq2vm.440nxc_n44_3d0-6u9l7"}), + Just (fromJust (parseHandle "uz3cgdxtkev-40624m0eh_y06g-c9isv-ob.r84rneq2vm.440nxc_n44_3d0-6u9l7")), botUserViewTeam = Just (Id (fromJust (UUID.fromString "00000003-0000-0003-0000-000300000001"))) } @@ -107,7 +107,7 @@ testObject_BotUserView_provider_7 = "}$d}\RSY\1064459\1052613\96622np\1076823_\150435\1064267\&4rNy,U\1047882\&7\1005658\NAK2" }, botUserViewColour = ColourId {fromColourId = -1}, - botUserViewHandle = Just (Handle {fromHandle = "j4z9ty7y-wt_ldl_tddmmrhdfp4myz9fjrqdg2dkh5r9vxcs5z"}), + botUserViewHandle = Just (fromJust (parseHandle "j4z9ty7y-wt_ldl_tddmmrhdfp4myz9fjrqdg2dkh5r9vxcs5z")), botUserViewTeam = Just (Id (fromJust (UUID.fromString "00000006-0000-0004-0000-000300000004"))) } @@ -240,7 +225,7 @@ testObject_BotUserView_provider_16 = "W0\DC23\179352_\150603\&9\1081508\41244!\USNh\1010987\48629\1008710+\30291\147681S\23109\94906H[sp^\EOT(\r\184575\v>I{G\CAN\1090476\129048\FS\GS\181835K\1026670oOJ\USB]t\1042482L wY\1027509\11746\DC4l5Y\46221[,TcoF~_\ENQ\r\42008\136798\ETB" }, botUserViewColour = ColourId {fromColourId = -4}, - botUserViewHandle = Just (Handle {fromHandle = "_mvtpq.f"}), + botUserViewHandle = Just (fromJust (parseHandle "_mvtpq.f")), botUserViewTeam = Just (Id (fromJust (UUID.fromString "00000005-0000-0001-0000-000700000005"))) } @@ -254,7 +239,7 @@ testObject_BotUserView_provider_17 = ")o}s)\181243+0\EOT\154402C\1048068\1060448\SID[c c\r\1108938$'f6\1002325 ~|,A\f\32588\FSJ\1011697?\166257MJp\1738\DEL\DC2:}B'\DLEQ\54387\136046\1057923\DC2A\DC4\140654\SOH\r\1012989\DC1\188221\1007075?" }, botUserViewColour = ColourId {fromColourId = 1}, - botUserViewHandle = Just (Handle {fromHandle = "f.xl"}), + botUserViewHandle = Just (fromJust (parseHandle "f.xl")), botUserViewTeam = Nothing } @@ -268,7 +253,7 @@ testObject_BotUserView_provider_18 = "\988095\134570T^ff6\SOH6@\DEL\1025500%\1044243\FSvM_s\176\ETB$K\1095116.\NAKm[\US\128932\EOT\SOH)\178049f\134315\1041068\&0kTn!9\SIL\1024745\n\a\1029970\\K(\146913\150726\SUB\NUL\1000860^W?\SOn|-\nR<\1099109\1046581\1036758\157276\GSQu\NAK\46380\FS\50047\1049174\183149\1111902b4\USly\DEL`'X%$mW]k\1051138\98086" }, botUserViewColour = ColourId {fromColourId = -7}, - botUserViewHandle = Just (Handle {fromHandle = "b-p"}), + botUserViewHandle = Just (fromJust (parseHandle "b-p")), botUserViewTeam = Just (Id (fromJust (UUID.fromString "00000002-0000-0003-0000-000700000006"))) } @@ -279,12 +264,7 @@ testObject_BotUserView_provider_19 = botUserViewName = Name {fromName = "\CAN0\STX\STX\SOH='\b\ETX\119524Y8\1048503 \EMa\72317\134511,q\SOH'"}, botUserViewColour = ColourId {fromColourId = -1}, botUserViewHandle = - Just - ( Handle - { fromHandle = - "g_ms.jaq23mkzzhouss60itfsrux5lapflg0xqotoz76f-ori4aglkqwj-raa_wr4ypirq9c9-w17nwre3414mvmm-vgetkk-07k1dgekjrzcvk-_w33giuc8wcak590c29h457nks5xzpn6tq0wtcorgq7210uaminql8ygrklj3vh11p.sg-nrbnmm2.dxmo0zzhr3xco" - } - ), + Just (fromJust (parseHandle "g_ms.jaq23mkzzhouss60itfsrux5lapflg0xqotoz76f-ori4aglkqwj-raa_wr4ypirq9c9-w17nwre3414mvmm-vgetkk-07k1dgekjrzcvk-_w33giuc8wcak590c29h457nks5xzpn6tq0wtcorgq7210uaminql8ygrklj3vh11p.sg-nrbnmm2.dxmo0zzhr3xco")), botUserViewTeam = Just (Id (fromJust (UUID.fromString "00000006-0000-0000-0000-000400000008"))) } @@ -299,11 +279,6 @@ testObject_BotUserView_provider_20 = }, botUserViewColour = ColourId {fromColourId = -8}, botUserViewHandle = - Just - ( Handle - { fromHandle = - "p35n6vhgb5sh71n.-har73f0tp1urvyml_5ni8n01ommlrlx5chb9z7bhp_rehr1geua0--yxs5x3m3dgmvhy8-a-07gbc0owxv2d9mj_pqzss9op.ovxyrid8l36nkw1b5f4sr2.li7bmtmcwe76.zxj9lwbqtqt8v77v6ncnmebtl3whz6790x34rcyqe.jxc6glk2-7d.janj7d1.c70bjkjpzqp0pi64hoiei854tefqdlz246bht" - } - ), + Just (fromJust (parseHandle "p35n6vhgb5sh71n.-har73f0tp1urvyml_5ni8n01ommlrlx5chb9z7bhp_rehr1geua0--yxs5x3m3dgmvhy8-a-07gbc0owxv2d9mj_pqzss9op.ovxyrid8l36nkw1b5f4sr2.li7bmtmcwe76.zxj9lwbqtqt8v77v6ncnmebtl3whz6790x34rcyqe.jxc6glk2-7d.janj7d1.c70bjkjpzqp0pi64hoiei854tefqdlz246bht")), botUserViewTeam = Just (Id (fromJust (UUID.fromString "00000006-0000-0004-0000-000700000004"))) } diff --git a/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated/LoginId_user.hs b/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated/LoginId_user.hs index f1c087404af..117789dfdf7 100644 --- a/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated/LoginId_user.hs +++ b/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated/LoginId_user.hs @@ -17,7 +17,8 @@ module Test.Wire.API.Golden.Generated.LoginId_user where -import Data.Handle (Handle (Handle, fromHandle)) +import Data.Handle (parseHandle) +import Data.Maybe import Wire.API.User (Email (Email, emailDomain, emailLocal), Phone (Phone, fromPhone)) import Wire.API.User.Auth (LoginId (..)) @@ -39,7 +40,7 @@ testObject_LoginId_user_3 = ) testObject_LoginId_user_4 :: LoginId -testObject_LoginId_user_4 = LoginByHandle (Handle {fromHandle = "7a8gg3v98"}) +testObject_LoginId_user_4 = LoginByHandle (fromJust (parseHandle "7a8gg3v98")) testObject_LoginId_user_5 :: LoginId testObject_LoginId_user_5 = LoginByPhone (Phone {fromPhone = "+041157889572"}) @@ -48,7 +49,7 @@ testObject_LoginId_user_6 :: LoginId testObject_LoginId_user_6 = LoginByPhone (Phone {fromPhone = "+2351341820189"}) testObject_LoginId_user_7 :: LoginId -testObject_LoginId_user_7 = LoginByHandle (Handle {fromHandle = "lb"}) +testObject_LoginId_user_7 = LoginByHandle (fromJust (parseHandle "lb")) testObject_LoginId_user_8 :: LoginId testObject_LoginId_user_8 = LoginByPhone (Phone {fromPhone = "+2831673805093"}) @@ -58,12 +59,7 @@ testObject_LoginId_user_9 = LoginByPhone (Phone {fromPhone = "+1091378734554"}) testObject_LoginId_user_10 :: LoginId testObject_LoginId_user_10 = - LoginByHandle - ( Handle - { fromHandle = - "z58-6fbjhtx11d8t6oplyijpkc2.fp_lf3kpk3_.qle4iecjun2xd0tpcordlg2bwv636v3cthpgwah3undqmuofgzp8ry6gc6g-n-kxnj7sl6771hxou7-t_ps_lu_t3.4ukz6dh6fkjq2i3aggtkbpzbd1162.qv.rbtb6e.90-xpayg65z9t9lk2aur452zcs9a" - } - ) + LoginByHandle (fromJust (parseHandle "z58-6fbjhtx11d8t6oplyijpkc2.fp_lf3kpk3_.qle4iecjun2xd0tpcordlg2bwv636v3cthpgwah3undqmuofgzp8ry6gc6g-n-kxnj7sl6771hxou7-t_ps_lu_t3.4ukz6dh6fkjq2i3aggtkbpzbd1162.qv.rbtb6e.90-xpayg65z9t9lk2aur452zcs9a")) testObject_LoginId_user_11 :: LoginId testObject_LoginId_user_11 = @@ -110,14 +106,14 @@ testObject_LoginId_user_16 = ) testObject_LoginId_user_17 :: LoginId -testObject_LoginId_user_17 = LoginByHandle (Handle {fromHandle = "e3iusdy"}) +testObject_LoginId_user_17 = LoginByHandle (fromJust (parseHandle "e3iusdy")) testObject_LoginId_user_18 :: LoginId testObject_LoginId_user_18 = - LoginByHandle (Handle {fromHandle = "8vpices3usz1dfs4u2lf_e3jendod_szl1z111_eoj4b7k7ajj-xo.qzbw4espf3smnz_"}) + LoginByHandle (fromJust (parseHandle "8vpices3usz1dfs4u2lf_e3jendod_szl1z111_eoj4b7k7ajj-xo.qzbw4espf3smnz_")) testObject_LoginId_user_19 :: LoginId -testObject_LoginId_user_19 = LoginByHandle (Handle {fromHandle = "3jzpp2bo8"}) +testObject_LoginId_user_19 = LoginByHandle (fromJust (parseHandle "3jzpp2bo8")) testObject_LoginId_user_20 :: LoginId testObject_LoginId_user_20 = LoginByEmail (Email {emailLocal = "", emailDomain = "\155899"}) diff --git a/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated/Login_user.hs b/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated/Login_user.hs index cb3c93848e4..e0b6a4cf88a 100644 --- a/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated/Login_user.hs +++ b/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated/Login_user.hs @@ -18,11 +18,12 @@ module Test.Wire.API.Golden.Generated.Login_user where import Data.Code -import Data.Handle (Handle (Handle, fromHandle)) +import Data.Handle (parseHandle) +import Data.Maybe import Data.Misc (plainTextPassword6Unsafe) import Data.Range (unsafeRange) import Data.Text.Ascii (AsciiChars (validate)) -import Imports (Maybe (Just, Nothing), fromRight, undefined) +import Imports import Wire.API.User (Email (Email, emailDomain, emailLocal), Phone (Phone, fromPhone)) import Wire.API.User.Auth @@ -51,7 +52,7 @@ testObject_Login_user_3 :: Login testObject_Login_user_3 = PasswordLogin ( PasswordLoginData - (LoginByHandle (Handle {fromHandle = "c2wp.7s5."})) + (LoginByHandle (fromJust (parseHandle "c2wp.7s5."))) ( plainTextPassword6Unsafe "&\RS\DC4\1104052Z\11418n\SO\158691\1010906/\127253'\1063038m\1010345\"\9772\138717\RS(&\996590\SOf1Wf'I\SI\100286\1047270\1033961\DC1Jq\1050673Y\\Bedu@\1014647c\1003986D\53211\1050614S\144414\ETX\ETXW>\1005358\DC4\rSO8FXy\166833a\EM\170017\SUBNF\158145L\RS$5\NULk\RSz*s\148780\157980\v\175417\"SY\DEL\STX\994691\1103514ub5q\ENQ\1014299\vN.\t\183536:l\1105396\RS\1027721\a\168001\SO\vt\1098704W\SYN\1042396\1109979\a'v\ETB\64211\NAK\59538\STX \NAK\STX\49684,\1111630x\1047668^\1067127\27366I;\NAKb\1092049o\162763_\190546MME\1022528\SI\1096252H;\SO\ETBs\SO\1065937{Knlrd;\35750\DC4\SI\1075008TO\1090529\999639U\48787\1099927t\1068680^y\17268u$\DC1Jp\1054308\164905\164446\STX\"\1095399*\SO\1004302\32166\990924X\1098844\ETXsK}\b\143918\NUL0\988724\&12\171116\tM052\189551\EOT0\RS\986138\1084688{ji\ESC\1020800\27259&t \SI\ESCy\aL\136111\131558\994027\r\1054821ga,\DC4do,tx[I&\DC4h\DLE\ETX\DLEBpm\1002292-\a]/ZI\1033117q]w3n\46911e\23692kYo5\1090844'K\1089820}v\146759;\1018792\\=\41264\&8g\DLEg*has\44159\1006118\DC3\USYg?I\19462\NAKaW2\150415m\t}h\155161RbU\STX\ETBlz2!\DC3JW5\ESC\1026156U\SOg,rpO\5857]0\ESC\479\1005443F\SI\1045994\RS\SO\11908rl\1104306~\ACK+Mn{5\993784a\EM2\v{jM\ETBT\1058105$\DC1\1099974\GSj_~Z\1007141P\SOH\EOTo@TJhk\EOT\ETBk:-\96583[p\DLE\DC1\RS'\r\STXQ,,\1016866?H\rh\30225\rj\147982\DC2\\(u\ESCu\154705\1002696o\DC4\988492\1103465\1052034\DC1q\GS-\b\40807\DC1qW>\fys\8130,'\159954<" ) @@ -73,11 +74,7 @@ testObject_Login_user_5 = PasswordLogin ( PasswordLoginData ( LoginByHandle - ( Handle - { fromHandle = - "c372iaa_v5onjcck67rlzq4dn5_oxhtx7dpx7v82lp1rhx0e97i26--8r3c6k773bxtlzmkjc20-11_047ydua_o9_5u4sll_fl3ng_0sa." - } - ) + (fromJust (parseHandle "c372iaa_v5onjcck67rlzq4dn5_oxhtx7dpx7v82lp1rhx0e97i26--8r3c6k773bxtlzmkjc20-11_047ydua_o9_5u4sll_fl3ng_0sa.")) ) ( plainTextPassword6Unsafe "\120347\184756DU\1035832hp\1006715t~\DC2\SOH\STX*\1053210y1\1078382H\173223{e\\S\SO?c_7\t\DC4X\135187\&6\172722E\100168j\SUB\t\SYN\1088511>HO]60\990035\ETX\"+w,t\1066040\ak(b%u\151197`>b\1028272e\ACKc\151393\1107996)\12375\&7\1082464`\186313yO+v%\1033664\rc<\65764\&2>8u\1094258\1080669\1113623\75033a\179193\NAK=\EOT\1077021\&8R&j\1042630\ESC\t4sj-\991835\40404n\136765\1064089N\GS\\\1026123\72288\&5\r\97004(P!\DEL\29235\26855\b\1067772Mr~\65123\EMjt>Z\GS~\140732A\1031358\SO\\>\DC16\">%\45860\1084751I@u5\187891\vrY\r;7\1071052#\1078407\1016286\CAN'\63315\1041397\EM_I_zY\987300\149441\EMd\1039844cd\DEL\1061999\136326Cp3\26325\GSXj\n\46305jy\44050\58825\t-\19065\43336d\1046547L\SUBYF\ACKPOL\54766\DC2\DC1\DC1\DC2*\rH\DLE(?\DC3F\25820\DLE\r]\1069451j\170177 @\ENQT\1100685s\FSF2\NAK]8\a\DC3!\NAKW\176469\1110834K\1025058\1112222_%\1001818\1113069'\1098149\70360(#\SOHky\t\ETB!\17570\NAK\DC4\ESC{\119317U2LS'" @@ -126,7 +123,7 @@ testObject_Login_user_9 :: Login testObject_Login_user_9 = PasswordLogin ( PasswordLoginData - (LoginByHandle (Handle {fromHandle = "6bolp"})) + (LoginByHandle (fromJust (parseHandle "6bolp"))) ( plainTextPassword6Unsafe ">1/\t\NAK \1010386\1013311z\33488Bv\1109131(=<\SOq\1104556?L\6845\1066491\2972c\997644<&!\1103500\999823j~O3USw\DC2\ETX\a\ETB+\1024033Ny\31920(/Sco\STX{3\SIEh\SYN\1032591\1022672\27668-\FS.'\ENQX\98936\150419Ti3\1051250\"%\SYN\b\188444+\EOT\STX^\1108463)2bR\ACK\SIJB[\1045179&O9{w{aV\ENQgZ?3z\1065517\&8\4979\156950\990517`\1063252\"PE)uKq|w\SYN0\ESC. \ETX\73440sxW\160357\1001111m\ENQ7e)\77912\1008764:s\CANYj\9870\16356\ACK\USlTu\1110309I.\1087068O#kQ\RS!g\1062167\CANQ\US\172867\SYN\ACK|\"M\"P\US\ETX@ZPq\1016598gY\148621=\a\1057645l8\1041152\&3\995012\1022626CN<\147876gJ\1038434]\94932mX~\ACKw3\DLE\179764\&8\a6\EOT}\DLEi\DC3L5\1032336PY^|!Vz\ESC4\36208!iLa\12091\DC4\1059706\167964\GS:\1042431\149640h\\dLx\1087701\EM\194900\SUB\134635R%ps7\95168s\1074387fg\nIf\1067199\DC1l\SUB\1022871-n_\6065UY?4d]|c\\[T\ajS\18838\55046\37136aK\1025430\1112672\ETX\FSx+" ) diff --git a/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated/NewBotRequest_provider.hs b/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated/NewBotRequest_provider.hs index b8088ef6121..77bb41b00b8 100644 --- a/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated/NewBotRequest_provider.hs +++ b/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated/NewBotRequest_provider.hs @@ -20,7 +20,7 @@ module Test.Wire.API.Golden.Generated.NewBotRequest_provider where import Data.Domain -import Data.Handle (Handle (Handle, fromHandle)) +import Data.Handle (parseHandle) import Data.ISO3166_CountryCodes ( CountryCode ( AO, @@ -161,7 +161,7 @@ testObject_NewBotRequest_provider_2 = { botUserViewId = Id (fromJust (UUID.fromString "00000000-0000-0000-0000-000100000000")), botUserViewName = Name {fromName = "}\DLE&:\bp\ETB.+H\59688 \RS\SYNq\1068740\37311"}, botUserViewColour = ColourId {fromColourId = 1}, - botUserViewHandle = Just (Handle {fromHandle = "mwt6"}), + botUserViewHandle = Just (fromJust (parseHandle "mwt6")), botUserViewTeam = Nothing }, newBotConv = @@ -185,12 +185,7 @@ testObject_NewBotRequest_provider_3 = }, botUserViewColour = ColourId {fromColourId = 1}, botUserViewHandle = - Just - ( Handle - { fromHandle = - "h.cn77ac0vrssl3li_xktkmwmps_8s6y-ntsnv5e6i6pc4tihqh6t9paxuyxopod76mgse-4pyop9v.n6uhz5" - } - ), + Just (fromJust (parseHandle "h.cn77ac0vrssl3li_xktkmwmps_8s6y-ntsnv5e6i6pc4tihqh6t9paxuyxopod76mgse-4pyop9v.n6uhz5")), botUserViewTeam = Just (Id (fromJust (UUID.fromString "00000000-0000-0001-0000-000100000001"))) }, newBotConv = @@ -257,7 +252,7 @@ testObject_NewBotRequest_provider_5 = }, botUserViewColour = ColourId {fromColourId = -1}, botUserViewHandle = - Just (Handle {fromHandle = "dcd5u---q-5liar3qaixbwwjjrg-79a2k413z74whfyc-k_8jvle63fhs3v.mdncia29"}), + Just (fromJust (parseHandle "dcd5u---q-5liar3qaixbwwjjrg-79a2k413z74whfyc-k_8jvle63fhs3v.mdncia29")), botUserViewTeam = Just (Id (fromJust (UUID.fromString "00000000-0000-0001-0000-000000000000"))) }, newBotConv = @@ -280,7 +275,7 @@ testObject_NewBotRequest_provider_6 = "vK!_\DLE:\ESCI0\168602U\144178\b\NUL*\70679%\SUBvf7\59967\&7\1022395\51118\NULQn\1098780_\1052931]FIF\NUL\994410m?a\DC1\134034+\US\1016849[U\1056197v\rU$:\986190\SOm[\987847\1007064\DC1H\DEL\ENQ$_^e8e\1085721E')y\33670\EMR\v[Z\f)\SI\DC4\119067\137276\1039160c;'\170985\1064339\51122\RS\43522\ENQj\8110\1098421\\\133676PL|n\ETB\984318\1038283" }, botUserViewColour = ColourId {fromColourId = 1}, - botUserViewHandle = Just (Handle {fromHandle = "chuc8zlscl1gioct"}), + botUserViewHandle = Just (fromJust (parseHandle "chuc8zlscl1gioct")), botUserViewTeam = Just (Id (fromJust (UUID.fromString "00000000-0000-0001-0000-000000000001"))) }, newBotConv = @@ -350,7 +345,7 @@ testObject_NewBotRequest_provider_7 = { botUserViewId = Id (fromJust (UUID.fromString "00000000-0000-0000-0000-000100000000")), botUserViewName = Name {fromName = "]\98090\DEL\SO\GSq{9\143048j\135048"}, botUserViewColour = ColourId {fromColourId = 1}, - botUserViewHandle = Just (Handle {fromHandle = "kfgs"}), + botUserViewHandle = Just (fromJust (parseHandle "kfgs")), botUserViewTeam = Just (Id (fromJust (UUID.fromString "00000000-0000-0001-0000-000000000000"))) }, newBotConv = @@ -369,7 +364,7 @@ testObject_NewBotRequest_provider_8 = { botUserViewId = Id (fromJust (UUID.fromString "00000000-0000-0001-0000-000000000001")), botUserViewName = Name {fromName = "0H\164007\1094020\CAN\1063257\v1\1064417\1068260(r"}, botUserViewColour = ColourId {fromColourId = 1}, - botUserViewHandle = Just (Handle {fromHandle = ".x1v4"}), + botUserViewHandle = Just (fromJust (parseHandle ".x1v4")), botUserViewTeam = Nothing }, newBotConv = @@ -450,7 +445,7 @@ testObject_NewBotRequest_provider_10 = "\28714+w\1052759*KHRC\DC3\DC2\69702\&0\1043100u1vT\ACK\94716\SUB}\65128\"P\1054449\&3\fb_\CAN\EOT\133649B55t\SUB\29069\&8\21614\1091434I\166155\135568\29529\1084846\SUBf\1077482\SUB\9091\151919\&3\GS?U\145649\SI0\1046380\996945\&1\ESC\STX8\46655g\146307\1068045?|\GSn\a+8|\166543#H|+\1054950|\1082601\1070384\&86o\95174" }, botUserViewColour = ColourId {fromColourId = 1}, - botUserViewHandle = Just (Handle {fromHandle = "hy4dc"}), + botUserViewHandle = Just (fromJust (parseHandle "hy4dc")), botUserViewTeam = Nothing }, newBotConv = @@ -473,7 +468,7 @@ testObject_NewBotRequest_provider_11 = "\1034857\ENQ<\ETB\1067175`pv6$?U1\f\1061\900\&6GB\SUB\154475\1039582{W@\1013922\1106400w\1040667Z\trO\1058683e\66911\25986x*YUj\nf\53235lg\ESCs_\1046674S2[\DC2e\1101653\1004868=\CAN\36589,#\1035811\1105438\DC2{2>\DC3*\EM\23235%\bfn\180748\&9<\ETBc\181499\69937Qr\146682\n" }, botUserViewColour = ColourId {fromColourId = -1}, - botUserViewHandle = Just (Handle {fromHandle = "pt-g.o"}), + botUserViewHandle = Just (fromJust (parseHandle "pt-g.o")), botUserViewTeam = Just (Id (fromJust (UUID.fromString "00000001-0000-0000-0000-000000000001"))) }, newBotConv = @@ -496,12 +491,7 @@ testObject_NewBotRequest_provider_12 = }, botUserViewColour = ColourId {fromColourId = 0}, botUserViewHandle = - Just - ( Handle - { fromHandle = - "2mbu57j9i5av3tl5qq3defu9ydjatm7y-bgi4nznqyvcbmdn66pma5ice6famcazb892aqtzz2_zclckldrjh6nq69sz_2p0qx99p6t2ogt9ewzzq2olgge32jyt6kmwgmzvdbeti-iygnitchblkicol8m83a8n-a2ip-yy27z2llzu7" - } - ), + Just (fromJust (parseHandle "2mbu57j9i5av3tl5qq3defu9ydjatm7y-bgi4nznqyvcbmdn66pma5ice6famcazb892aqtzz2_zclckldrjh6nq69sz_2p0qx99p6t2ogt9ewzzq2olgge32jyt6kmwgmzvdbeti-iygnitchblkicol8m83a8n-a2ip-yy27z2llzu7")), botUserViewTeam = Just (Id (fromJust (UUID.fromString "00000001-0000-0001-0000-000000000000"))) }, newBotConv = @@ -521,12 +511,7 @@ testObject_NewBotRequest_provider_13 = botUserViewName = Name {fromName = "6`k)?\189080V"}, botUserViewColour = ColourId {fromColourId = 0}, botUserViewHandle = - Just - ( Handle - { fromHandle = - "7g_a0on27rzpz7cfzl3hle6v7dwv.db.to.ief5xzr3eu.vr5jb57_z5t3ahmggm9oddsd-quxc1uv4xkr7ncg9ff9zicgsjenafoxe4jbtrzjagqy84xrvt7iv_dcpe7_iiyg3tpeg8fh2osxf7dv01ueygahrdokoa-2ya37r6g0b0u3j416qnnk.404lffdz" - } - ), + Just (fromJust (parseHandle "7g_a0on27rzpz7cfzl3hle6v7dwv.db.to.ief5xzr3eu.vr5jb57_z5t3ahmggm9oddsd-quxc1uv4xkr7ncg9ff9zicgsjenafoxe4jbtrzjagqy84xrvt7iv_dcpe7_iiyg3tpeg8fh2osxf7dv01ueygahrdokoa-2ya37r6g0b0u3j416qnnk.404lffdz")), botUserViewTeam = Just (Id (fromJust (UUID.fromString "00000000-0000-0001-0000-000100000001"))) }, newBotConv = @@ -569,7 +554,7 @@ testObject_NewBotRequest_provider_14 = "\"\161008Z9\b\57817\94488\34531yX\SYN\989653/\SUB\SUB/B\1089073B\EM?\n\119029zz\1063844\1079191T\SO]\1045646\1020565d\b[\183600\&3\35869\US\1074551\985034BVTBC8&\t\1085747\135733aRR\1071408e <(]\NAK" }, botUserViewColour = ColourId {fromColourId = -1}, - botUserViewHandle = Just (Handle {fromHandle = "ho"}), + botUserViewHandle = Just (fromJust (parseHandle "ho")), botUserViewTeam = Just (Id (fromJust (UUID.fromString "00000000-0000-0001-0000-000000000000"))) }, newBotConv = @@ -615,7 +600,7 @@ testObject_NewBotRequest_provider_16 = "N\ESCE`W:\"9\"\14840\DC2g_\"<\1047945\1062839GGQ/g\54646*\1005815|Sh)-\DC3&e-Y&&:\147317\1053744TWo\ETX\1010161\1009736@\SI>q\ETB\11622c\1068700|k\SOH\1090490 Dqwr\SI r\30804\161971\1014628?u\1021253AH\64817A\SOH\181530\1052127\SOHF\997870V\ACKkY\997171-\1081803\998604]'" }, botUserViewColour = ColourId {fromColourId = 1}, - botUserViewHandle = Just (Handle {fromHandle = "o8opul3h"}), + botUserViewHandle = Just (fromJust (parseHandle "o8opul3h")), botUserViewTeam = Just (Id (fromJust (UUID.fromString "00000000-0000-0000-0000-000100000001"))) }, newBotConv = @@ -687,7 +672,7 @@ testObject_NewBotRequest_provider_18 = "\1038532\EMz\SUB%\139660__DO}\54713\50053\CAN\47274\DELZ\13914w8<\1009245\1001975\184118\ESC\32164{|\ACK3_)\DC3]f$\1112650;Pj0\ETB\a\DC2k\nG\SUBr\145903\&2}\DC3.\EOTB\SOH\CAN\162312\EOT\145691\ETB\1087729).\41256\tNwq\1022524\59021\1088435" }, botUserViewColour = ColourId {fromColourId = 0}, - botUserViewHandle = Just (Handle {fromHandle = "gcmc3fjd3ire.maquq87awi"}), + botUserViewHandle = Just (fromJust (parseHandle "gcmc3fjd3ire.maquq87awi")), botUserViewTeam = Nothing }, newBotConv = @@ -765,12 +750,7 @@ testObject_NewBotRequest_provider_20 = }, botUserViewColour = ColourId {fromColourId = 0}, botUserViewHandle = - Just - ( Handle - { fromHandle = - "th4n3ndvnpp49es-gz55m5nnya_d.mcna7zg2t-t.xhcz6xbh17cg0.trdfgmo8whrtkl9fqdi8jg7d3nlh03p.bpumzn-.89h4.i75x6gx.x7kos0x4hqc.31hy78ckr6502kun7u7_b1a.8mw3oo3ylv.k29_zei793az7xlfaes1wa2gvu4tad52v5-w8rz9o-ivftxq5-nz87uhlm" - } - ), + Just (fromJust (parseHandle "th4n3ndvnpp49es-gz55m5nnya_d.mcna7zg2t-t.xhcz6xbh17cg0.trdfgmo8whrtkl9fqdi8jg7d3nlh03p.bpumzn-.89h4.i75x6gx.x7kos0x4hqc.31hy78ckr6502kun7u7_b1a.8mw3oo3ylv.k29_zei793az7xlfaes1wa2gvu4tad52v5-w8rz9o-ivftxq5-nz87uhlm")), botUserViewTeam = Just (Id (fromJust (UUID.fromString "00000000-0000-0001-0000-000000000001"))) }, newBotConv = diff --git a/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated/SelfProfile_user.hs b/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated/SelfProfile_user.hs index 8347f901b60..046e2bf3dc5 100644 --- a/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated/SelfProfile_user.hs +++ b/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated/SelfProfile_user.hs @@ -20,7 +20,7 @@ module Test.Wire.API.Golden.Generated.SelfProfile_user where import Data.Domain (Domain (Domain, _domainText)) -import Data.Handle (Handle (Handle, fromHandle)) +import Data.Handle import Data.ISO3166_CountryCodes (CountryCode (PA)) import Data.Id (Id (Id)) import Data.Json.Util (readUTCTimeMillis) @@ -57,7 +57,7 @@ testObject_SelfProfile_user_1 = _serviceRefProvider = Id (fromJust (UUID.fromString "00000000-0000-0001-0000-000000000001")) } ), - userHandle = Just (Handle {fromHandle = "do9-5"}), + userHandle = Just (fromJust (parseHandle "do9-5")), userExpire = Just (fromJust (readUTCTimeMillis "1864-05-07T21:09:29.342Z")), userTeam = Just (Id (fromJust (UUID.fromString "00000001-0000-0002-0000-000000000002"))), userManagedBy = ManagedByScim, diff --git a/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated/UserProfile_user.hs b/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated/UserProfile_user.hs index e0790e3d8c6..44f9d311e39 100644 --- a/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated/UserProfile_user.hs +++ b/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated/UserProfile_user.hs @@ -20,7 +20,7 @@ module Test.Wire.API.Golden.Generated.UserProfile_user where import Data.Domain (Domain (Domain, _domainText)) -import Data.Handle (Handle (Handle, fromHandle)) +import Data.Handle import Data.Id (Id (Id)) import Data.Json.Util (readUTCTimeMillis) import Data.LegalHold (UserLegalHoldStatus (..)) @@ -73,12 +73,7 @@ testObject_UserProfile_user_2 = } ), profileHandle = - Just - ( Handle - { fromHandle = - "emsonpvo3-x_4ys4qjtjtkfgx.mag6pi2ldq.77m5vnsn_tte41r-0vwgklpeejr1t4se0bknu4tsuqs-njzh34-ba_mj8lm5x6aro4o.2wsqe0ldx" - } - ), + Just (fromJust (parseHandle "emsonpvo3-x_4ys4qjtjtkfgx.mag6pi2ldq.77m5vnsn_tte41r-0vwgklpeejr1t4se0bknu4tsuqs-njzh34-ba_mj8lm5x6aro4o.2wsqe0ldx")), profileExpire = Just (fromJust (readUTCTimeMillis "1864-05-09T01:42:22.437Z")), profileTeam = Just (Id (fromJust (UUID.fromString "00000000-0000-0002-0000-000200000002"))), profileEmail = Just (Email {emailLocal = "\172353 ", emailDomain = ""}), diff --git a/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated/User_user.hs b/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated/User_user.hs index c744ea8f57a..de58fc8b457 100644 --- a/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated/User_user.hs +++ b/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated/User_user.hs @@ -20,7 +20,7 @@ module Test.Wire.API.Golden.Generated.User_user where import Data.Domain (Domain (Domain, _domainText)) -import Data.Handle (Handle (Handle, fromHandle)) +import Data.Handle import Data.ISO3166_CountryCodes ( CountryCode ( MQ, @@ -129,7 +129,7 @@ testObject_User_user_3 = _serviceRefProvider = Id (fromJust (UUID.fromString "00000001-0000-0000-0000-000100000000")) } ), - userHandle = Just (Handle {fromHandle = "1c"}), + userHandle = Just (fromJust (parseHandle "1c")), userExpire = Just (fromJust (readUTCTimeMillis "1864-05-09T20:12:05.821Z")), userTeam = Just (Id (fromJust (UUID.fromString "00000002-0000-0001-0000-000200000000"))), userManagedBy = ManagedByWire, @@ -164,12 +164,7 @@ testObject_User_user_4 = } ), userHandle = - Just - ( Handle - { fromHandle = - "iw2-.udd2l7-7yg3dfg.wzn4vx3hjhch8.--5t6uyjqk93twv-a2pce8p1xjh7387nztzu.q" - } - ), + Just (fromJust (parseHandle "iw2-.udd2l7-7yg3dfg.wzn4vx3hjhch8.--5t6uyjqk93twv-a2pce8p1xjh7387nztzu.q")), userExpire = Just (fromJust (readUTCTimeMillis "1864-05-09T14:25:26.089Z")), userTeam = Just (Id (fromJust (UUID.fromString "00000000-0000-0000-0000-000100000002"))), userManagedBy = ManagedByScim, @@ -204,12 +199,7 @@ testObject_User_user_5 = } ), userHandle = - Just - ( Handle - { fromHandle = - "iw2-.udd2l7-7yg3dfg.wzn4vx3hjhch8.--5t6uyjqk93twv-a2pce8p1xjh7387nztzu.q" - } - ), + Just (fromJust (parseHandle "iw2-.udd2l7-7yg3dfg.wzn4vx3hjhch8.--5t6uyjqk93twv-a2pce8p1xjh7387nztzu.q")), userExpire = Just (fromJust (readUTCTimeMillis "1864-05-09T14:25:26.089Z")), userTeam = Just (Id (fromJust (UUID.fromString "00000000-0000-0000-0000-000100000002"))), userManagedBy = ManagedByScim, diff --git a/libs/wire-subsystems/src/Wire/UserStore/Cassandra.hs b/libs/wire-subsystems/src/Wire/UserStore/Cassandra.hs index 15a649b7f1d..4f3be239832 100644 --- a/libs/wire-subsystems/src/Wire/UserStore/Cassandra.hs +++ b/libs/wire-subsystems/src/Wire/UserStore/Cassandra.hs @@ -88,9 +88,6 @@ freeHandleImpl uid h = do -- | Sending an empty 'Handle' here causes C* to throw "Key may not be empty" -- error. --- --- FUTUREWORK: This should ideally be tackled by hiding constructor for 'Handle' --- and only allowing it to be parsed. lookupHandleImpl :: Consistency -> Handle -> Client (Maybe UserId) lookupHandleImpl consistencyLevel h = do (runIdentity =<<) diff --git a/libs/wire-subsystems/src/Wire/UserSubsystem/HandleBlacklist.hs b/libs/wire-subsystems/src/Wire/UserSubsystem/HandleBlacklist.hs index e6ac6fba97a..c4878f685ec 100644 --- a/libs/wire-subsystems/src/Wire/UserSubsystem/HandleBlacklist.hs +++ b/libs/wire-subsystems/src/Wire/UserSubsystem/HandleBlacklist.hs @@ -3,7 +3,8 @@ module Wire.UserSubsystem.HandleBlacklist ) where -import Data.Handle (Handle (Handle)) +import Control.Exception (assert) +import Data.Handle (Handle, parseHandle) import Data.HashSet qualified as HashSet import Imports @@ -12,10 +13,11 @@ isBlacklistedHandle :: Handle -> Bool isBlacklistedHandle = (`HashSet.member` blacklist) blacklist :: HashSet Handle -blacklist = - HashSet.fromList $ - map - Handle +blacklist = assert good (HashSet.fromList (fromJust <$> parsed)) + where + good = all isJust parsed + parsed = parseHandle <$> raw + raw = [ "account", "admin", "administrator", diff --git a/libs/wire-subsystems/test/unit/Wire/UserSubsystem/InterpreterSpec.hs b/libs/wire-subsystems/test/unit/Wire/UserSubsystem/InterpreterSpec.hs index dd8b97ed592..b43c9173a3d 100644 --- a/libs/wire-subsystems/test/unit/Wire/UserSubsystem/InterpreterSpec.hs +++ b/libs/wire-subsystems/test/unit/Wire/UserSubsystem/InterpreterSpec.hs @@ -337,11 +337,11 @@ spec = describe "UserSubsystem.Interpreter" do prop "CheckHandle fails if there is no user with that handle" - \(Handle handle, config) -> - not (isBlacklistedHandle (Handle handle)) ==> + \(handle :: Handle, config) -> + not (isBlacklistedHandle handle) ==> let localBackend = def {users = []} checkHandleResp = - runNoFederationStack localBackend Nothing config $ checkHandle handle + runNoFederationStack localBackend Nothing config $ checkHandle (fromHandle handle) in checkHandleResp === CheckHandleNotFound prop @@ -365,22 +365,22 @@ spec = describe "UserSubsystem.Interpreter" do describe "Scim+UpdateProfileUpdate" do prop "Updating handles fails when UpdateOriginWireClient" - \(alice, Handle newHandle, domain, config) -> - not (isBlacklistedHandle (Handle newHandle)) ==> + \(alice, newHandle :: Handle, domain, config) -> + not (isBlacklistedHandle newHandle) ==> let res :: Either UserSubsystemError () res = run . runErrorUnsafe . runError $ interpretNoFederationStack localBackend Nothing def config do - updateHandle (toLocalUnsafe domain alice.id) Nothing UpdateOriginWireClient newHandle + updateHandle (toLocalUnsafe domain alice.id) Nothing UpdateOriginWireClient (fromHandle newHandle) localBackend = def {users = [alice {managedBy = Just ManagedByScim}]} in res === Left UserSubsystemHandleManagedByScim prop "Updating handles succeeds when UpdateOriginScim" - \(alice, ssoId, email :: Maybe Email, Handle newHandle, domain, config) -> - not (isBlacklistedHandle (Handle newHandle)) ==> + \(alice, ssoId, email :: Maybe Email, fromHandle -> newHandle, domain, config) -> + not (isBlacklistedHandle (fromJust (parseHandle newHandle))) ==> let res :: Either UserSubsystemError () = run . runErrorUnsafe . runError @@ -401,7 +401,7 @@ spec = describe "UserSubsystem.Interpreter" do prop "update valid handles succeeds" - \(storedUser :: StoredUser, newHandle@(Handle rawNewHandle), config) -> + \(storedUser :: StoredUser, newHandle@(fromHandle -> rawNewHandle), config) -> (isJust storedUser.identity && not (isBlacklistedHandle newHandle)) ==> let updateResult :: Either UserSubsystemError () = run . runErrorUnsafe diff --git a/services/brig/src/Brig/API/Internal.hs b/services/brig/src/Brig/API/Internal.hs index 038e9956d2b..af81a62a56c 100644 --- a/services/brig/src/Brig/API/Internal.hs +++ b/services/brig/src/Brig/API/Internal.hs @@ -882,8 +882,8 @@ updateUserNameH uid (NameUpdate nameUpd) = Nothing -> throwStd (errorToWai @'E.InvalidUser) checkHandleInternalH :: Member UserSubsystem r => Handle -> Handler r CheckHandleResponse -checkHandleInternalH (Handle h) = lift $ liftSem do - API.checkHandle h <&> \case +checkHandleInternalH h = lift $ liftSem do + API.checkHandle (fromHandle h) <&> \case API.CheckHandleFound -> CheckHandleResponseFound API.CheckHandleNotFound -> CheckHandleResponseNotFound diff --git a/services/brig/test/integration/API/Federation.hs b/services/brig/test/integration/API/Federation.hs index 9f416d5b252..4d09484d7ff 100644 --- a/services/brig/test/integration/API/Federation.hs +++ b/services/brig/test/integration/API/Federation.hs @@ -26,7 +26,7 @@ import Control.Arrow (Arrow (first), (&&&)) import Control.Lens ((?~)) import Data.Aeson import Data.Domain (Domain (Domain)) -import Data.Handle (Handle (..)) +import Data.Handle (Handle (fromHandle), parseHandle) import Data.Id import Data.Map qualified as Map import Data.Qualified @@ -264,7 +264,7 @@ testGetUserByHandleNotFound opts = do maybeProfile <- withSettingsOverrides (allowFullSearch domain opts) $ do runWaiTestFedClient domain $ createWaiTestFedClient @"get-user-by-handle" @'Brig $ - Handle hdl + fromJust (parseHandle hdl) liftIO $ assertEqual "should not return any UserProfile" Nothing maybeProfile diff --git a/services/brig/test/integration/API/Provider.hs b/services/brig/test/integration/API/Provider.hs index 538453d1aed..0d4bf057042 100644 --- a/services/brig/test/integration/API/Provider.hs +++ b/services/brig/test/integration/API/Provider.hs @@ -41,7 +41,7 @@ import Data.ByteString.Char8 qualified as C8 import Data.ByteString.Conversion import Data.ByteString.Lazy.Char8 qualified as LC8 import Data.Domain -import Data.Handle (Handle (Handle)) +import Data.Handle (parseHandle) import Data.HashMap.Strict qualified as HashMap import Data.Id import Data.Json.Util (toBase64Text) @@ -2233,7 +2233,7 @@ testAddRemoveBotUtil localDomain pid sid cid u1 u2 h sref buf brig galley cannon -- Check that the preferred locale defaults to the locale of the -- user who requsted the bot. liftIO $ assertEqual "locale" (userLocale u1) (testBotLocale bot) - liftIO $ assertEqual "handle" (Just (Handle h)) u1Handle + liftIO $ assertEqual "handle" (Just (fromJust $ parseHandle h)) u1Handle -- Check that the bot has access to the conversation getBotConv galley bid cid !!! const 200 === statusCode -- Check that the bot user exists and can be identified as a bot diff --git a/services/brig/test/integration/API/User/Account.hs b/services/brig/test/integration/API/User/Account.hs index 388a4a97fa2..fa5f3277db8 100644 --- a/services/brig/test/integration/API/User/Account.hs +++ b/services/brig/test/integration/API/User/Account.hs @@ -1711,7 +1711,7 @@ testDeleteUserWithDanglingProperty brig cannon userJournalWatcher = do const 200 === statusCode const (Just objectProp) === responseJsonMaybe - execAndAssertUserDeletion brig cannon u (Handle hdl) [] userJournalWatcher $ \uid' -> do + execAndAssertUserDeletion brig cannon u (fromJust (parseHandle hdl)) [] userJournalWatcher $ \uid' -> do deleteUserInternal uid' brig !!! do const 202 === statusCode @@ -1736,7 +1736,7 @@ setHandleAndDeleteUser brig cannon u others userJournalWatcher execDelete = do put (brig . path "/self/handle" . contentJson . zUser uid . zConn "c" . body update) !!! const 200 === statusCode - execAndAssertUserDeletion brig cannon u (Handle hdl) others userJournalWatcher execDelete + execAndAssertUserDeletion brig cannon u (fromJust (parseHandle hdl)) others userJournalWatcher execDelete execAndAssertUserDeletion :: Brig -> Cannon -> User -> Handle -> [UserId] -> UserJournalWatcher -> (UserId -> HttpT IO ()) -> Http () execAndAssertUserDeletion brig cannon u hdl others userJournalWatcher execDelete = do diff --git a/services/brig/test/integration/API/User/Auth.hs b/services/brig/test/integration/API/User/Auth.hs index 8a23e8cbb27..a03af8237bc 100644 --- a/services/brig/test/integration/API/User/Auth.hs +++ b/services/brig/test/integration/API/User/Auth.hs @@ -42,7 +42,7 @@ import Data.Aeson as Aeson hiding (json) import Data.ByteString qualified as BS import Data.ByteString.Conversion import Data.ByteString.Lazy qualified as Lazy -import Data.Handle (Handle (Handle)) +import Data.Handle (parseHandle) import Data.Id import Data.Misc (PlainTextPassword6, plainTextPassword6, plainTextPassword6Unsafe) import Data.Proxy @@ -379,7 +379,7 @@ testHandleLogin brig = do let update = RequestBodyLBS . encode $ HandleUpdate hdl put (brig . path "/self/handle" . contentJson . zUser usr . zConn "c" . Http.body update) !!! const 200 === statusCode - let l = PasswordLogin (PasswordLoginData (LoginByHandle (Handle hdl)) defPassword Nothing Nothing) + let l = PasswordLogin (PasswordLoginData (LoginByHandle (fromJust $ parseHandle hdl)) defPassword Nothing Nothing) login brig l PersistentCookie !!! const 200 === statusCode -- | Check that local part after @+@ is ignored by equality on email addresses if the domain is diff --git a/services/brig/test/integration/API/User/Handles.hs b/services/brig/test/integration/API/User/Handles.hs index 88164a3e600..db34f2f9277 100644 --- a/services/brig/test/integration/API/User/Handles.hs +++ b/services/brig/test/integration/API/User/Handles.hs @@ -32,7 +32,7 @@ import Control.Monad.Catch (MonadCatch) import Data.Aeson import Data.Aeson.Lens import Data.ByteString.Conversion -import Data.Handle (Handle (Handle)) +import Data.Handle (parseHandle) import Data.Id import Data.List1 qualified as List1 import Data.Qualified (Qualified (..)) @@ -151,7 +151,7 @@ testHandleRace brig = do void . flip mapConcurrently us $ \u -> put (brig . path "/self/handle" . contentJson . zUser u . zConn "c" . body update) ps <- forM us $ \u -> responseJsonMaybe <$> get (brig . path "/self" . zUser u) - let owners = catMaybes $ filter (maybe False ((== Just (Handle hdl)) . userHandle)) ps + let owners = catMaybes $ filter (maybe False ((== Just (fromJust (parseHandle hdl))) . userHandle)) ps liftIO $ assertBool "More than one owner of a handle" (length owners <= 1) testHandleQuery :: Opt.Opts -> Brig -> Http () @@ -168,14 +168,14 @@ testHandleQuery opts brig = do -- Query the updated profile get (brig . path "/self" . zUser uid) !!! do const 200 === statusCode - const (Just (Handle hdl)) === (userHandle <=< responseJsonMaybe) + const (Just (fromJust $ parseHandle hdl)) === (userHandle <=< responseJsonMaybe) -- Query for the handle availability (must be taken) Bilge.head (brig . paths ["users", "handles", toByteString' hdl] . zUser uid) !!! const 200 === statusCode -- Query user profiles by handles get (apiVersion "v1" . brig . path "/users" . queryItem "handles" (toByteString' hdl) . zUser uid) !!! do const 200 === statusCode - const (Just (Handle hdl)) === (profileHandle <=< listToMaybe <=< responseJsonMaybe) + const (Just (fromJust $ parseHandle hdl)) === (profileHandle <=< listToMaybe <=< responseJsonMaybe) -- Bulk availability check hdl2 <- randomHandle hdl3 <- randomHandle diff --git a/services/brig/test/integration/API/User/Util.hs b/services/brig/test/integration/API/User/Util.hs index dfd26fb1c26..da62d9d228f 100644 --- a/services/brig/test/integration/API/User/Util.hs +++ b/services/brig/test/integration/API/User/Util.hs @@ -40,7 +40,7 @@ import Data.ByteString.Char8 (pack) import Data.ByteString.Conversion import Data.ByteString.Lazy qualified as LB import Data.Domain -import Data.Handle (Handle (Handle)) +import Data.Handle (parseHandle) import Data.Id import Data.Kind import Data.List1 qualified as List1 @@ -120,7 +120,7 @@ setRandomHandle brig user = do ) !!! const 200 === statusCode - pure user {userHandle = Just (Handle h)} + pure user {userHandle = Just . fromJust . parseHandle $ h} -- Note: This actually _will_ send out an email, so we ensure that the email -- used here has a domain 'simulator.amazonses.com'. diff --git a/services/spar/src/Spar/Intra/BrigApp.hs b/services/spar/src/Spar/Intra/BrigApp.hs index 78c66c2997a..97878fa990c 100644 --- a/services/spar/src/Spar/Intra/BrigApp.hs +++ b/services/spar/src/Spar/Intra/BrigApp.hs @@ -50,7 +50,7 @@ import Control.Lens import Control.Monad.Except import Data.ByteString.Conversion import qualified Data.CaseInsensitive as CI -import Data.Handle (Handle (Handle)) +import Data.Handle (Handle, parseHandle) import Data.Id (TeamId, UserId) import Data.Text.Encoding import Data.Text.Encoding.Error @@ -180,7 +180,7 @@ giveDefaultHandle :: (HasCallStack, Member BrigAccess r) => User -> Sem r Handle giveDefaultHandle usr = case userHandle usr of Just handle -> pure handle Nothing -> do - let handle = Handle . decodeUtf8With lenientDecode . toByteString' $ uid + let handle = fromJust . parseHandle . decodeUtf8With lenientDecode . toByteString' $ uid uid = userId usr BrigAccess.setHandle uid handle pure handle diff --git a/services/spar/src/Spar/Scim/User.hs b/services/spar/src/Spar/Scim/User.hs index fb292202198..4b7d4cbdb61 100644 --- a/services/spar/src/Spar/Scim/User.hs +++ b/services/spar/src/Spar/Scim/User.hs @@ -54,7 +54,7 @@ import qualified Data.Aeson.Text as Aeson import Data.ByteString (toStrict) import Data.ByteString.Conversion (fromByteString, toByteString, toByteString') import qualified Data.ByteString.UTF8 as UTF8 -import Data.Handle (Handle (Handle), parseHandle) +import Data.Handle (Handle, fromHandle, parseHandle) import Data.Id (Id (..), TeamId, UserId, idToText) import Data.Json.Util (UTCTimeMillis, fromUTCTimeMillis, toUTCTimeMillis) import qualified Data.Text as Text @@ -1039,7 +1039,7 @@ synthesizeStoredUser' uid veid dname handle richInfo accStatus createdAt lastUpd synthesizeScimUser :: ST.ValidScimUser -> Scim.User ST.SparTag synthesizeScimUser info = - let Handle userName = info ^. ST.vsuHandle + let userName = info ^. ST.vsuHandle . to fromHandle in (Scim.empty ST.userSchemas userName (ST.ScimUserExtra (info ^. ST.vsuRichInfo))) { Scim.externalId = Brig.renderValidExternalId $ info ^. ST.vsuExternalId, Scim.displayName = Just $ fromName (info ^. ST.vsuName), diff --git a/services/spar/test-integration/Test/Spar/Scim/UserSpec.hs b/services/spar/test-integration/Test/Spar/Scim/UserSpec.hs index 1ff2bdb2584..681c3ae0685 100644 --- a/services/spar/test-integration/Test/Spar/Scim/UserSpec.hs +++ b/services/spar/test-integration/Test/Spar/Scim/UserSpec.hs @@ -45,7 +45,7 @@ import Data.Aeson.Types (fromJSON, toJSON) import Data.ByteString.Conversion import qualified Data.CaseInsensitive as CI import qualified Data.Csv as Csv -import Data.Handle (Handle (Handle), fromHandle, parseHandleEither) +import Data.Handle (Handle, fromHandle, parseHandle, parseHandleEither) import Data.Id (TeamId, UserId, randomId) import Data.Ix (inRange) import Data.LanguageCodes (ISO639_1 (..)) @@ -385,11 +385,11 @@ specSuspend = do member <- loginSsoUserFirstTime idp privCreds -- NOTE: once SCIM is enabled, SSO Auto-provisioning is disabled tok <- registerScimToken teamid (Just (idp ^. SAML.idpId)) - handle'@(Handle handle) <- nextHandle - runSpar $ BrigAccess.setHandle member handle' + handle <- nextHandle + runSpar $ BrigAccess.setHandle member handle unless isActive $ do runSpar $ BrigAccess.setStatus member Suspended - [user] <- listUsers tok (Just (filterBy "userName" handle)) + [user] <- listUsers tok (Just (filterBy "userName" (fromHandle handle))) lift $ (fmap Scim.unScimBool . Scim.User.active . Scim.value . Scim.thing $ user) `shouldBe` Just isActive it "pre-existing suspended users are inactive" $ do checkPreExistingUser False @@ -640,7 +640,7 @@ testCreateUserNoIdP = do scimStoredUser <- createUser tok scimUser liftIO $ (fmap Scim.unScimBool . Scim.User.active . Scim.value . Scim.thing $ scimStoredUser) `shouldBe` Just False let userid = scimUserId scimStoredUser - handle = Handle $ Scim.User.userName scimUser + handle = fromJust . parseHandle $ Scim.User.userName scimUser userName = Name . fromJust . Scim.User.displayName $ scimUser -- get account from brig, status should be PendingInvitation @@ -1129,7 +1129,7 @@ testCreateUserTimeout = do searchUser :: HasCallStack => Spar.Types.ScimToken -> Scim.User.User tag -> Email -> Bool -> TestSpar () searchUser tok scimUser email shouldSucceed = do - let handle = Handle . Scim.User.userName $ scimUser + let handle = fromJust . parseHandle . Scim.User.userName $ scimUser tryquery qry = aFewTimesAssert (length <$> listUsers tok (Just qry)) diff --git a/services/spar/test-integration/Util/Core.hs b/services/spar/test-integration/Util/Core.hs index b8c935955d3..003035dd373 100644 --- a/services/spar/test-integration/Util/Core.hs +++ b/services/spar/test-integration/Util/Core.hs @@ -156,7 +156,7 @@ import Data.Aeson as Aeson hiding (json) import Data.Aeson.Lens as Aeson import qualified Data.ByteString.Base64.Lazy as EL import Data.ByteString.Conversion -import Data.Handle (Handle (Handle)) +import Data.Handle (Handle, parseHandle) import Data.Id import Data.Misc (PlainTextPassword6, plainTextPassword6Unsafe) import Data.Proxy @@ -569,7 +569,7 @@ nextSAMLID :: MonadIO m => m (ID a) nextSAMLID = mkID . UUID.toText <$> liftIO UUID.nextRandom nextHandle :: MonadIO m => m Handle -nextHandle = liftIO $ Handle . cs . show <$> randomRIO (0 :: Int, 13371137) +nextHandle = liftIO $ fromJust . parseHandle . cs . show <$> randomRIO (0 :: Int, 13371137) -- | Generate a 'SAML.UserRef' subject. nextSubject :: (HasCallStack, MonadIO m) => m NameID diff --git a/services/spar/test-integration/Util/Scim.hs b/services/spar/test-integration/Util/Scim.hs index d32608f4397..48a6407b8fa 100644 --- a/services/spar/test-integration/Util/Scim.hs +++ b/services/spar/test-integration/Util/Scim.hs @@ -27,7 +27,7 @@ import Control.Lens import Control.Monad.Random import Data.ByteString.Conversion import qualified Data.ByteString.Lazy as Lazy -import Data.Handle (Handle (Handle)) +import Data.Handle (Handle, parseHandle) import Data.Id import Data.LanguageCodes (ISO639_1 (EN)) import Data.String.Conversions @@ -646,7 +646,7 @@ _wrappedStoredUserToWrappedUser f = f . WrappedScimUser . Scim.value . Scim.thin instance IsUser (WrappedScimUser SparTag) where maybeUserId = Nothing - maybeHandle = Just (Just . Handle . Scim.User.userName . fromWrappedScimUser) + maybeHandle = Just (parseHandle . Scim.User.userName . fromWrappedScimUser) maybeName = Just (fmap Name . Scim.User.displayName . fromWrappedScimUser) maybeTenant = Nothing maybeSubject = Nothing diff --git a/tools/stern/test/integration/API.hs b/tools/stern/test/integration/API.hs index 14fcde3b39c..3b107b56502 100644 --- a/tools/stern/test/integration/API.hs +++ b/tools/stern/test/integration/API.hs @@ -234,8 +234,8 @@ testEjpdInfo = do uid <- randomUser h <- randomHandle void $ setHandle uid h - info <- ejpdInfo True [Handle h] - liftIO $ fmap (.ejpdResponseRootHandle) info.ejpdResponseBody @?= [Just (Handle h)] + info <- ejpdInfo True [fromJust $ parseHandle h] + liftIO $ fmap (.ejpdResponseRootHandle) info.ejpdResponseBody @?= [Just (fromJust (parseHandle h))] testUserBlacklist :: TestM () testUserBlacklist = do From 99c4092cb7250f82628af1a8a8a0ac243d96f8f2 Mon Sep 17 00:00:00 2001 From: Leonhardt Wille Date: Mon, 10 Jun 2024 18:20:41 +0200 Subject: [PATCH 23/64] WPB-9495: nginz: add allowlisted_fqdn_origins override (#4087) * add allowlisted_fqdn_origins override * this is required to get CORS to work with additional developer domains * included a test to prevent usage of allowlisted_fqdn_origins in non-staging environments related to WPB-9495 --- changelog.d/5-internal/WPB-9495 | 1 + charts/nginz/templates/conf/_nginx.conf.tpl | 9 ++++++++- charts/nginz/values.yaml | 3 +++ 3 files changed, 12 insertions(+), 1 deletion(-) create mode 100644 changelog.d/5-internal/WPB-9495 diff --git a/changelog.d/5-internal/WPB-9495 b/changelog.d/5-internal/WPB-9495 new file mode 100644 index 00000000000..4be0c6f6de5 --- /dev/null +++ b/changelog.d/5-internal/WPB-9495 @@ -0,0 +1 @@ +nginz: Added `allowlisted_fqdn_origins` to `nginx_conf` value diff --git a/charts/nginz/templates/conf/_nginx.conf.tpl b/charts/nginz/templates/conf/_nginx.conf.tpl index e50fadfa021..9e5e0d61b76 100644 --- a/charts/nginz/templates/conf/_nginx.conf.tpl +++ b/charts/nginz/templates/conf/_nginx.conf.tpl @@ -146,7 +146,14 @@ http { {{ range $origin := .Values.nginx_conf.randomport_allowlisted_origins }} "~^https?://{{ $origin }}(:[0-9]{2,5})?$" "$http_origin"; {{ end }} - } + {{/* Allow additional origin FQDNs, if present */}} + {{- range $origin := .Values.nginx_conf.allowlisted_fqdn_origins }} + "https://{{ $origin }}" "$http_origin"; + {{- end }} + {{- if and .Values.nginx_conf.allowlisted_fqdn_origins (not (eq .Values.nginx_conf.env "staging")) -}} + {{ fail "allowlisted_fqdn_origins is only cleared for usage in staging."}} + {{- end }} + } # diff --git a/charts/nginz/values.yaml b/charts/nginz/values.yaml index 2eab637272c..c3db69f37fc 100644 --- a/charts/nginz/values.yaml +++ b/charts/nginz/values.yaml @@ -78,6 +78,9 @@ nginx_conf: - webapp - teams - account + # Fully-qualified domain names from which to allow Cross-Origin Requests + # (they are **not** combined with 'external_env_domain') + allowlisted_fqdn_origins: [] # The origins from which we allow CORS requests at random ports. This is # useful for testing with HTTP proxies and should not be used in production. From 30abe72f2fb20407a66b09bea234044f5fc40955 Mon Sep 17 00:00:00 2001 From: Akshay Mankar Date: Thu, 13 Jun 2024 08:59:26 +0200 Subject: [PATCH 24/64] federator: Expect a client certificate to be the certificate chain (#4089) Without this openssl doesn't forward to whole chain causing mTLS to not succeed. --- changelog.d/3-bug-fixes/federator-client-cert-chain | 3 +++ services/federator/src/Federator/Monitor/Internal.hs | 2 +- 2 files changed, 4 insertions(+), 1 deletion(-) create mode 100644 changelog.d/3-bug-fixes/federator-client-cert-chain diff --git a/changelog.d/3-bug-fixes/federator-client-cert-chain b/changelog.d/3-bug-fixes/federator-client-cert-chain new file mode 100644 index 00000000000..b05a5385ef6 --- /dev/null +++ b/changelog.d/3-bug-fixes/federator-client-cert-chain @@ -0,0 +1,3 @@ +federator: Expect a client certificate to be the certificate chain + +Without this openssl doesn't forward to whole chain causing mTLS to not succeed. \ No newline at end of file diff --git a/services/federator/src/Federator/Monitor/Internal.hs b/services/federator/src/Federator/Monitor/Internal.hs index 1b6b74f84d1..d731858cacc 100644 --- a/services/federator/src/Federator/Monitor/Internal.hs +++ b/services/federator/src/Federator/Monitor/Internal.hs @@ -344,7 +344,7 @@ mkSSLContext settings = do ctx <- mkSSLContextWithoutCert settings Polysemy.fromExceptionVia @SomeException (InvalidClientCertificate . displayException) $ - SSL.contextSetCertificateFile ctx (clientCertificate settings) + SSL.contextSetCertificateChainFile ctx (clientCertificate settings) Polysemy.fromExceptionVia @SomeException (InvalidClientPrivateKey . displayException) $ SSL.contextSetPrivateKeyFile ctx (clientPrivateKey settings) From 6cdef2008b2ad95cb72be702beb831ea2c3f4067 Mon Sep 17 00:00:00 2001 From: Akshay Mankar Date: Thu, 13 Jun 2024 10:02:30 +0200 Subject: [PATCH 25/64] gh-actions: Upgrade nix and cachix installation actions to fix builds (#4091) --- .github/workflows/ci.yml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml index 7bb88e10d9b..c8adcfe6995 100644 --- a/.github/workflows/ci.yml +++ b/.github/workflows/ci.yml @@ -14,8 +14,8 @@ jobs: - uses: actions/checkout@v2 with: submodules: true - - uses: cachix/install-nix-action@v20 - - uses: cachix/cachix-action@v12 + - uses: cachix/install-nix-action@v27 + - uses: cachix/cachix-action@v15 with: name: wire-server signingKey: '${{ secrets.CACHIX_SIGNING_KEY }}' From b30fc9de68c8bf4acf8c4387c463e7cc2ac23265 Mon Sep 17 00:00:00 2001 From: Akshay Mankar Date: Thu, 13 Jun 2024 12:12:34 +0200 Subject: [PATCH 26/64] Add more fingerprint verification tests for bots (#4027) --------- Co-authored-by: Magnus Viernickel Co-authored-by: Stefan Berthold Co-authored-by: Paolo Capriotti --- changelog.d/5-internal/wpb-6350 | 1 + hack/bin/certchain.sh | 41 +++++ integration/default.nix | 12 ++ integration/integration.cabal | 8 + integration/test/API/Brig.hs | 31 +++- integration/test/SetupHelpers.hs | 4 +- integration/test/Test/Bot.hs | 152 +++++++++++++++ integration/test/Test/LegalHold.hs | 31 ++-- integration/test/Testlib/Certs.hs | 144 +++++++++++++++ .../test/Testlib/MockIntegrationService.hs | 174 +++++++++++------- libs/wire-api/src/Wire/API/Error/Brig.hs | 4 - nix/haskell-pins.nix | 7 + nix/manual-overrides.nix | 2 + services/brig/src/Brig/Provider/RPC.hs | 2 +- .../src/Galley/Effects/ExternalAccess.hs | 3 +- services/galley/src/Galley/External.hs | 9 +- 16 files changed, 524 insertions(+), 101 deletions(-) create mode 100644 changelog.d/5-internal/wpb-6350 create mode 100755 hack/bin/certchain.sh create mode 100644 integration/test/Test/Bot.hs create mode 100644 integration/test/Testlib/Certs.hs diff --git a/changelog.d/5-internal/wpb-6350 b/changelog.d/5-internal/wpb-6350 new file mode 100644 index 00000000000..0414493148d --- /dev/null +++ b/changelog.d/5-internal/wpb-6350 @@ -0,0 +1 @@ +add tests for bots that use self-signed certs and add documentation on why we cannot test the bots to work with PKI diff --git a/hack/bin/certchain.sh b/hack/bin/certchain.sh new file mode 100755 index 00000000000..5ae241fb990 --- /dev/null +++ b/hack/bin/certchain.sh @@ -0,0 +1,41 @@ +#!/usr/bin/env bash +set -euo pipefail +set -x + +## Custom CA root certificate +CANAME=Example-RootCA +CADIR=/tmp/ca/$CANAME +mkdir -p $CADIR + +openssl genrsa -out $CADIR/$CANAME.key 4096 +openssl rsa -in $CADIR/$CANAME.key -pubout -out $CADIR/$CANAME.pub + +openssl req -x509 -new -noenc -out $CADIR/$CANAME.crt -key $CADIR/$CANAME.key \ + -sha256 -subj '/CN=Example Root CA/C=DE/ST=Berlin/L=Berlin/O=Example' + +## Intermediate certificate +INTNAME=Example-IntermediateCA +INTDIR=$CADIR/intermediate +mkdir -p $INTDIR + +openssl genrsa -out $INTDIR/$INTNAME.key +openssl rsa -in $INTDIR/$INTNAME.key -pubout -out $INTDIR/$INTNAME.pub +openssl req -new -key $INTDIR/$INTNAME.key -out $INTDIR/$INTNAME.csr \ + -sha256 -subj '/CN=Example Root CA/C=DE/ST=Berlin/L=Berlin/O=Example' + +openssl x509 -req -in $INTDIR/$INTNAME.csr -CA $CADIR/$CANAME.crt \ + -CAkey $CADIR/$CANAME.key -CAcreateserial -sha256 -out $INTDIR/$INTNAME.crt + +## leaf certificate + +LEAFNAME=Example-Leaf +LEAFDIR=$INTDIR/leaf +mkdir -p $LEAFDIR + +openssl genrsa -out $LEAFDIR/$LEAFNAME.key +openssl rsa -in $LEAFDIR/$LEAFNAME.key -pubout -out $LEAFDIR/$LEAFNAME.pub +openssl req -new -key $LEAFDIR/$LEAFNAME.key -out $LEAFDIR/$LEAFNAME.csr \ + -sha256 -subj '/CN=example-leaf/C=DE/ST=Berlin/L=Berlin/O=Example' + +openssl x509 -req -in $LEAFDIR/$LEAFNAME.csr -CA $INTDIR/$INTNAME.crt \ + -CAkey $INTDIR/$INTNAME.key -CAcreateserial -sha256 -out $LEAFDIR/$LEAFNAME.crt diff --git a/integration/default.nix b/integration/default.nix index 6abbb50c753..040ab8db6f5 100644 --- a/integration/default.nix +++ b/integration/default.nix @@ -7,6 +7,8 @@ , aeson-diff , aeson-pretty , array +, asn1-encoding +, asn1-types , async , attoparsec , base @@ -20,6 +22,8 @@ , cql , cql-io , crypton +, crypton-x509 +, cryptostore , data-default , data-timeout , deriving-aeson @@ -32,6 +36,7 @@ , gitignoreSource , haskell-src-exts , hex +, hourglass , HsOpenSSL , http-client , http-types @@ -70,6 +75,7 @@ , uuid , vector , wai +, wai-route , warp , warp-tls , websockets @@ -97,6 +103,8 @@ mkDerivation { aeson-diff aeson-pretty array + asn1-encoding + asn1-types async attoparsec base @@ -109,6 +117,8 @@ mkDerivation { cql cql-io crypton + crypton-x509 + cryptostore data-default data-timeout deriving-aeson @@ -119,6 +129,7 @@ mkDerivation { extra filepath hex + hourglass HsOpenSSL http-client http-types @@ -156,6 +167,7 @@ mkDerivation { uuid vector wai + wai-route warp warp-tls websockets diff --git a/integration/integration.cabal b/integration/integration.cabal index f70fd486b02..0c4c2f93b6c 100644 --- a/integration/integration.cabal +++ b/integration/integration.cabal @@ -108,6 +108,7 @@ library Test.AssetDownload Test.AssetUpload Test.B2B + Test.Bot Test.Brig Test.Cargohold.API Test.Cargohold.API.Federation @@ -151,6 +152,7 @@ library Testlib.App Testlib.Assertions Testlib.Cannon + Testlib.Certs Testlib.Env Testlib.HTTP Testlib.JSON @@ -175,6 +177,8 @@ library , aeson-diff , aeson-pretty , array + , asn1-encoding + , asn1-types , async , attoparsec , base @@ -187,6 +191,8 @@ library , cql , cql-io , crypton + , crypton-x509 + , cryptostore , data-default , data-timeout , deriving-aeson @@ -197,6 +203,7 @@ library , extra , filepath , hex + , hourglass , HsOpenSSL , http-client , http-types @@ -234,6 +241,7 @@ library , uuid , vector , wai + , wai-route , warp , warp-tls , websockets diff --git a/integration/test/API/Brig.hs b/integration/test/API/Brig.hs index ff825f0aa90..d304b3ed31f 100644 --- a/integration/test/API/Brig.hs +++ b/integration/test/API/Brig.hs @@ -601,14 +601,33 @@ updateService dom providerId serviceId mAcceptHeader newName = do rawBaseRequest domain Brig Versioned $ joinHttpPath ["provider", "services", sId] let addHdrs = - addHeader "Z-Type" "provider" - . addHeader "Z-Provider" providerId + zType "provider" + . zProvider providerId . maybe id (addHeader "Accept") mAcceptHeader submit "PUT" . addHdrs . addJSONObject ["name" .= n | n <- maybeToList newName] $ req +updateServiceConn :: + MakesValue conn => + -- | providerId + String -> + -- | serviceId + String -> + -- | connection update as a Json object, with an obligatory "password" field + conn -> + App Response +updateServiceConn providerId serviceId connectionUpdate = do + req <- baseRequest OwnDomain Brig Versioned do + joinHttpPath ["provider", "services", serviceId, "connection"] + upd <- make connectionUpdate + submit "PUT" + . zType "provider" + . zProvider providerId + . addJSON upd + $ req + -- | https://staging-nginz-https.zinfra.io/v5/api/swagger-ui/#/default/get_users__uid_domain___uid__prekeys__client_ getUsersPrekeysClient :: (HasCallStack, MakesValue caller, MakesValue targetUser) => caller -> targetUser -> String -> App Response getUsersPrekeysClient caller targetUser targetClient = do @@ -642,3 +661,11 @@ getCallsConfigV2 :: (HasCallStack, MakesValue user) => user -> App Response getCallsConfigV2 user = do req <- baseRequest user Brig Versioned $ joinHttpPath ["calls", "config", "v2"] submit "GET" req + +addBot :: MakesValue user => user -> String -> String -> String -> App Response +addBot user providerId serviceId convId = do + req <- baseRequest user Brig Versioned $ joinHttpPath ["conversations", convId, "bots"] + submit "POST" $ + req + & zType "access" + & addJSONObject ["provider" .= providerId, "service" .= serviceId] diff --git a/integration/test/SetupHelpers.hs b/integration/test/SetupHelpers.hs index 80b3e1778fc..cc25f9599cb 100644 --- a/integration/test/SetupHelpers.hs +++ b/integration/test/SetupHelpers.hs @@ -288,7 +288,9 @@ setupProvider :: setupProvider u np@(NewProvider {..}) = do dom <- objDomain u provider <- newProvider u np - pass <- provider %. "password" & asString + pass <- case newProviderPassword of + Nothing -> provider %. "password" & asString + Just pass -> pure pass (key, code) <- do pair <- getProviderActivationCodeInternal dom newProviderEmail `bindResponse` \resp -> do diff --git a/integration/test/Test/Bot.hs b/integration/test/Test/Bot.hs new file mode 100644 index 00000000000..ff399e98fc7 --- /dev/null +++ b/integration/test/Test/Bot.hs @@ -0,0 +1,152 @@ +module Test.Bot where + +import API.Brig +import API.Common +import API.Galley +import Control.Lens hiding ((.=)) +import qualified Data.Aeson as Aeson +import qualified Data.ProtoLens as Proto +import Data.String.Conversions (cs) +import Network.HTTP.Types (status200, status201) +import Network.Wai (responseLBS) +import qualified Network.Wai as Wai +import qualified Network.Wai.Route as Wai +import Numeric.Lens (hex) +import qualified Proto.Otr as Proto +import qualified Proto.Otr_Fields as Proto +import SetupHelpers +import Testlib.Certs +import Testlib.MockIntegrationService +import Testlib.Prelude +import UnliftIO + +{- FUTUREWORK(mangoiv): + - + - In general the situation is as follows: we only support self-signed certificates, and there's no + - way of testing we support anything but self-signed certs due to the simple reason of not being able + - to obtain a valid certificate for testing reasons without modifying brig to accept some root cert + - generated by us. + - + - These tests exist to document this behaviour. If, in the future, some situation would arise that + - makes us add the certificate validation for PKI, there are already helpers in place in the 'Testlib.Certs' + - module. + - + - In more long form: + - + - The issue is as follows: + - + - certificate validation should work only for self-signed certs, this is checked by the signature + - verification function; so this test fails if there's any unknown entity (CA) involved who + - signed the cert. (a cert can only have one signatory, a CA or self) + - + - this test succeeds if the signature verification fails (because it's not self signed), however, + - even if Brig starts to do signature verification, the test would still succeed, because brig + - doesn't know (or trust) the CA, anyway, even if it does signature verification. + - + - For this test to make sense, we would have to make sure that the brig we're testing against + - *would* trust the CA, *if* it did verification, because only in that case it would now succeed + - with verification and not return a "PinInvalidCert" error. + - + - -} +testBotUnknownSignatory :: App () +testBotUnknownSignatory = do + (_, rootPrivKey) <- mkKeyPair primesA + (ownerPubKey, privateKeyToString -> ownerPrivKey) <- mkKeyPair primesB + let rootSignedLeaf = signedCertToString $ intermediateCert "Kabel" ownerPubKey "Example-Root" rootPrivKey + settings = MkMockServerSettings rootSignedLeaf ownerPrivKey (publicKeyToString ownerPubKey) + withBotWithSettings settings \resp' -> withResponse resp' \resp -> do + resp.status `shouldMatchInt` 502 + resp.json %. "label" `shouldMatch` "bad-gateway" + resp.json %. "message" `shouldMatch` "The upstream service returned an invalid response: PinInvalidCert" + +testBotSelfSigned :: App () +testBotSelfSigned = do + keys@(publicKeyToString -> pub, privateKeyToString -> priv) <- mkKeyPair primesA + let cert = signedCertToString $ selfSignedCert "Kabel" keys + withBotWithSettings MkMockServerSettings {certificate = cert, privateKey = priv, publicKey = pub} \resp' -> do + resp <- withResponse resp' \resp -> do + resp.status `shouldMatchInt` 201 + pure resp + + -- If self signed, we should be able to exchange messages + -- with the bot conversation. + botClient <- resp.json %. "client" + botId <- resp.json %. "id" + aliceQid <- resp.json %. "event.qualified_from" + conv <- resp.json %. "event.qualified_conversation" + + aliceC <- getJSON 201 =<< addClient aliceQid def + aliceCid <- objId aliceC + + msg <- + mkProteusRecipients + aliceQid + [(botId, [botClient])] + "hi bot" + let aliceBotMessage = + Proto.defMessage @Proto.QualifiedNewOtrMessage + & #sender . Proto.client .~ (aliceCid ^?! hex) + & #recipients .~ [msg] + & #reportAll .~ Proto.defMessage + assertStatus 201 + =<< postProteusMessage aliceQid conv aliceBotMessage + +withBotWithSettings :: + MockServerSettings -> + (Response -> App ()) -> + App () +withBotWithSettings settings k = do + alice <- randomUser OwnDomain def + + withMockServer settings mkBotService \(host, port) _chan -> do + email <- randomEmail + provider <- setupProvider alice def {newProviderEmail = email, newProviderPassword = Just defPassword} + providerId <- provider %. "id" & asString + service <- + newService OwnDomain providerId $ + def {newServiceUrl = "https://" <> host <> ":" <> show port, newServiceKey = cs settings.publicKey} + serviceId <- asString $ service %. "id" + conv <- getJSON 201 =<< postConversation alice defProteus + convId <- conv %. "id" & asString + assertStatus 200 =<< updateServiceConn providerId serviceId do + object ["enabled" .= True, "password" .= defPassword] + addBot alice providerId serviceId convId >>= k + +data BotEvent + = BotCreated + | BotMessage String + deriving stock (Eq, Ord, Show) + +mkBotService :: Chan BotEvent -> LiftedApplication +mkBotService chan = + Wai.route + [ (cs "/bots", onBotCreate chan), + (cs "/bots/:bot/messages", onBotMessage chan), + (cs "/alive", onBotAlive chan) + ] + +onBotCreate, + onBotMessage, + onBotAlive :: + Chan BotEvent -> + [(ByteString, ByteString)] -> + Wai.Request -> + (Wai.Response -> App Wai.ResponseReceived) -> + App Wai.ResponseReceived +onBotCreate chan _headers _req k = do + ((: []) -> pks) <- getPrekey + writeChan chan BotCreated + lpk <- getLastPrekey + k $ responseLBS status201 mempty do + Aeson.encode $ + object + [ "prekeys" .= pks, + "last_prekey" .= lpk + ] +onBotMessage chan _headers req k = do + body <- liftIO $ Wai.strictRequestBody req + writeChan chan (BotMessage (cs body)) + liftIO $ putStrLn $ cs body + k (responseLBS status200 mempty mempty) +onBotAlive _chan _headers _req k = do + k (responseLBS status200 mempty (cs "success")) diff --git a/integration/test/Test/LegalHold.hs b/integration/test/Test/LegalHold.hs index b0f4db871cc..e049335a419 100644 --- a/integration/test/Test/LegalHold.hs +++ b/integration/test/Test/LegalHold.hs @@ -48,7 +48,7 @@ import UnliftIO (Chan, readChan, timeout) testLHPreventAddingNonConsentingUsers :: App () testLHPreventAddingNonConsentingUsers = do - withMockServer lhMockApp $ \lhDomAndPort _chan -> do + withMockServer def lhMockApp $ \lhDomAndPort _chan -> do (owner, tid, [alice, alex]) <- createTeam OwnDomain 3 legalholdWhitelistTeam tid owner >>= assertSuccess @@ -113,7 +113,7 @@ testLHMessageExchange (TaggedBool clients1New) (TaggedBool clients2New) = do -- We used to throw LegalholdConflictsOldClients if clients didn't have LH capability, but we -- don't do that any more because that broke things. -- Related: https://github.com/wireapp/wire-server/pull/4056 - withMockServer lhMockApp $ \lhDomAndPort _chan -> do + withMockServer def lhMockApp $ \lhDomAndPort _chan -> do (owner, tid, [mem1, mem2]) <- createTeam OwnDomain 3 let clientSettings :: Bool -> AddClient @@ -187,7 +187,7 @@ data LHApprovedOrPending -- | Cannot fetch prekeys of LH users if requester has not given consent or has old clients. testLHClaimKeys :: LHApprovedOrPending -> TestClaimKeys -> App () testLHClaimKeys approvedOrPending testmode = do - withMockServer lhMockApp $ \lhDomAndPort _chan -> do + withMockServer def lhMockApp $ \lhDomAndPort _chan -> do (lowner, ltid, [lmem]) <- createTeam OwnDomain 2 (powner, ptid, [pmem]) <- createTeam OwnDomain 2 @@ -288,7 +288,7 @@ testLHRequestDevice = do lpk <- getLastPrekey pks <- replicateM 3 getPrekey - withMockServer (lhMockAppWithPrekeys MkCreateMock {nextLastPrey = pure lpk, somePrekeys = pure pks}) \lhDomAndPort _chan -> do + withMockServer def (lhMockAppWithPrekeys MkCreateMock {nextLastPrey = pure lpk, somePrekeys = pure pks}) \lhDomAndPort _chan -> do let statusShouldBe :: String -> App () statusShouldBe status = legalholdUserStatus tid alice bob `bindResponse` \resp -> do @@ -355,7 +355,7 @@ testLHApproveDevice = do approveLegalHoldDevice tid (bob %. "qualified_id") defPassword >>= assertLabel 412 "legalhold-not-pending" - withMockServer lhMockApp \lhDomAndPort chan -> do + withMockServer def lhMockApp \lhDomAndPort chan -> do legalholdWhitelistTeam tid alice >>= assertStatus 200 postLegalHoldSettings tid alice (mkLegalHoldSettings lhDomAndPort) @@ -434,6 +434,7 @@ testLHGetDeviceStatus = do pks <- replicateM 3 getPrekey withMockServer + def do lhMockAppWithPrekeys MkCreateMock {nextLastPrey = pure lpk, somePrekeys = pure pks} \lhDomAndPort _chan -> do legalholdWhitelistTeam tid alice @@ -480,7 +481,7 @@ testLHDisableForUser :: App () testLHDisableForUser = do (alice, tid, [bob]) <- createTeam OwnDomain 2 - withMockServer lhMockApp \lhDomAndPort chan -> do + withMockServer def lhMockApp \lhDomAndPort chan -> do setUpLHDevice tid alice bob lhDomAndPort bobc <- objId $ addClient bob def `bindResponse` getJSON 201 @@ -529,7 +530,7 @@ testLHEnablePerTeam = do resp.json %. "lockStatus" `shouldMatch` "unlocked" resp.json %. "status" `shouldMatch` "disabled" - withMockServer lhMockApp \lhDomAndPort _chan -> do + withMockServer def lhMockApp \lhDomAndPort _chan -> do setUpLHDevice tid alice bob lhDomAndPort legalholdUserStatus tid alice bob `bindResponse` \resp -> do @@ -560,7 +561,7 @@ testLHGetMembersIncludesStatus = do bobMember %. "legalhold_status" `shouldMatch` status statusShouldBe "no_consent" - withMockServer lhMockApp \lhDomAndPort _chan -> do + withMockServer def lhMockApp \lhDomAndPort _chan -> do statusShouldBe "no_consent" legalholdWhitelistTeam tid alice @@ -613,7 +614,7 @@ testLHConnectionsWithNonConsentingUsers = do legalholdWhitelistTeam tid alice >>= assertStatus 200 - withMockServer lhMockApp \lhDomAndPort _chan -> do + withMockServer def lhMockApp \lhDomAndPort _chan -> do postLegalHoldSettings tid alice (mkLegalHoldSettings lhDomAndPort) >>= assertStatus 201 @@ -674,7 +675,7 @@ testLHConnectionsWithConsentingUsers = do legalholdWhitelistTeam teamB bob >>= assertStatus 200 - withMockServer lhMockApp \lhDomAndPort _chan -> do + withMockServer def lhMockApp \lhDomAndPort _chan -> do postLegalHoldSettings teamA alice (mkLegalHoldSettings lhDomAndPort) >>= assertStatus 201 @@ -713,7 +714,7 @@ testLHNoConsentRemoveFromGroup approvedOrPending admin = do (alice, tidAlice, []) <- createTeam OwnDomain 1 (bob, tidBob, []) <- createTeam OwnDomain 1 legalholdWhitelistTeam tidAlice alice >>= assertStatus 200 - withMockServer lhMockApp \lhDomAndPort _chan -> do + withMockServer def lhMockApp \lhDomAndPort _chan -> do postLegalHoldSettings tidAlice alice (mkLegalHoldSettings lhDomAndPort) >>= assertStatus 201 withWebSockets [alice, bob] \[aws, bws] -> do connectTwoUsers alice bob @@ -787,7 +788,7 @@ testLHHappyFlow = do lpk <- getLastPrekey pks <- replicateM 3 getPrekey - withMockServer (lhMockAppWithPrekeys MkCreateMock {nextLastPrey = pure lpk, somePrekeys = pure pks}) \lhDomAndPort _chan -> do + withMockServer def (lhMockAppWithPrekeys MkCreateMock {nextLastPrey = pure lpk, somePrekeys = pure pks}) \lhDomAndPort _chan -> do postLegalHoldSettings tid alice (mkLegalHoldSettings lhDomAndPort) >>= assertStatus 201 -- implicit consent @@ -834,7 +835,7 @@ testLHGetStatus = do check u bob "no_consent" check u emil "no_consent" legalholdWhitelistTeam tid alice >>= assertStatus 200 - withMockServer lhMockApp \lhDomAndPort _chan -> do + withMockServer def lhMockApp \lhDomAndPort _chan -> do postLegalHoldSettings tid alice (mkLegalHoldSettings lhDomAndPort) >>= assertStatus 201 for_ [alice, bob, charlie, debora, emil] \u -> do check u bob "disabled" @@ -850,7 +851,7 @@ testLHCannotCreateGroupWithUsersInConflict = do legalholdWhitelistTeam tidAlice alice >>= assertStatus 200 connectTwoUsers bob charlie connectTwoUsers bob debora - withMockServer lhMockApp \lhDomAndPort _chan -> do + withMockServer def lhMockApp \lhDomAndPort _chan -> do postLegalHoldSettings tidAlice alice (mkLegalHoldSettings lhDomAndPort) >>= assertStatus 201 postConversation bob defProteus {qualifiedUsers = [charlie, alice], newUsersRole = "wire_member", team = Just tidAlice} >>= assertStatus 201 @@ -876,7 +877,7 @@ testNoConsentCannotBeInvited = do connectUsers [peer, userLHNotActivated] connectUsers [peer2, userLHNotActivated] - withMockServer lhMockApp \lhDomAndPort _chan -> do + withMockServer def lhMockApp \lhDomAndPort _chan -> do postLegalHoldSettings tidLH legalholder (mkLegalHoldSettings lhDomAndPort) >>= assertStatus 201 cid <- postConversation userLHNotActivated defProteus {qualifiedUsers = [legalholder], newUsersRole = "wire_admin", team = Just tidLH} >>= getJSON 201 addMembers userLHNotActivated cid (def {users = [peer], role = Just "wire_admin"}) >>= assertSuccess diff --git a/integration/test/Testlib/Certs.hs b/integration/test/Testlib/Certs.hs new file mode 100644 index 00000000000..5a8ecee6af2 --- /dev/null +++ b/integration/test/Testlib/Certs.hs @@ -0,0 +1,144 @@ +module Testlib.Certs where + +import Crypto.Hash.Algorithms (SHA256 (SHA256)) +import qualified Crypto.PubKey.RSA as RSA +import qualified Crypto.PubKey.RSA.PKCS15 as PKCS15 +import Crypto.Store.PKCS8 (PrivateKeyFormat (PKCS8Format), keyToPEM) +import Crypto.Store.X509 (pubKeyToPEM) +import Data.ASN1.OID (OIDable (getObjectID)) +import Data.Hourglass +import Data.PEM (PEM (PEM), pemWriteBS) +import Data.String.Conversions (cs) +import Data.X509 +import Testlib.Prelude + +type RSAKeyPair = (RSA.PublicKey, RSA.PrivateKey) + +type SignedCert = SignedExact Certificate + +-- | convert a PEM to a string +toPem :: PEM -> String +toPem = cs . pemWriteBS + +-- | convert a signed certificate to a string +signedCertToString :: SignedCert -> String +signedCertToString = toPem . PEM "CERTIFICATE" [] . encodeSignedObject + +-- | convert a private key to string +privateKeyToString :: RSA.PrivateKey -> String +privateKeyToString = toPem . keyToPEM PKCS8Format . PrivKeyRSA + +-- | convert a public key to string +publicKeyToString :: RSA.PublicKey -> String +publicKeyToString = toPem . pubKeyToPEM . PubKeyRSA + +-- | order: publickey, private key +keyPairToString :: RSAKeyPair -> (String, String) +keyPairToString = bimap publicKeyToString privateKeyToString + +-- | the minimum key size is hard coded to be 256 bytes (= 2048 bits) +mkKeyPair :: HasCallStack => (Integer, Integer) -> App RSAKeyPair +mkKeyPair primes = + assertJust "key generation failed" $ + RSA.generateWith + primes + 2048 + 65537 + +primesA :: (Integer, Integer) +primesA = + ( 1013416710455617992060044810859399709890835129925648843043641673852539448350775594187007527506724875627885909523835606557173980236290013476205929897072239944138314384631600538474898358198731711608598716779857515154388088878657555928549962380829213547435085854695442354636327047821108802590374275481605077802187415357974963365435650338024405558985202998762641404395411587629314013330411500470203761301812113710962088477051775450894192994742118846780105265558368972170180276350636994878636389758206123738715722878057404540464220733023391993383290494652037274532356460190907090422144536951440069212998822960155765054879900781581263606916652700903953626527029121897494538017122565993895036773799860052414697053960902764894046849087727915659738623914130083281919853081537137782445589156217286369690178786653090799221857147470043219175767249163571686740347462294750028790472737772761949491538873890614496706566060247820117584298845501935064037819052405654373374661838572553244593002834443762478259268799467895951456315647324157054992319938064879914915556645111272573189405077515029783954913337757933225821260787418411247627537065834022908147122036442414923430533383989652364612738513379313521406363716216150953874675705623133860932309998632104801092827841702718992714882139811954467163400593020720191718049863114367363094097654194786896842879463158349468509662084081492854544553121389587671952367596127566679408181243898540691657673709282297206699665271972122876732477153246545187514721891966873910637813569799235783300883640120382296336980469139678449923244327325676463743789034561023783533980749100272005938046751700931286800296518645750336292219055157506140422334232031499441618108378207249469768514341014613604798707882336528213109908520952809254346958192134161621644423814067058523341464457188689237566854457651740962437154879472377563420329379777383724869785437079461381042576932777663816932792106785972722313112138774627384189872028788531464434347861094422498231096686231475413078333450041613628998736286930594422166708703115486915826404578851616898264340560519310655180870217752558303339822824214706404615558734661262111177357709447064658518593459191904042065215329175588893364731436963818899069593653897213811368511785916948261704025900054681973429106441628584851712758726618885443787735678619865846520873765930283904988556631550968487727144405349504203063775775239807234977371854786517646240982498594502233136236903225375658288185007963323167751702824125884605983, + 927336758709169856221729309972684377326012758705584701160913392855296574209188805952293975727392736357355525822682625960867980784906333126250176772633612511280160520450355917665344680820117001909657304528897728644985372222487760541890997744380957145384918405839817509991111341989419216342513467094263440712622240826707558561965237909070383875063686755789716081493927682670013715434239129366779748040394792694841549258598842315715859562294976974200564408338450316192760863885386436881465495436476022429943600686139972778561942722494137924396693749231870673494020761865863446686474725091312431012619078931330640808188498974525508440925548025604310429878232463952454557835744654770844144316962049844107999645072674978011865146180434315809137160022154815275730622923394822959089495198091753080586758917401240837851455881168916390487103230014598246305055773428160686563500509562651266122967947533947385066722712316194439650272469880653336775557226431438158529031941085177895035782278423238393385871537920481620086314516883242108371084035236009476902958675684122414056114458154814623140680549398143962297844269217544119579639388880282746926211911340151495180800938356829417651851575812389707158878607136197574826859775996273379970390171328581948608028025142182853278853363612390290636206287758711077096741448655899931751827724488361988091582792716911972718148392453707898042946671553774030598713651389432173834332238513353580335392843797930178943386918304488493730840967156657148290968957715981554273773737487151449135620952308225431024688393136984555900143424679822610046551196808932727745248865362347785479364187372055325574195459037155066312293273886348144861748982170185415622553571530631513603477602826429579398186262265223153306278304799915076700814229178193555765145764377299909576623617487785999435363105546438656832847240507003602597491108906216981192670279162943412764046303699081784813538920115117298548433198843455119043790372888336933692344328141527872374759669746090941218187034798766305747971923638002946091334202545017363599031086846658957509235784541901412672981937055987278520433029602910026209333275313496848631869151490522436140352421940732910006747478399676998276993458833024795683746787074826108339213690383195100285198326586610540809574097037429381790444840835133521220930836457168264627708965665242143474257229651142989737540001394269465834767510321913987796958346807012067096569096845804007816516090656151634293085062792873308124403242170010908041 + ) + +primesB :: (Integer, Integer) +primesB = + ( 871155632739595756799368259914317757869334272154983889623497899446351035891726950864760818802838595063934628826345508916199957107684222515882852684036230531365663403198038587540738738037375348907830388509196441061498831829580551641232283859846190461640815357339853825341277581978021694268863680319244800913484314268404426052051276279669361259959567803085510055380452465751288284768848270342730747029989822198165263072973301996345116628415172285009118708059077706393593020607784780174671547072573221780144687345051988772069027762089091988339582468302138720780718092405021682721751886066645363782225165192495156519578684200413534356562613176683748354996198186163955382610564385310389118252336135259031274255451291680971631891663534692283032504605093383857083862510210862275042255073696123798884409160503619458509744563163914332600437715745600147161022540996340483674184441810042828159783031479546834467530369264396884330140711499699266924456618312375561602660949586678704688686856427513634257055225556101020484663286239650064186437382802373072023507182933268791570788599931961833813734037134668038054950930969107492644097198321408480575010280891590867974839171422952718717441444733710567680383351516170682903290649975877510922338625322722929191152330381838484770793021720831482560176937010381470742911288685130877749162737215149115897767752780906005531169766158172378124848548236188253951341833337787491191664609190850061976677827193348008151669235627322237835010267056500055155911065051791530775399726348686264567265615592790858074242165758723415045115369812705468997801074923865225034659418948148275742092201647617244926597099611670028261172621565835558819135359344483800612705319426768052233109556067407938461005945571595672934139094853414792890276083259923707564466948103729121571083500502589982253333701218140215063120367647585300928378204225025283637784718810313259064139990414485231379692327258476858053769854028351496526751167792340279523340296200242416054659843844911906831964521310830916452145341389783536384312312436425360442183300971035975855454272571297920101093815174274315270008040800474966896945391435392494085295376492758667434573362418630322524804767037530872608312526851376234941674830096729913417387669746155771937829809497813203635102474604063142988339458080423659799467256308889003645375406858192706500220530718350804807804829694351252086594036332829897567632623034066916145636238868932684508748622471625137517969447341759208173885041127987345267, + 1030843359898456423663521323846594342599509001361505950190458094255790543792826808869649005832755187592625111972154015489882697017782849415061917844274039201990123282710414810809677284498651901967728601289390435426055251344683598043635553930587608961202440578033000424009931449958127951542294372025522185552538021557179009278446615246891375299863655746951224012338422185000952023195927317706092311999889180603374149659663869483313116251085191329801800565556652256960650364631610748235925879940728370511827034946814052737660926604082837303885143652256413187183052924192977324527952882600246973965189570970469037044568259408811931440525775822585332497163319841870179534838043708793539688804501356153704884928847627798172061867373042270416202913078776299057112318300845218218100606684092792088779583532324019862407866255929320869554565576301069075336647916168479092314004711778618335406757602974282533765740790546167166172626995630463716394043281720388344899550856555259477489548509996409954619324524195894460510128676025203769176155038527250084664954695197534485529595784255553806751541708069739004260117122700058054443774458724994738753921481706985581116480802534320353367271370286704034867136678539759260831996400891886615914808935283451835347282009482924185619896114631919985205238905153951336432886954324618000593140640843908517786951586431386674557882396487935889471856924185568502767114186884930347618747984770073080480895996031031971187681573023398782756925726725786964170460286504569090697402674905089317540771910375616350312239688178277204391962835159620450731320465816254229575392846112372636483958055913716148919092913102176828552932292829256960875180097808893909460952573027221089128208000054670526724565994184754244760290009957352237133054978847493874379201323517903544742831961755055100216728931496213920467911320372016970509300894067675803619448926461034580033818298648457643287641768005986812455071220244863874301028965665847375769473444088940776224643189987541019987285740411119351744972645543429351630677554481991322726604779330104110295967482897278840078926508970545806499140537364387530291523697762079684955475417383069988065253583073257131193644210418873929829417895241230927769637328283865111435730810586338426336027745629520975220163350734423915441885289661065494424704587153904031874537230782548938379423349488654701140981815973723582107593419642780372301171156324514852331126462907486017679770773972513376077318418003532168673261819818236071249 + ) + +-- | create a root certificate authority CertificateBundle +createRootCA :: + HasCallStack => + -- | the root CA's name + String -> + -- | the root CA's keymaterial + RSAKeyPair -> + SignedCert +createRootCA caName (pubKey, privKey) = + mkSignedCert + pubKey + privKey + caName + caName + +-- | sign an intermediate/ leaf certificate by signing with an intermediate/ root CA's key +intermediateCert :: + HasCallStack => + -- | name of the owner of the certificate + String -> + -- | the public key of the owner + RSA.PublicKey -> + -- | name of the signatory (intermediate/ root CA) + String -> + -- | the private (signature) key of the signing (intermediate/ root) CA + RSA.PrivateKey -> + SignedCert +intermediateCert intermediateCaName pubKey rootCaName rootKey = + mkSignedCert + pubKey + rootKey + rootCaName + intermediateCaName + +-- | self sign a certificate +selfSignedCert :: + HasCallStack => + -- | name of the owner + String -> + -- | key material of the owner + RSAKeyPair -> + SignedCert +selfSignedCert ownerName (pubKey, privKey) = + mkSignedCert + pubKey + privKey + ownerName + ownerName + +signMsgWithPrivateKey :: HasCallStack => RSA.PrivateKey -> ByteString -> ByteString +signMsgWithPrivateKey privKey = fromRight (error "signing unsuccessful") . PKCS15.sign Nothing (Just SHA256) privKey + +-- | create a signed certificate +mkSignedCert :: + HasCallStack => + -- | public key of the *owner* + RSA.PublicKey -> + -- | private key of *signatory* + RSA.PrivateKey -> + -- | name of the issuer + String -> + -- | name of the owner + String -> + SignedExact Certificate +mkSignedCert pubKey privKey caName ownerName = + let distinguishedName name = + DistinguishedName + [ (getObjectID DnCommonName, fromString $ name), + (getObjectID DnCountry, fromString "DE") + ] + in fst $ + objectToSignedExact + (\msg -> (signMsgWithPrivateKey privKey msg, SignatureALG HashSHA256 PubKeyALG_RSA, ())) + Certificate + { certVersion = 3, + certSerial = 1, + certSignatureAlg = SignatureALG HashSHA256 PubKeyALG_RSA, + certIssuerDN = distinguishedName caName, + certValidity = (DateTime {dtDate = Date 2000 January 1, dtTime = midNight}, DateTime {dtDate = Date 2049 January 1, dtTime = midNight}), + certSubjectDN = distinguishedName ownerName, + certPubKey = PubKeyRSA pubKey, + certExtensions = Extensions Nothing + } + where + midNight = TimeOfDay 0 0 0 0 diff --git a/integration/test/Testlib/MockIntegrationService.hs b/integration/test/Testlib/MockIntegrationService.hs index 7e91be4b7b5..36ab35612dd 100644 --- a/integration/test/Testlib/MockIntegrationService.hs +++ b/integration/test/Testlib/MockIntegrationService.hs @@ -1,4 +1,13 @@ -module Testlib.MockIntegrationService (withMockServer, lhMockAppWithPrekeys, lhMockApp, mkLegalHoldSettings, CreateMock (..)) where +module Testlib.MockIntegrationService + ( withMockServer, + lhMockAppWithPrekeys, + lhMockApp, + mkLegalHoldSettings, + CreateMock (..), + LiftedApplication, + MockServerSettings (..), + ) +where import Control.Monad.Catch import Control.Monad.Reader @@ -20,72 +29,6 @@ import UnliftIO.Chan import UnliftIO.MVar import UnliftIO.Timeout (timeout) -mockServerPubKey :: String -mockServerPubKey = - "-----BEGIN PUBLIC KEY-----\n\ - \MIIBIjANBgkqhkiG9w0BAQEFAAOCAQ8AMIIBCgKCAQEAu+Kg/PHHU3atXrUbKnw0\n\ - \G06FliXcNt3lMwl2os5twEDcPPFw/feGiAKymxp+7JqZDrseS5D9THGrW+OQRIPH\n\ - \WvUBdiLfGrZqJO223DB6D8K2Su/odmnjZJ2z23rhXoEArTplu+Dg9K+c2LVeXTKV\n\ - \VPOaOzgtAB21XKRiQ4ermqgi3/njr03rXyq/qNkuNd6tNcg+HAfGxfGvvCSYBfiS\n\ - \bUKr/BeArYRcjzr/h5m1In6fG/if9GEI6m8dxHT9JbY53wiksowy6ajCuqskIFg8\n\ - \7X883H+LA/d6X5CTiPv1VMxXdBUiGPuC9IT/6CNQ1/LFt0P37ax58+LGYlaFo7la\n\ - \nQIDAQAB\n\ - \-----END PUBLIC KEY-----" - -mockServerPrivKey :: String -mockServerPrivKey = - "-----BEGIN RSA PRIVATE KEY-----\n\ - \MIIEpAIBAAKCAQEAu+Kg/PHHU3atXrUbKnw0G06FliXcNt3lMwl2os5twEDcPPFw\n\ - \/feGiAKymxp+7JqZDrseS5D9THGrW+OQRIPHWvUBdiLfGrZqJO223DB6D8K2Su/o\n\ - \dmnjZJ2z23rhXoEArTplu+Dg9K+c2LVeXTKVVPOaOzgtAB21XKRiQ4ermqgi3/nj\n\ - \r03rXyq/qNkuNd6tNcg+HAfGxfGvvCSYBfiSbUKr/BeArYRcjzr/h5m1In6fG/if\n\ - \9GEI6m8dxHT9JbY53wiksowy6ajCuqskIFg87X883H+LA/d6X5CTiPv1VMxXdBUi\n\ - \GPuC9IT/6CNQ1/LFt0P37ax58+LGYlaFo7lanQIDAQABAoIBAQC0doVy7zgpLsBv\n\ - \Sz0AnbPe1pjxEwRlntRbJSfSULySALqJvs5s4adSVGUBHX3z/LousAP1SRpCppuU\n\ - \8wrLBFgjQVlaAzyQB84EEl+lNtrG8Jrvd2es9R/4sJDkqy50+yuPN5wnzWPFIjhg\n\ - \3jP5CHDu29y0LMzsY5yjkzDe9B0bueXEZVU+guRjhpwHHKOFeAr9J9bugFUwgeAr\n\ - \jF0TztzFAb0fsUNPiQAho1J5PyjSVgItaPfAPv/p30ROG+rz+Rd5NSSvBC5F+yOo\n\ - \azb84zzwCg/knAfIz7SOMRrmBh2qhGZFZ8gXdq65UaYv+cpT/qo28mpAT2vOkyeD\n\ - \aPZp0ysBAoGBAOQROoDipe/5BTHBcXYuUE1qa4RIj3wgql5I8igXr4K6ppYBmaOg\n\ - \DL2rrnqD86chv0P4l/XOomKFwYhVGXtqRkeYnk6mQXwNVkgqcGbY5PSNyMg5+ekq\n\ - \jSOOPHGzzTWKzYuUDUpB/Lf6jbTv8fq2GYW3ZYiqQ/xiugOvglZrTE7NAoGBANLl\n\ - \irjByfxAWGhzCrDx0x5MBpsetadI9wUA8u1BDdymsRg73FDn3z7NipVUAMDXMGVj\n\ - \lqbCRlHESO2yP4GaPEA4FM+MbTZSuhAYV+SY07mEPLHF64/nJas83Zp91r5rhaqJ\n\ - \L9rWCl3KJ5OUnr3YizCnHIW72FxjwtpjxHJLupsRAoGAGIbhy8qUHeKh9F/hW9xP\n\ - \NoQjW+6Rv7+jktA1eqpRbbW1BJzXcQldVWiJMxPNuEOg1iZ98SlvvTi1P3wnaWZc\n\ - \eIapP7wRfs3QYaJuxCC/Pq2g0ieqALFazGAXkALOJtvujvw1Ea9XBlIjuzmyxEuh\n\ - \Iwg+Gxx0g0f6yTquwax4YGECgYEAnpAK3qKFNO1ECzQDo8oNy0ep59MNDPtlDhQK\n\ - \katJus5xdCD9oq7TQKrVOTTxZAvmzTQ1PqfuqueDVYOhD9Zg2n/P1cRlEGTek99Z\n\ - \pfvppB/yak6+r3FA9yBKFS/r1zuMQg3nNweav62QV/tz5pT7AdeDMGFtaPlwtTYx\n\ - \qyWY5aECgYBPySbPccNj+xxQzxcti2y/UXjC04RgOA/Hm1D0exa0vBqS9uxlOdG8\n\ - \F47rKenpBrslvdfTVsCDB1xyP2ebWVzp6EqMycw6OLPxgo3fBfZ4pi6P+rByh0Cc\n\ - \Lhfh+ET0CPnKCxtop3lUrn4ZvqchS0j3J+M0pDuqoWF5hfKxFhkEIw==\n\ - \-----END RSA PRIVATE KEY-----" - -mockServerCert :: String -mockServerCert = - "-----BEGIN CERTIFICATE-----\n\ - \MIIDdjCCAl4CCQCm0AiwERR/qjANBgkqhkiG9w0BAQsFADB9MQswCQYDVQQGEwJE\n\ - \RTEPMA0GA1UECAwGQmVybGluMQ8wDQYDVQQHDAZCZXJsaW4xGDAWBgNVBAoMD1dp\n\ - \cmUgU3dpc3MgR21iSDERMA8GA1UEAwwId2lyZS5jb20xHzAdBgkqhkiG9w0BCQEW\n\ - \EGJhY2tlbmRAd2lyZS5jb20wHhcNMTYwODA0MTMxNDQyWhcNMzYwNzMwMTMxNDQy\n\ - \WjB9MQswCQYDVQQGEwJERTEPMA0GA1UECAwGQmVybGluMQ8wDQYDVQQHDAZCZXJs\n\ - \aW4xGDAWBgNVBAoMD1dpcmUgU3dpc3MgR21iSDERMA8GA1UEAwwId2lyZS5jb20x\n\ - \HzAdBgkqhkiG9w0BCQEWEGJhY2tlbmRAd2lyZS5jb20wggEiMA0GCSqGSIb3DQEB\n\ - \AQUAA4IBDwAwggEKAoIBAQC74qD88cdTdq1etRsqfDQbToWWJdw23eUzCXaizm3A\n\ - \QNw88XD994aIArKbGn7smpkOux5LkP1Mcatb45BEg8da9QF2It8atmok7bbcMHoP\n\ - \wrZK7+h2aeNknbPbeuFegQCtOmW74OD0r5zYtV5dMpVU85o7OC0AHbVcpGJDh6ua\n\ - \qCLf+eOvTetfKr+o2S413q01yD4cB8bF8a+8JJgF+JJtQqv8F4CthFyPOv+HmbUi\n\ - \fp8b+J/0YQjqbx3EdP0ltjnfCKSyjDLpqMK6qyQgWDztfzzcf4sD93pfkJOI+/VU\n\ - \zFd0FSIY+4L0hP/oI1DX8sW3Q/ftrHnz4sZiVoWjuVqdAgMBAAEwDQYJKoZIhvcN\n\ - \AQELBQADggEBAEuwlHElIGR56KVC1dJiw238mDGjMfQzSP76Wi4zWS6/zZwJUuog\n\ - \BkC+vacfju8UAMvL+vdqkjOVUHor84/2wuq0qn91AjOITD7tRAZB+XLXxsikKv/v\n\ - \OXE3A/lCiNi882NegPyXAfFPp/71CIiTQZps1eQkAvhD5t5WiFYPESxDlvEJrHFY\n\ - \XP4+pp8fL8YPS7iZNIq+z+P8yVIw+B/Hs0ht7wFIYN0xACbU8m9+Rs08JMoT16c+\n\ - \hZMuK3BWD3fzkQVfW0yMwz6fWRXB483ZmekGkgndOTDoJQMdJXZxHpI3t2FcxQYj\n\ - \T45GXxRd18neXtuYa/OoAw9UQFDN5XfXN0g=\n\ - \-----END CERTIFICATE-----" - withFreePortAnyAddr :: (MonadMask m, MonadIO m) => ((Warp.Port, Socket) -> m a) -> m a withFreePortAnyAddr = bracket openFreePortAnyAddr (liftIO . Socket.close . snd) @@ -94,17 +37,23 @@ openFreePortAnyAddr = liftIO $ bindRandomPortTCP (fromString "*6") type LiftedApplication = Request -> (Wai.Response -> App ResponseReceived) -> App ResponseReceived +type Host = String + +-- | The channel exists to facilitate out of http comms between the test and the +-- service. Could be used for recording (request, response) pairs. withMockServer :: (HasCallStack) => - -- | the mock server + -- | the mock server settings + MockServerSettings -> + -- | The certificate and key pair (Chan e -> LiftedApplication) -> -- | the test - ((String, Warp.Port) -> Chan e -> App a) -> + ((Host, Warp.Port) -> Chan e -> App a) -> App a -withMockServer mkApp go = withFreePortAnyAddr \(sPort, sock) -> do +withMockServer settings mkApp go = withFreePortAnyAddr \(sPort, sock) -> do serverStarted <- newEmptyMVar host <- asks integrationTestHostName - let tlss = Warp.tlsSettingsMemory (cs mockServerCert) (cs mockServerPrivKey) + let tlss = Warp.tlsSettingsMemory (cs settings.certificate) (cs settings.privateKey) let defs = Warp.defaultSettings {Warp.settingsPort = sPort, Warp.settingsBeforeMainLoop = putMVar serverStarted ()} buf <- newChan srv <- async $ withRunInIO \inIO -> do @@ -118,6 +67,23 @@ withMockServer mkApp go = withFreePortAnyAddr \(sPort, sock) -> do lhMockApp :: Chan (Wai.Request, LBS.ByteString) -> LiftedApplication lhMockApp = lhMockAppWithPrekeys def +data MockServerSettings = MkMockServerSettings + { -- | the certificate the mock service uses + certificate :: String, + -- | the private key the mock service uses + privateKey :: String, + -- | the public key the mock service uses + publicKey :: String + } + +instance Default MockServerSettings where + def = + MkMockServerSettings + { certificate = mockServerCert, + privateKey = mockServerPrivKey, + publicKey = mockServerPubKey + } + data CreateMock f = MkCreateMock { -- | how to obtain the next last prekey of a mock app nextLastPrey :: f Value, @@ -177,3 +143,69 @@ mkLegalHoldSettings (botHost, lhPort) = "public_key" .= mockServerPubKey, "auth_token" .= "tok" ] + +mockServerPubKey :: String +mockServerPubKey = + "-----BEGIN PUBLIC KEY-----\n\ + \MIIBIjANBgkqhkiG9w0BAQEFAAOCAQ8AMIIBCgKCAQEAu+Kg/PHHU3atXrUbKnw0\n\ + \G06FliXcNt3lMwl2os5twEDcPPFw/feGiAKymxp+7JqZDrseS5D9THGrW+OQRIPH\n\ + \WvUBdiLfGrZqJO223DB6D8K2Su/odmnjZJ2z23rhXoEArTplu+Dg9K+c2LVeXTKV\n\ + \VPOaOzgtAB21XKRiQ4ermqgi3/njr03rXyq/qNkuNd6tNcg+HAfGxfGvvCSYBfiS\n\ + \bUKr/BeArYRcjzr/h5m1In6fG/if9GEI6m8dxHT9JbY53wiksowy6ajCuqskIFg8\n\ + \7X883H+LA/d6X5CTiPv1VMxXdBUiGPuC9IT/6CNQ1/LFt0P37ax58+LGYlaFo7la\n\ + \nQIDAQAB\n\ + \-----END PUBLIC KEY-----" + +mockServerPrivKey :: String +mockServerPrivKey = + "-----BEGIN RSA PRIVATE KEY-----\n\ + \MIIEpAIBAAKCAQEAu+Kg/PHHU3atXrUbKnw0G06FliXcNt3lMwl2os5twEDcPPFw\n\ + \/feGiAKymxp+7JqZDrseS5D9THGrW+OQRIPHWvUBdiLfGrZqJO223DB6D8K2Su/o\n\ + \dmnjZJ2z23rhXoEArTplu+Dg9K+c2LVeXTKVVPOaOzgtAB21XKRiQ4ermqgi3/nj\n\ + \r03rXyq/qNkuNd6tNcg+HAfGxfGvvCSYBfiSbUKr/BeArYRcjzr/h5m1In6fG/if\n\ + \9GEI6m8dxHT9JbY53wiksowy6ajCuqskIFg87X883H+LA/d6X5CTiPv1VMxXdBUi\n\ + \GPuC9IT/6CNQ1/LFt0P37ax58+LGYlaFo7lanQIDAQABAoIBAQC0doVy7zgpLsBv\n\ + \Sz0AnbPe1pjxEwRlntRbJSfSULySALqJvs5s4adSVGUBHX3z/LousAP1SRpCppuU\n\ + \8wrLBFgjQVlaAzyQB84EEl+lNtrG8Jrvd2es9R/4sJDkqy50+yuPN5wnzWPFIjhg\n\ + \3jP5CHDu29y0LMzsY5yjkzDe9B0bueXEZVU+guRjhpwHHKOFeAr9J9bugFUwgeAr\n\ + \jF0TztzFAb0fsUNPiQAho1J5PyjSVgItaPfAPv/p30ROG+rz+Rd5NSSvBC5F+yOo\n\ + \azb84zzwCg/knAfIz7SOMRrmBh2qhGZFZ8gXdq65UaYv+cpT/qo28mpAT2vOkyeD\n\ + \aPZp0ysBAoGBAOQROoDipe/5BTHBcXYuUE1qa4RIj3wgql5I8igXr4K6ppYBmaOg\n\ + \DL2rrnqD86chv0P4l/XOomKFwYhVGXtqRkeYnk6mQXwNVkgqcGbY5PSNyMg5+ekq\n\ + \jSOOPHGzzTWKzYuUDUpB/Lf6jbTv8fq2GYW3ZYiqQ/xiugOvglZrTE7NAoGBANLl\n\ + \irjByfxAWGhzCrDx0x5MBpsetadI9wUA8u1BDdymsRg73FDn3z7NipVUAMDXMGVj\n\ + \lqbCRlHESO2yP4GaPEA4FM+MbTZSuhAYV+SY07mEPLHF64/nJas83Zp91r5rhaqJ\n\ + \L9rWCl3KJ5OUnr3YizCnHIW72FxjwtpjxHJLupsRAoGAGIbhy8qUHeKh9F/hW9xP\n\ + \NoQjW+6Rv7+jktA1eqpRbbW1BJzXcQldVWiJMxPNuEOg1iZ98SlvvTi1P3wnaWZc\n\ + \eIapP7wRfs3QYaJuxCC/Pq2g0ieqALFazGAXkALOJtvujvw1Ea9XBlIjuzmyxEuh\n\ + \Iwg+Gxx0g0f6yTquwax4YGECgYEAnpAK3qKFNO1ECzQDo8oNy0ep59MNDPtlDhQK\n\ + \katJus5xdCD9oq7TQKrVOTTxZAvmzTQ1PqfuqueDVYOhD9Zg2n/P1cRlEGTek99Z\n\ + \pfvppB/yak6+r3FA9yBKFS/r1zuMQg3nNweav62QV/tz5pT7AdeDMGFtaPlwtTYx\n\ + \qyWY5aECgYBPySbPccNj+xxQzxcti2y/UXjC04RgOA/Hm1D0exa0vBqS9uxlOdG8\n\ + \F47rKenpBrslvdfTVsCDB1xyP2ebWVzp6EqMycw6OLPxgo3fBfZ4pi6P+rByh0Cc\n\ + \Lhfh+ET0CPnKCxtop3lUrn4ZvqchS0j3J+M0pDuqoWF5hfKxFhkEIw==\n\ + \-----END RSA PRIVATE KEY-----" + +mockServerCert :: String +mockServerCert = + "-----BEGIN CERTIFICATE-----\n\ + \MIIDdjCCAl4CCQCm0AiwERR/qjANBgkqhkiG9w0BAQsFADB9MQswCQYDVQQGEwJE\n\ + \RTEPMA0GA1UECAwGQmVybGluMQ8wDQYDVQQHDAZCZXJsaW4xGDAWBgNVBAoMD1dp\n\ + \cmUgU3dpc3MgR21iSDERMA8GA1UEAwwId2lyZS5jb20xHzAdBgkqhkiG9w0BCQEW\n\ + \EGJhY2tlbmRAd2lyZS5jb20wHhcNMTYwODA0MTMxNDQyWhcNMzYwNzMwMTMxNDQy\n\ + \WjB9MQswCQYDVQQGEwJERTEPMA0GA1UECAwGQmVybGluMQ8wDQYDVQQHDAZCZXJs\n\ + \aW4xGDAWBgNVBAoMD1dpcmUgU3dpc3MgR21iSDERMA8GA1UEAwwId2lyZS5jb20x\n\ + \HzAdBgkqhkiG9w0BCQEWEGJhY2tlbmRAd2lyZS5jb20wggEiMA0GCSqGSIb3DQEB\n\ + \AQUAA4IBDwAwggEKAoIBAQC74qD88cdTdq1etRsqfDQbToWWJdw23eUzCXaizm3A\n\ + \QNw88XD994aIArKbGn7smpkOux5LkP1Mcatb45BEg8da9QF2It8atmok7bbcMHoP\n\ + \wrZK7+h2aeNknbPbeuFegQCtOmW74OD0r5zYtV5dMpVU85o7OC0AHbVcpGJDh6ua\n\ + \qCLf+eOvTetfKr+o2S413q01yD4cB8bF8a+8JJgF+JJtQqv8F4CthFyPOv+HmbUi\n\ + \fp8b+J/0YQjqbx3EdP0ltjnfCKSyjDLpqMK6qyQgWDztfzzcf4sD93pfkJOI+/VU\n\ + \zFd0FSIY+4L0hP/oI1DX8sW3Q/ftrHnz4sZiVoWjuVqdAgMBAAEwDQYJKoZIhvcN\n\ + \AQELBQADggEBAEuwlHElIGR56KVC1dJiw238mDGjMfQzSP76Wi4zWS6/zZwJUuog\n\ + \BkC+vacfju8UAMvL+vdqkjOVUHor84/2wuq0qn91AjOITD7tRAZB+XLXxsikKv/v\n\ + \OXE3A/lCiNi882NegPyXAfFPp/71CIiTQZps1eQkAvhD5t5WiFYPESxDlvEJrHFY\n\ + \XP4+pp8fL8YPS7iZNIq+z+P8yVIw+B/Hs0ht7wFIYN0xACbU8m9+Rs08JMoT16c+\n\ + \hZMuK3BWD3fzkQVfW0yMwz6fWRXB483ZmekGkgndOTDoJQMdJXZxHpI3t2FcxQYj\n\ + \T45GXxRd18neXtuYa/OoAw9UQFDN5XfXN0g=\n\ + \-----END CERTIFICATE-----" diff --git a/libs/wire-api/src/Wire/API/Error/Brig.hs b/libs/wire-api/src/Wire/API/Error/Brig.hs index 1a9accdd1b8..e0e560920fb 100644 --- a/libs/wire-api/src/Wire/API/Error/Brig.hs +++ b/libs/wire-api/src/Wire/API/Error/Brig.hs @@ -113,10 +113,6 @@ type instance MapError 'ServiceDisabled = 'StaticError 403 "service-disabled" "T type instance MapError 'InvalidBot = 'StaticError 403 "invalid-bot" "The targeted user is not a bot." -type instance MapError 'ServiceDisabled = 'StaticError 403 "service-disabled" "The desired service is currently disabled." - -type instance MapError 'InvalidBot = 'StaticError 403 "invalid-bot" "The targeted user is not a bot." - type instance MapError 'UserNotFound = 'StaticError 404 "not-found" "User not found" type instance MapError 'InvalidConversation = 'StaticError 403 "invalid-conversation" "The operation is not allowed in this conversation." diff --git a/nix/haskell-pins.nix b/nix/haskell-pins.nix index 39b77216b17..5b5aa560ac3 100644 --- a/nix/haskell-pins.nix +++ b/nix/haskell-pins.nix @@ -266,6 +266,7 @@ let "warp" = "warp"; }; }; + }; hackagePins = { # Major re-write upstream, we should get rid of this dependency rather than @@ -289,6 +290,12 @@ let version = "0.3.20"; sha256 = "sha256-PGwjhrRnkH8cLhd7fHTZFd6ts9abp0w5sLlV8ke1yXU="; }; + # PR: https://github.com/wireapp/wire-server/pull/4027 + HsOpenSSL = { + version = "0.11.7.7"; + sha256 = "sha256-45qWTqfY4fwCjTQsQg/f0EPkC5KZ8CFZYH4cwcw3Y18="; + }; + }; # Name -> Source -> Maybe Subpath -> Drv mkGitDrv = name: src: subpath: diff --git a/nix/manual-overrides.nix b/nix/manual-overrides.nix index 2a70e83728d..a3b16e6fee4 100644 --- a/nix/manual-overrides.nix +++ b/nix/manual-overrides.nix @@ -63,6 +63,8 @@ hself: hsuper: { # flags and patches # (these are fine) # ----------------- + cryptostore = hlib.addBuildDepends (hlib.dontCheck (hlib.appendConfigureFlags hsuper.cryptostore [ "-fuse_crypton" ])) + [ hself.crypton hself.crypton-x509 hself.crypton-x509-validation ]; # Make hoogle static to reduce size of the hoogle image hoogle = hlib.justStaticExecutables hsuper.hoogle; http2-manager = hlib.enableCabalFlag hsuper.http2-manager "-f-test-trailing-dot"; diff --git a/services/brig/src/Brig/Provider/RPC.hs b/services/brig/src/Brig/Provider/RPC.hs index 12e17007518..a95873c5ccd 100644 --- a/services/brig/src/Brig/Provider/RPC.hs +++ b/services/brig/src/Brig/Provider/RPC.hs @@ -137,7 +137,7 @@ extLogError scon e = -- Internal RPC -- | Set service connection information in galley. -setServiceConn :: ServiceConn -> (AppT r) () +setServiceConn :: ServiceConn -> AppT r () setServiceConn scon = do Log.debug $ remote "galley" diff --git a/services/galley/src/Galley/Effects/ExternalAccess.hs b/services/galley/src/Galley/Effects/ExternalAccess.hs index 7f6f3c4f0f7..095ecb75b78 100644 --- a/services/galley/src/Galley/Effects/ExternalAccess.hs +++ b/services/galley/src/Galley/Effects/ExternalAccess.hs @@ -26,7 +26,6 @@ module Galley.Effects.ExternalAccess ) where -import Data.Aeson import Data.Id import Galley.Data.Services import Imports @@ -35,7 +34,7 @@ import Wire.API.Event.Conversation data ExternalAccess m a where Deliver :: Foldable f => f (BotMember, Event) -> ExternalAccess m [BotMember] - DeliverAsync :: (ToJSON e, Foldable f) => f (BotMember, e) -> ExternalAccess m () + DeliverAsync :: (Foldable f) => f (BotMember, Event) -> ExternalAccess m () DeliverAndDeleteAsync :: Foldable f => ConvId -> f (BotMember, Event) -> ExternalAccess m () makeSem ''ExternalAccess diff --git a/services/galley/src/Galley/External.hs b/services/galley/src/Galley/External.hs index c7ea60ed63d..a3ada1d3c51 100644 --- a/services/galley/src/Galley/External.hs +++ b/services/galley/src/Galley/External.hs @@ -21,7 +21,6 @@ import Bilge.Request import Bilge.Retry (httpHandlers) import Control.Lens import Control.Retry -import Data.Aeson (ToJSON) import Data.ByteString.Conversion.To import Data.Id import Data.Misc @@ -70,7 +69,7 @@ interpretExternalAccess = interpret $ \case -- | Like deliver, but ignore orphaned bots and return immediately. -- -- FUTUREWORK: Check if this can be removed. -deliverAsync :: ToJSON e => [(BotMember, e)] -> App () +deliverAsync :: [(BotMember, Event)] -> App () deliverAsync = void . forkIO . void . deliver -- | Like deliver, but remove orphaned bots and return immediately. @@ -79,10 +78,10 @@ deliverAndDeleteAsync cnv pushes = void . forkIO $ do gone <- deliver pushes mapM_ (deleteBot cnv . botMemId) gone -deliver :: forall e. ToJSON e => [(BotMember, e)] -> App [BotMember] +deliver :: [(BotMember, Event)] -> App [BotMember] deliver pp = mapM (async . exec) pp >>= foldM eval [] . zip (map fst pp) where - exec :: (BotMember, e) -> App Bool + exec :: (BotMember, Event) -> App Bool exec (b, e) = lookupService (botMemService b) >>= \case Nothing -> pure False @@ -128,7 +127,7 @@ deliver pp = mapM (async . exec) pp >>= foldM eval [] . zip (map fst pp) -- Internal ------------------------------------------------------------------- -deliver1 :: ToJSON e => Service -> BotMember -> e -> App () +deliver1 :: Service -> BotMember -> Event -> App () deliver1 s bm e | s ^. serviceEnabled = do let t = toByteString' (s ^. serviceToken) From 36b2406a55ca6770c454f945924393b56791e1f9 Mon Sep 17 00:00:00 2001 From: Arthur Wolf Date: Thu, 13 Jun 2024 12:14:29 +0200 Subject: [PATCH 27/64] change externallyCreated to useFakeS3 and change its depth (#3895) * change externallyCreated to useFakeS3 and change its depth * fix chart values and doc --------- Co-authored-by: Amit Sagtani --- .../templates/service.yaml | 2 +- charts/nginx-ingress-services/values.yaml | 17 ++++++++--------- 2 files changed, 9 insertions(+), 10 deletions(-) diff --git a/charts/nginx-ingress-services/templates/service.yaml b/charts/nginx-ingress-services/templates/service.yaml index 1acbc358089..4bcfa2fce4f 100644 --- a/charts/nginx-ingress-services/templates/service.yaml +++ b/charts/nginx-ingress-services/templates/service.yaml @@ -14,7 +14,7 @@ spec: selector: app: webapp {{- end }} -{{- if not .Values.service.s3.externallyCreated }} +{{- if .Values.service.useFakeS3 }} --- apiVersion: v1 kind: Service diff --git a/charts/nginx-ingress-services/values.yaml b/charts/nginx-ingress-services/values.yaml index 73d7ee2ee6f..d254733505f 100644 --- a/charts/nginx-ingress-services/values.yaml +++ b/charts/nginx-ingress-services/values.yaml @@ -100,7 +100,7 @@ service: s3: externalPort: 9000 serviceName: fake-aws-s3 - externallyCreated: false # See note below + useFakeS3: true # See note below teamSettings: externalPort: 8080 accountPages: @@ -142,14 +142,13 @@ config: # # For Services: # service: -# s3: -# externallyCreated: true -# ^ externallyCreated might be useful if S3 access is provided by -# an external service such as `minio-external`: in such cases -# we do not want to create yet another service here but rather -# use that service instead in the ingress -# serviceName: minio-external - +# useFakeS3: true +# ^ useFakeS3 should be enabled if S3 access is to be +# provided by fake-aws-s3, inside of the kubernetes cluster. +# when it is something outside of the cluster (like minio-external), +# we should leave this setting off. this setting creates a +# fake-aws-s3 service inside of the cluster, which should be +# what is referred to in the brig configuration. # Configure CSP headers directly in the ingress. # # This is only suggested / needed in setups with multiple backend domains From c2bb1a241f537cbae0841cb3ecaa5b2f2b777335 Mon Sep 17 00:00:00 2001 From: Akshay Mankar Date: Mon, 17 Jun 2024 11:19:28 +0200 Subject: [PATCH 28/64] Define metrics using `Prometheus.unsafeRegister` instead of having the metrics-core wrapper (#4085) * catchErrors middleware: Always record metrics Instead of relying on `Metrics`, use top-level metric registered using `unsafeRegister`. * Use `unsafeRegister` for metrics instead of bunch of IORef HashMaps * federator: Enable GC metrics --- changelog.d/5-internal/federator-metrics | 1 + changelog.d/5-internal/metrics-core | 1 + libs/metrics-core/default.nix | 8 - libs/metrics-core/metrics-core.cabal | 7 +- libs/metrics-core/src/Data/Metrics.hs | 295 ------------------ libs/metrics-core/src/Data/Metrics/AWS.hs | 18 +- libs/metrics-wai/default.nix | 4 - libs/metrics-wai/metrics-wai.cabal | 3 - .../src/Data/Metrics/Middleware.hs | 80 ----- libs/wai-utilities/default.nix | 2 - .../src/Network/Wai/Utilities/Server.hs | 57 ++-- libs/wai-utilities/wai-utilities.cabal | 1 - .../background-worker/background-worker.cabal | 1 - services/background-worker/default.nix | 2 - .../src/Wire/BackgroundWorker.hs | 2 +- .../src/Wire/BackgroundWorker/Env.hs | 3 - .../Wire/BackendNotificationPusherSpec.hs | 2 - .../background-worker/test/Test/Wire/Util.hs | 1 - services/brig/brig.cabal | 1 + services/brig/default.nix | 2 + services/brig/src/Brig/API/Public.hs | 6 +- services/brig/src/Brig/API/User.hs | 38 ++- services/brig/src/Brig/App.hs | 22 +- services/brig/src/Brig/Data/Client.hs | 51 ++- services/brig/src/Brig/Index/Eval.hs | 4 +- services/brig/src/Brig/Index/Migrations.hs | 2 - .../brig/src/Brig/Index/Migrations/Types.hs | 4 +- services/brig/src/Brig/Phone.hs | 38 ++- services/brig/src/Brig/Run.hs | 7 +- services/brig/src/Brig/User/Auth/Cookie.hs | 20 +- services/brig/src/Brig/User/Phone.hs | 19 +- services/brig/src/Brig/User/Search/Index.hs | 120 +++++-- services/cannon/cannon.cabal | 1 + services/cannon/default.nix | 2 + services/cannon/src/Cannon/Run.hs | 26 +- services/cannon/src/Cannon/Types.hs | 18 +- services/cargohold/cargohold.cabal | 1 + services/cargohold/default.nix | 2 + services/cargohold/src/CargoHold/App.hs | 11 +- services/cargohold/src/CargoHold/Metrics.hs | 35 ++- services/cargohold/src/CargoHold/Run.hs | 12 +- services/federator/src/Federator/Env.hs | 4 +- .../federator/src/Federator/Interpreter.hs | 2 +- services/federator/src/Federator/Run.hs | 4 +- services/galley/default.nix | 2 + services/galley/galley.cabal | 1 + services/galley/src/Galley/App.hs | 8 +- services/galley/src/Galley/Env.hs | 2 - services/galley/src/Galley/Monad.hs | 4 +- services/galley/src/Galley/Run.hs | 30 +- services/gundeck/default.nix | 3 +- services/gundeck/gundeck.cabal | 2 +- services/gundeck/src/Gundeck/Env.hs | 8 +- services/gundeck/src/Gundeck/Monad.hs | 6 +- services/gundeck/src/Gundeck/Push.hs | 3 +- services/gundeck/src/Gundeck/Push/Native.hs | 74 ++++- .../gundeck/src/Gundeck/Push/Websocket.hs | 23 +- services/gundeck/src/Gundeck/Run.hs | 19 +- .../src/Gundeck/ThreadBudget/Internal.hs | 91 ++++-- services/gundeck/test/integration/Util.hs | 4 +- services/gundeck/test/unit/ThreadBudget.hs | 7 +- services/proxy/src/Proxy/Env.hs | 9 +- services/proxy/src/Proxy/Run.hs | 8 +- services/spar/src/Spar/Run.hs | 2 +- tools/stern/default.nix | 2 - tools/stern/src/Stern/API.hs | 2 +- tools/stern/src/Stern/App.hs | 5 +- tools/stern/stern.cabal | 1 - 68 files changed, 576 insertions(+), 680 deletions(-) create mode 100644 changelog.d/5-internal/federator-metrics create mode 100644 changelog.d/5-internal/metrics-core delete mode 100644 libs/metrics-core/src/Data/Metrics.hs delete mode 100644 libs/metrics-wai/src/Data/Metrics/Middleware.hs diff --git a/changelog.d/5-internal/federator-metrics b/changelog.d/5-internal/federator-metrics new file mode 100644 index 00000000000..d2453989684 --- /dev/null +++ b/changelog.d/5-internal/federator-metrics @@ -0,0 +1 @@ +federator: Add metrics for garbage collections and unexpected errors that were caught \ No newline at end of file diff --git a/changelog.d/5-internal/metrics-core b/changelog.d/5-internal/metrics-core new file mode 100644 index 00000000000..f9b39a5a634 --- /dev/null +++ b/changelog.d/5-internal/metrics-core @@ -0,0 +1 @@ +metrics-core: Delete `Data.Metrics` in favour of defining metrics closer to where they are being emitted \ No newline at end of file diff --git a/libs/metrics-core/default.nix b/libs/metrics-core/default.nix index f3eab69051a..b7e369144f6 100644 --- a/libs/metrics-core/default.nix +++ b/libs/metrics-core/default.nix @@ -4,16 +4,12 @@ # dependencies are added or removed. { mkDerivation , base -, containers , gitignoreSource -, hashable , immortal , imports , lib , prometheus-client -, text , time -, unordered-containers }: mkDerivation { pname = "metrics-core"; @@ -21,14 +17,10 @@ mkDerivation { src = gitignoreSource ./.; libraryHaskellDepends = [ base - containers - hashable immortal imports prometheus-client - text time - unordered-containers ]; description = "Metrics core"; license = lib.licenses.agpl3Only; diff --git a/libs/metrics-core/metrics-core.cabal b/libs/metrics-core/metrics-core.cabal index 278c23d2a84..67ef9011baa 100644 --- a/libs/metrics-core/metrics-core.cabal +++ b/libs/metrics-core/metrics-core.cabal @@ -12,7 +12,6 @@ build-type: Simple library exposed-modules: - Data.Metrics Data.Metrics.AWS Data.Metrics.GC @@ -66,14 +65,10 @@ library -Wredundant-constraints -Wunused-packages build-depends: - base >=4.9 - , containers - , hashable >=1.2 + base >=4.9 , immortal , imports , prometheus-client - , text >=0.11 , time - , unordered-containers >=0.2 default-language: GHC2021 diff --git a/libs/metrics-core/src/Data/Metrics.hs b/libs/metrics-core/src/Data/Metrics.hs deleted file mode 100644 index 1a7c1726183..00000000000 --- a/libs/metrics-core/src/Data/Metrics.hs +++ /dev/null @@ -1,295 +0,0 @@ -{-# LANGUAGE GeneralizedNewtypeDeriving #-} -{-# LANGUAGE OverloadedStrings #-} - --- This file is part of the Wire Server implementation. --- --- Copyright (C) 2022 Wire Swiss GmbH --- --- This program is free software: you can redistribute it and/or modify it under --- the terms of the GNU Affero General Public License as published by the Free --- Software Foundation, either version 3 of the License, or (at your option) any --- later version. --- --- This program is distributed in the hope that it will be useful, but WITHOUT --- ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS --- FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for more --- details. --- --- You should have received a copy of the GNU Affero General Public License along --- with this program. If not, see . - -module Data.Metrics - ( -- * Types - Path, - Metrics, - Histogram, - Counter, - Gauge, - - -- * Counters - counterGet, - counterAdd, - counterIncr, - counterValue, - - -- * Gauges - gaugeGet, - gaugeAdd, - gaugeSub, - gaugeIncr, - gaugeDecr, - gaugeSet, - gaugeValue, - - -- * Histograms - - -- ** Types - HistogramInfo, - Buckets, - Bucket, - - -- ** Describing Histograms - linearHistogram, - customHistogram, - - -- ** Manipulating Histograms - histoGet, - histoSubmit, - histoValue, - histoTimeAction, - - -- * Helper functions - path, - metrics, - ) -where - -import Data.HashMap.Strict qualified as HM -import Data.Hashable -import Data.Map.Strict qualified as M -import Data.Text qualified as T -import Imports hiding (lookup, union) -import Prometheus qualified as P - --- | Internal Counter type -newtype Counter = Counter P.Counter - --- | Internal Gauge type -newtype Gauge = Gauge P.Gauge - --- | Internal Histogram type -newtype Histogram = Histogram P.Histogram - --- | Represents a descriptive metric path or name. --- --- NOTE: Until all metrics are fully migrated to Prometheus this should be a valid --- name according to collectd; e.g. @net.resources./teams/invitations/info@ --- All names are converted into valid prometheus names when needed via 'toInfo' -newtype Path = Path - { _path :: Text - } - deriving (Eq, Show, Hashable, Semigroup, Monoid) - --- | Create a path -path :: Text -> Path -path = Path - --- | Opaque storage of metrics -data Metrics = Metrics - { counters :: IORef (HashMap Path Counter), - gauges :: IORef (HashMap Path Gauge), - histograms :: IORef (HashMap Path Histogram) - } - deriving (Generic) - --- Initialize an empty set of metrics -metrics :: MonadIO m => m Metrics -metrics = - liftIO $ - Metrics - <$> newIORef HM.empty - <*> newIORef HM.empty - <*> newIORef HM.empty - --- | Converts a CollectD style 'path' to a Metric name usable by prometheus --- This is to provide back compatibility with the previous collect-d metric names --- which often had paths and dot-separated names. --- --- See the spec for valid prometheus names: --- https://prometheus.io/docs/concepts/data_model/ --- --- E.g. we sanitize a metric name like "net.resources._conversations_:cnv-members_:usr.DELETE.time.960" --- into: "net_resources_conversations_:cnv_members_:usr_delete_time_960" -toInfo :: Path -> P.Info -toInfo (Path p) = - P.Info - ( p - & T.map sanitize - & ensureValidStartingChar - & collapseMultipleUnderscores - & T.toLower - ) - "description not provided" - where - ensureValidStartingChar :: Text -> Text - ensureValidStartingChar = T.dropWhile (not . validStartingChar) - validStartingChar :: Char -> Bool - validStartingChar c = isAlpha c || c `elem` ['_', ':'] - collapseMultipleUnderscores :: Text -> Text - collapseMultipleUnderscores = T.intercalate "_" . filter (not . T.null) . T.splitOn "_" - sanitize :: Char -> Char - sanitize ':' = ':' - sanitize c - | isAlphaNum c = c - | otherwise = '_' - --- | Checks whether a given key exists in a mutable hashmap (i.e. one inside an IORef) --- If it exists it is returned, if it does not then one is initialized using the provided --- initializer, then stored, then returned. -getOrCreate :: (MonadIO m, Hashable k) => IORef (HashMap k v) -> k -> IO v -> m v -getOrCreate mapRef key initializer = liftIO $ do - hMap <- readIORef mapRef - maybe initialize pure (HM.lookup key hMap) - where - initialize = do - val <- initializer - atomicModifyIORef' mapRef $ \m -> (HM.insert key val m, val) - ------------------------------------------------------------------------------ --- Counter specifics - --- | Create a counter for a 'Path' -newCounter :: Path -> IO Counter -newCounter p = Counter <$> P.register (P.counter $ toInfo p) - --- | Access the counter for a given 'Path' -counterGet :: MonadIO m => Path -> Metrics -> m Counter -counterGet p m = getOrCreate (counters m) p (newCounter p) - --- | Add the given amount to the counter at 'Path' -counterAdd :: MonadIO m => Double -> Path -> Metrics -> m () -counterAdd x p m = liftIO $ do - Counter c <- counterGet p m - void $ P.addCounter c x - --- | Add 1 to the counter at 'Path' -counterIncr :: MonadIO m => Path -> Metrics -> m () -counterIncr = counterAdd 1 - --- | Get the current value of the Counter -counterValue :: MonadIO m => Counter -> m Double -counterValue (Counter c) = P.getCounter c - ------------------------------------------------------------------------------ --- Gauge specifics - --- | Create a gauge for a 'Path' -newGauge :: Path -> IO Gauge -newGauge p = Gauge <$> P.register (P.gauge $ toInfo p) - --- | Access the gauge for a given 'Path' -gaugeGet :: MonadIO m => Path -> Metrics -> m Gauge -gaugeGet p m = getOrCreate (gauges m) p (newGauge p) - --- | Set the 'Gauge' at 'Path' to the given value -gaugeSet :: MonadIO m => Double -> Path -> Metrics -> m () -gaugeSet x p m = liftIO $ do - Gauge g <- gaugeGet p m - P.setGauge g x - --- | Add the given amount to the gauge at 'Path' -gaugeAdd :: MonadIO m => Double -> Path -> Metrics -> m () -gaugeAdd x p m = liftIO $ do - Gauge g <- gaugeGet p m - P.addGauge g x - --- | Add 1 to the gauge at 'Path' -gaugeIncr :: MonadIO m => Path -> Metrics -> m () -gaugeIncr = gaugeAdd 1 - --- | Subtract 1 from the gauge at 'Path' -gaugeDecr :: MonadIO m => Path -> Metrics -> m () -gaugeDecr = gaugeAdd (-1) - --- | Subtract the given amount from the gauge at 'Path' -gaugeSub :: MonadIO m => Double -> Path -> Metrics -> m () -gaugeSub x = gaugeAdd (-x) - --- | Get the current value of the Gauge -gaugeValue :: MonadIO m => Gauge -> m Double -gaugeValue (Gauge g) = liftIO $ P.getGauge g - ------------------------------------------------------------------------------ --- Histogram specifics - --- | A marker of a bucketing point -type Bucket = Double - --- | Description of discrete buckets which histogram samples will be allocated into -type Buckets = [Bucket] - --- | Describes a histogram metric -data HistogramInfo = HistogramInfo - { hiPath :: Path, - hiBuckets :: Buckets - } - deriving (Eq, Show) - -type RangeStart = Double - -type RangeEnd = Double - -type BucketWidth = Double - --- | Creates a 'HistogramInfo' which has evenly sized buckets of the given 'BucketWidth' --- between 'RangeStart' and 'RangeEnd' -linearHistogram :: Path -> RangeStart -> RangeEnd -> BucketWidth -> HistogramInfo -linearHistogram pth start end width = - HistogramInfo - { hiPath = pth, - hiBuckets = buckets - } - where - count :: Int - count = ceiling $ (end - start) / width - buckets :: Buckets - buckets = P.linearBuckets start width count - --- | Construct a histogram using a given list of buckets. --- It's recommended that you use 'linearHistogram' instead when possible. -customHistogram :: Path -> Buckets -> HistogramInfo -customHistogram pth buckets = HistogramInfo {hiPath = pth, hiBuckets = buckets} - --- | Create a histo for a 'HistogramInfo' -newHisto :: HistogramInfo -> IO Histogram -newHisto HistogramInfo {hiPath, hiBuckets} = - Histogram <$> P.register (P.histogram (toInfo hiPath) hiBuckets) - --- | Access the histogram for a given 'HistogramInfo' -histoGet :: - MonadIO m => - HistogramInfo -> - Metrics -> - m Histogram -histoGet hi@HistogramInfo {hiPath} m = getOrCreate (histograms m) hiPath (newHisto hi) - --- | Get the current distribution of a Histogram -histoValue :: MonadIO m => Histogram -> m (M.Map Bucket Int) -histoValue (Histogram histo) = liftIO $ P.getHistogram histo - --- | Report an individual value to be bucketed in the histogram -histoSubmit :: MonadIO m => Double -> HistogramInfo -> Metrics -> m () -histoSubmit val hi m = liftIO $ do - Histogram h <- histoGet hi m - P.observe h val - --- | Execute and time the provided monadic action and submit it as an entry --- to the provided Histogram metric. --- --- NOTE: If the action throws an exception it will NOT be reported. --- This is particularly relevant for web handlers which signal their response --- with an exception. -histoTimeAction :: (P.MonadMonitor m, MonadIO m) => HistogramInfo -> Metrics -> m a -> m a -histoTimeAction hi m act = do - Histogram h <- histoGet hi m - P.observeDuration h act diff --git a/libs/metrics-core/src/Data/Metrics/AWS.hs b/libs/metrics-core/src/Data/Metrics/AWS.hs index 7ff710f229c..437ad2f0628 100644 --- a/libs/metrics-core/src/Data/Metrics/AWS.hs +++ b/libs/metrics-core/src/Data/Metrics/AWS.hs @@ -16,14 +16,24 @@ module Data.Metrics.AWS (gaugeTokenRemaing) where -import Data.Metrics (Metrics, gaugeSet, path) import Data.Time import Imports +import Prometheus qualified as Prom -gaugeTokenRemaing :: Metrics -> Maybe NominalDiffTime -> IO () -gaugeTokenRemaing m mbRemaining = do +gaugeTokenRemaing :: Maybe NominalDiffTime -> IO () +gaugeTokenRemaing mbRemaining = do let t = toSeconds (fromMaybe 0 mbRemaining) - gaugeSet t (path "aws_auth.token_secs_remaining") m + Prom.setGauge awsAuthTokenSecsRemaining t where toSeconds :: NominalDiffTime -> Double toSeconds = fromRational . toRational + +{-# NOINLINE awsAuthTokenSecsRemaining #-} +awsAuthTokenSecsRemaining :: Prom.Gauge +awsAuthTokenSecsRemaining = + Prom.unsafeRegister $ + Prom.gauge + Prom.Info + { Prom.metricName = "aws_auth.token_secs_remaining", + Prom.metricHelp = "Number of seconds left before AWS Auth expires" + } diff --git a/libs/metrics-wai/default.nix b/libs/metrics-wai/default.nix index eb65cf447ae..eb3a260e929 100644 --- a/libs/metrics-wai/default.nix +++ b/libs/metrics-wai/default.nix @@ -9,10 +9,8 @@ , gitignoreSource , hspec , hspec-discover -, http-types , imports , lib -, metrics-core , servant , servant-multipart , text @@ -30,9 +28,7 @@ mkDerivation { base bytestring containers - http-types imports - metrics-core servant servant-multipart text diff --git a/libs/metrics-wai/metrics-wai.cabal b/libs/metrics-wai/metrics-wai.cabal index 3d9725348fe..ed848c893cb 100644 --- a/libs/metrics-wai/metrics-wai.cabal +++ b/libs/metrics-wai/metrics-wai.cabal @@ -12,7 +12,6 @@ build-type: Simple library exposed-modules: - Data.Metrics.Middleware Data.Metrics.Middleware.Prometheus Data.Metrics.Servant Data.Metrics.Test @@ -73,9 +72,7 @@ library base >=4 && <5 , bytestring >=0.10 , containers - , http-types >=0.8 , imports - , metrics-core >=0.3 , servant , servant-multipart , text >=0.11 diff --git a/libs/metrics-wai/src/Data/Metrics/Middleware.hs b/libs/metrics-wai/src/Data/Metrics/Middleware.hs deleted file mode 100644 index a65c902d6ff..00000000000 --- a/libs/metrics-wai/src/Data/Metrics/Middleware.hs +++ /dev/null @@ -1,80 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} - --- This file is part of the Wire Server implementation. --- --- Copyright (C) 2022 Wire Swiss GmbH --- --- This program is free software: you can redistribute it and/or modify it under --- the terms of the GNU Affero General Public License as published by the Free --- Software Foundation, either version 3 of the License, or (at your option) any --- later version. --- --- This program is distributed in the hope that it will be useful, but WITHOUT --- ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS --- FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for more --- details. --- --- You should have received a copy of the GNU Affero General Public License along --- with this program. If not, see . - --- | FUTUREWORK: use package wai-middleware-prometheus instead and deprecate collectd? -module Data.Metrics.Middleware - ( PathTemplate, - Paths, - withPathTemplate, - requestCounter, - module Data.Metrics, - ) -where - -import Data.Metrics -import Data.Metrics.Types -import Data.Text qualified as T -import Data.Text.Encoding qualified as T -import Imports -import Network.HTTP.Types -import Network.Wai -import Network.Wai.Internal (Response (ResponseRaw)) -import Network.Wai.Route.Tree qualified as Tree - -withPathTemplate :: Paths -> (PathTemplate -> Middleware) -> Middleware -withPathTemplate t f app r k = f (fromMaybe def tmp) app r k - where - def = PathTemplate "N/A" - tmp = - PathTemplate - . T.decodeUtf8 - <$> treeLookup t (Tree.segments $ rawPathInfo r) - --- Count Requests and their status code. --- --- [Note [Raw Response]]: --- --- We ignore the status code of raw responses which are returned after --- websocket communication ends because there is no meaningful status code --- to ask for. WAI uses the fallback response status code (i.e. 500) which --- is only used in servers which do not support raw responses (i.e. not --- Warp). -requestCounter :: Metrics -> PathTemplate -> Middleware -requestCounter m (PathTemplate t) f rq k = f rq onResponse - where - onResponse rs@(ResponseRaw _ _) = do - -- See Note [Raw Response] - counterIncr (path "net.requests") m - k rs - onResponse rs = do - counterIncr (path "net.requests") m - counterIncr (mkPath [t, methodName rq, "status", code rs]) m - k rs - -mkPath :: [Text] -> Path -mkPath = path . mconcat . intersperse "." . ("net.resources" :) -{-# INLINE mkPath #-} - -code :: Response -> Text -code = T.pack . show . statusCode . responseStatus -{-# INLINE code #-} - -methodName :: Request -> Text -methodName = T.decodeUtf8 . requestMethod -{-# INLINE methodName #-} diff --git a/libs/wai-utilities/default.nix b/libs/wai-utilities/default.nix index 1c893b72f76..db4b25e4fb6 100644 --- a/libs/wai-utilities/default.nix +++ b/libs/wai-utilities/default.nix @@ -19,7 +19,6 @@ , kan-extensions , lib , metrics-core -, metrics-wai , openapi3 , pipes , prometheus-client @@ -55,7 +54,6 @@ mkDerivation { imports kan-extensions metrics-core - metrics-wai openapi3 pipes prometheus-client diff --git a/libs/wai-utilities/src/Network/Wai/Utilities/Server.hs b/libs/wai-utilities/src/Network/Wai/Utilities/Server.hs index 1425eec16a8..95657f59dd5 100644 --- a/libs/wai-utilities/src/Network/Wai/Utilities/Server.hs +++ b/libs/wai-utilities/src/Network/Wai/Utilities/Server.hs @@ -33,7 +33,6 @@ module Network.Wai.Utilities.Server requestIdMiddleware, catchErrors, catchErrorsWithRequestId, - OnErrorMetrics, heavyDebugLogging, rethrow5xx, lazyResponseBody, @@ -64,7 +63,6 @@ import Data.ByteString.Char8 qualified as C import Data.ByteString.Lazy qualified as LBS import Data.Domain (domainText) import Data.Metrics.GC (spawnGCMetricsCollector) -import Data.Metrics.Middleware import Data.Streaming.Zlib (ZlibException (..)) import Data.Text.Encoding qualified as Text import Data.Text.Encoding.Error (lenientDecode) @@ -87,7 +85,7 @@ import Network.Wai.Utilities.Error qualified as Wai import Network.Wai.Utilities.JSONResponse import Network.Wai.Utilities.Request (lookupRequestId) import Network.Wai.Utilities.Response -import Prometheus qualified as Prm +import Prometheus qualified as Prom import System.Logger qualified as Log import System.Logger.Class hiding (Error, Settings, format) import System.Posix.Signals (installHandler, sigINT, sigTERM) @@ -100,18 +98,14 @@ data Server = Server { serverHost :: String, serverPort :: Word16, serverLogger :: Logger, - serverMetrics :: Metrics, serverTimeout :: Maybe Int } -defaultServer :: String -> Word16 -> Logger -> Metrics -> Server -defaultServer h p l m = Server h p l m Nothing +defaultServer :: String -> Word16 -> Logger -> Server +defaultServer h p l = Server h p l Nothing newSettings :: MonadIO m => Server -> m Settings -newSettings (Server h p l m t) = do - -- (Atomically) initialise the standard metrics, to avoid races. - void $ gaugeGet (path "net.connections") m - void $ counterGet (path "net.errors") m +newSettings (Server h p l t) = do pure $ setHost (fromString h) . setPort (fromIntegral p) @@ -121,12 +115,22 @@ newSettings (Server h p l m t) = do . setTimeout (fromMaybe 300 t) $ defaultSettings where - connStart = gaugeIncr (path "net.connections") m - connEnd = gaugeDecr (path "net.connections") m + connStart = Prom.incGauge netConnections + connEnd = Prom.decGauge netConnections logStart = Log.info l . msg $ val "Listening on " +++ h +++ ':' +++ p +{-# NOINLINE netConnections #-} +netConnections :: Prom.Gauge +netConnections = + Prom.unsafeRegister $ + Prom.gauge + Prom.Info + { Prom.metricName = "net.connections", + Prom.metricHelp = "Number of active connections" + } + -- Run a WAI 'Application', initiating Warp's graceful shutdown -- on receiving either the INT or TERM signals. After closing -- the listen socket, Warp will be allowed to drain existing @@ -206,8 +210,8 @@ requestIdMiddleware logger reqIdHeaderName origApp req responder = let reqWithId = req {requestHeaders = (reqIdHeaderName, reqId) : req.requestHeaders} origApp reqWithId responder -catchErrors :: Logger -> HeaderName -> OnErrorMetrics -> Middleware -catchErrors l reqIdHeaderName m = catchErrorsWithRequestId (lookupRequestId reqIdHeaderName) l m +catchErrors :: Logger -> HeaderName -> Middleware +catchErrors l reqIdHeaderName = catchErrorsWithRequestId (lookupRequestId reqIdHeaderName) l -- | Create a middleware that catches exceptions and turns -- them into appropriate 'Error' responses, thereby logging @@ -219,9 +223,8 @@ catchErrors l reqIdHeaderName m = catchErrorsWithRequestId (lookupRequestId reqI catchErrorsWithRequestId :: (Request -> Maybe ByteString) -> Logger -> - OnErrorMetrics -> Middleware -catchErrorsWithRequestId getRequestId l m app req k = +catchErrorsWithRequestId getRequestId l app req k = rethrow5xx getRequestId l app req k `catch` errorResponse where mReqId = getRequestId req @@ -229,7 +232,7 @@ catchErrorsWithRequestId getRequestId l m app req k = errorResponse :: SomeException -> IO ResponseReceived errorResponse ex = do er <- runHandlers ex errorHandlers - onError l mReqId m req k er + onError l mReqId req k er {-# INLINEABLE catchErrors #-} @@ -374,31 +377,35 @@ lazyResponseBody rs = case responseToStream rs of -------------------------------------------------------------------------------- -- Utilities --- | 'onError' and 'catchErrors' support both the metrics-core ('Right') and the prometheus --- package introduced for spar ('Left'). -type OnErrorMetrics = [Either Prm.Counter Metrics] - -- | Send an 'Error' response. onError :: MonadIO m => Logger -> Maybe ByteString -> - OnErrorMetrics -> Request -> Continue IO -> Either Wai.Error JSONResponse -> m ResponseReceived -onError g mReqId m r k e = liftIO $ do +onError g mReqId r k e = liftIO $ do case e of Left we -> logError' g mReqId we Right jr -> logJSONResponse g mReqId jr let resp = either waiErrorToJSONResponse id e let code = statusCode (resp.status) - when (code >= 500) $ - either Prm.incCounter (counterIncr (path "net.errors")) `mapM_` m + when (code >= 500) $ Prom.incCounter netErrors flushRequestBody r k (jsonResponseToWai resp) +{-# NOINLINE netErrors #-} +netErrors :: Prom.Counter +netErrors = + Prom.unsafeRegister $ + Prom.counter + Prom.Info + { Prom.metricName = "net.errors", + Prom.metricHelp = "Number of exceptions caught by catchErrors middleware" + } + defaultRequestIdHeaderName :: HeaderName defaultRequestIdHeaderName = "Request-Id" diff --git a/libs/wai-utilities/wai-utilities.cabal b/libs/wai-utilities/wai-utilities.cabal index 4741ef9cd04..f40d486e0f2 100644 --- a/libs/wai-utilities/wai-utilities.cabal +++ b/libs/wai-utilities/wai-utilities.cabal @@ -88,7 +88,6 @@ library , imports , kan-extensions , metrics-core >=0.1 - , metrics-wai >=0.5.7 , openapi3 , pipes >=4.1 , prometheus-client diff --git a/services/background-worker/background-worker.cabal b/services/background-worker/background-worker.cabal index 31657b00ca5..4807e863625 100644 --- a/services/background-worker/background-worker.cabal +++ b/services/background-worker/background-worker.cabal @@ -37,7 +37,6 @@ library , http-client , http2-manager , imports - , metrics-core , metrics-wai , monad-control , prometheus-client diff --git a/services/background-worker/default.nix b/services/background-worker/default.nix index 3698011087d..6ccf66f8ac7 100644 --- a/services/background-worker/default.nix +++ b/services/background-worker/default.nix @@ -21,7 +21,6 @@ , http2-manager , imports , lib -, metrics-core , metrics-wai , monad-control , prometheus-client @@ -60,7 +59,6 @@ mkDerivation { http-client http2-manager imports - metrics-core metrics-wai monad-control prometheus-client diff --git a/services/background-worker/src/Wire/BackgroundWorker.hs b/services/background-worker/src/Wire/BackgroundWorker.hs index b5e745d6558..3a9bc8e298a 100644 --- a/services/background-worker/src/Wire/BackgroundWorker.hs +++ b/services/background-worker/src/Wire/BackgroundWorker.hs @@ -48,7 +48,7 @@ run opts = do -- Close the channel. `extended` will then close the connection, flushing messages to the server. Log.info l $ Log.msg $ Log.val "Closing RabbitMQ channel" Q.closeChannel chan - let server = defaultServer (T.unpack $ opts.backgroundWorker._host) opts.backgroundWorker._port env.logger env.metrics + let server = defaultServer (T.unpack $ opts.backgroundWorker._host) opts.backgroundWorker._port env.logger settings <- newSettings server -- Additional cleanup when shutting down via signals. runSettingsWithCleanup cleanup settings (servantApp env) Nothing diff --git a/services/background-worker/src/Wire/BackgroundWorker/Env.hs b/services/background-worker/src/Wire/BackgroundWorker/Env.hs index 0d3080595f6..9d1265fd131 100644 --- a/services/background-worker/src/Wire/BackgroundWorker/Env.hs +++ b/services/background-worker/src/Wire/BackgroundWorker/Env.hs @@ -7,7 +7,6 @@ import Control.Monad.Base import Control.Monad.Catch import Control.Monad.Trans.Control import Data.Map.Strict qualified as Map -import Data.Metrics qualified as Metrics import HTTP2.Client.Manager import Imports import Network.AMQP.Extended @@ -35,7 +34,6 @@ data Env = Env rabbitmqAdminClient :: RabbitMqAdmin.AdminAPI (Servant.AsClientT IO), rabbitmqVHost :: Text, logger :: Logger, - metrics :: Metrics.Metrics, federatorInternal :: Endpoint, httpManager :: Manager, defederationTimeout :: ResponseTimeout, @@ -75,7 +73,6 @@ mkEnv opts = do Map.fromList [ (BackendNotificationPusher, False) ] - metrics <- Metrics.metrics backendNotificationMetrics <- mkBackendNotificationMetrics let backendNotificationsConfig = opts.backendNotificationPusher pure Env {..} diff --git a/services/background-worker/test/Test/Wire/BackendNotificationPusherSpec.hs b/services/background-worker/test/Test/Wire/BackendNotificationPusherSpec.hs index 472f02d1f2e..6b53ed6e9e3 100644 --- a/services/background-worker/test/Test/Wire/BackendNotificationPusherSpec.hs +++ b/services/background-worker/test/Test/Wire/BackendNotificationPusherSpec.hs @@ -270,7 +270,6 @@ spec = do let federatorInternal = Endpoint "localhost" 8097 http2Manager = undefined statuses = undefined - metrics = undefined rabbitmqAdminClient = mockRabbitMqAdminClient mockAdmin rabbitmqVHost = "test-vhost" defederationTimeout = responseTimeoutNone @@ -288,7 +287,6 @@ spec = do let federatorInternal = Endpoint "localhost" 8097 http2Manager = undefined statuses = undefined - metrics = undefined rabbitmqAdminClient = mockRabbitMqAdminClient mockAdmin rabbitmqVHost = "test-vhost" defederationTimeout = responseTimeoutNone diff --git a/services/background-worker/test/Test/Wire/Util.hs b/services/background-worker/test/Test/Wire/Util.hs index ba698cccc2b..7c6fbf48aab 100644 --- a/services/background-worker/test/Test/Wire/Util.hs +++ b/services/background-worker/test/Test/Wire/Util.hs @@ -21,7 +21,6 @@ testEnv = do let federatorInternal = Endpoint "localhost" 0 rabbitmqAdminClient = undefined rabbitmqVHost = undefined - metrics = undefined defederationTimeout = responseTimeoutNone backendNotificationsConfig = BackendNotificationsConfig 1000 500000 1000 pure Env {..} diff --git a/services/brig/brig.cabal b/services/brig/brig.cabal index b5938bdc426..7b4ca0998ac 100644 --- a/services/brig/brig.cabal +++ b/services/brig/brig.cabal @@ -310,6 +310,7 @@ library , polysemy-plugin , polysemy-time , polysemy-wire-zoo + , prometheus-client , proto-lens >=0.1 , random-shuffle >=0.0.3 , raw-strings-qq diff --git a/services/brig/default.nix b/services/brig/default.nix index 793d7af919b..9d72a9fefea 100644 --- a/services/brig/default.nix +++ b/services/brig/default.nix @@ -95,6 +95,7 @@ , polysemy-wire-zoo , postie , process +, prometheus-client , proto-lens , QuickCheck , random @@ -243,6 +244,7 @@ mkDerivation { polysemy-plugin polysemy-time polysemy-wire-zoo + prometheus-client proto-lens random-shuffle raw-strings-qq diff --git a/services/brig/src/Brig/API/Public.hs b/services/brig/src/Brig/API/Public.hs index be850469eab..3636589b6bd 100644 --- a/services/brig/src/Brig/API/Public.hs +++ b/services/brig/src/Brig/API/Public.hs @@ -779,7 +779,7 @@ createUser (Public.NewUserPublic new) = lift . runExceptT $ do for_ (liftM2 (,) userEmail epair) $ \(e, p) -> sendActivationEmail e userDisplayName p (Just userLocale) newUserTeam for_ (liftM2 (,) userPhone ppair) $ \(p, c) -> - wrapClient $ sendActivationSms p c (Just userLocale) + wrapHttp $ sendActivationSms p c (Just userLocale) for_ (liftM3 (,,) userEmail (createdUserTeam result) newUserTeam) $ \(e, ct, ut) -> sendWelcomeEmail e ct ut (Just userLocale) cok <- @@ -955,7 +955,7 @@ changePhone u _ (Public.puPhone -> phone) = lift . exceptTToMaybe $ do (adata, pn) <- API.changePhone u phone loc <- lift $ wrapClient $ API.lookupLocale u let apair = (activationKey adata, activationCode adata) - lift . wrapClient $ sendActivationSms pn apair loc + lift . wrapHttp $ sendActivationSms pn apair loc removePhone :: ( Member (Embed HttpClientIO) r, @@ -1063,7 +1063,7 @@ beginPasswordReset (Public.NewPasswordReset target) = do loc <- lift $ wrapClient $ API.lookupLocale u lift $ case target of Left email -> sendPasswordResetMail email pair loc - Right phone -> wrapClient $ sendPasswordResetSms phone pair loc + Right phone -> wrapHttp $ sendPasswordResetSms phone pair loc completePasswordReset :: ( Member CodeStore r, diff --git a/services/brig/src/Brig/API/User.hs b/services/brig/src/Brig/API/User.hs index 08ffc85d785..fba40e66135 100644 --- a/services/brig/src/Brig/API/User.hs +++ b/services/brig/src/Brig/API/User.hs @@ -137,7 +137,6 @@ import Data.Json.Util import Data.LegalHold (UserLegalHoldStatus (..), defUserLegalHoldStatus) import Data.List.Extra import Data.List1 as List1 (List1, singleton) -import Data.Metrics qualified as Metrics import Data.Misc import Data.Qualified import Data.Range @@ -149,6 +148,7 @@ import Polysemy import Polysemy.Input (Input) import Polysemy.TinyLog (TinyLog) import Polysemy.TinyLog qualified as Log +import Prometheus qualified as Prom import System.Logger.Message import UnliftIO.Async (mapConcurrently_) import Wire.API.Connection @@ -973,11 +973,10 @@ sendActivationCode emailOrPhone loc call = case emailOrPhone of throwE (ActivationBlacklistedUserKey pk) c <- lift . wrapClient $ fmap snd <$> Data.lookupActivationCode pk p <- wrapClientE $ mkPair pk c Nothing - void . forPhoneKey pk $ \ph -> - lift $ - if call - then wrapClient $ sendActivationCall ph p loc - else wrapClient $ sendActivationSms ph p loc + void . lift . wrapHttp $ forPhoneKey pk $ \ph -> + if call + then sendActivationCall ph p loc + else sendActivationSms ph p loc where notFound = throwM . UserDisplayNameNotFound mkPair k c u = do @@ -1211,7 +1210,7 @@ deleteSelfUser uid pwd = do let n = userDisplayName (accountUser a) either (\e -> lift $ sendDeletionEmail n e k v l) - (\p -> lift $ wrapClient $ sendDeletionSms p k v l) + (\p -> lift $ wrapHttp $ sendDeletionSms p k v l) target `onException` wrapClientE (Code.delete k Code.AccountDeletion) pure $! Just $! Code.codeTTL c @@ -1369,9 +1368,28 @@ deleteUsersNoVerify :: AppT r () deleteUsersNoVerify uids = do liftSem $ for_ uids deleteUserNoVerify - m <- view metrics - Metrics.counterAdd (fromIntegral . length $ uids) (Metrics.path "user.enqueue_multi_delete_total") m - Metrics.counterIncr (Metrics.path "user.enqueue_multi_delete_calls_total") m + void $ Prom.addCounter enqueueMultiDeleteCounter (fromIntegral $ length uids) + Prom.incCounter enqueueMultiDeleteCallsCounter + +{-# NOINLINE enqueueMultiDeleteCounter #-} +enqueueMultiDeleteCounter :: Prom.Counter +enqueueMultiDeleteCounter = + Prom.unsafeRegister $ + Prom.counter + Prom.Info + { Prom.metricName = "user.enqueue_multi_delete_total", + Prom.metricHelp = "Number of users enqueued to be deleted" + } + +{-# NOINLINE enqueueMultiDeleteCallsCounter #-} +enqueueMultiDeleteCallsCounter :: Prom.Counter +enqueueMultiDeleteCallsCounter = + Prom.unsafeRegister $ + Prom.counter + Prom.Info + { Prom.metricName = "user.enqueue_multi_delete_calls_total", + Prom.metricHelp = "Number of users enqueued to be deleted" + } -- | Similar to lookupProfiles except it returns all results and all errors -- allowing for partial success. diff --git a/services/brig/src/Brig/App.hs b/services/brig/src/Brig/App.hs index 643c2191749..d647ab88957 100644 --- a/services/brig/src/Brig/App.hs +++ b/services/brig/src/Brig/App.hs @@ -54,7 +54,6 @@ module Brig.App zauthEnv, digestSHA256, digestMD5, - metrics, applog, turnEnv, sftEnv, @@ -122,8 +121,6 @@ import Control.Monad.Trans.Resource import Data.ByteString.Conversion import Data.Credentials (Credentials (..)) import Data.Domain -import Data.Metrics (Metrics) -import Data.Metrics.Middleware qualified as Metrics import Data.Misc import Data.Qualified import Data.Text qualified as Text @@ -144,6 +141,7 @@ import OpenSSL.Session qualified as SSL import Polysemy import Polysemy.Final import Polysemy.Input (Input, input) +import Prometheus import Ropes.Nexmo qualified as Nexmo import Ropes.Twilio qualified as Twilio import Ssl.Util @@ -174,7 +172,6 @@ data Env = Env _smtpEnv :: Maybe SMTP.SMTP, _emailSender :: Email, _awsEnv :: AWS.Env, - _metrics :: Metrics, _applog :: Logger, _internalEvents :: QueueEnv, _requestId :: RequestId, @@ -218,7 +215,6 @@ newEnv o = do Just md5 <- getDigestByName "MD5" Just sha256 <- getDigestByName "SHA256" Just sha512 <- getDigestByName "SHA512" - mtr <- Metrics.metrics lgr <- Log.mkLogger (Opt.logLevel o) (Opt.logNetStrings o) (Opt.logFormat o) cas <- initCassandra o lgr mgr <- initHttpManager @@ -263,7 +259,7 @@ newEnv o = do kpLock <- newMVar () rabbitChan <- traverse (Q.mkRabbitMqChannelMVar lgr) o.rabbitmq let allDisabledVersions = foldMap expandVersionExp (Opt.setDisabledAPIVersions sett) - idxEnv <- mkIndexEnv o.elasticsearch lgr mtr (Opt.galley o) mgr + idxEnv <- mkIndexEnv o.elasticsearch lgr (Opt.galley o) mgr pure $! Env { _cargohold = mkEndpoint $ Opt.cargohold o, @@ -276,7 +272,6 @@ newEnv o = do _smtpEnv = emailSMTP, _emailSender = Opt.emailSender . Opt.general . Opt.emailSMS $ o, _awsEnv = aws, -- used by `journalEvent` directly - _metrics = mtr, _applog = lgr, _internalEvents = (eventsQueue :: QueueEnv), _requestId = RequestId "N/A", @@ -317,8 +312,8 @@ newEnv o = do pure (Nothing, Just smtp) mkEndpoint service = RPC.host (encodeUtf8 (service ^. host)) . RPC.port (service ^. port) $ RPC.empty -mkIndexEnv :: ElasticSearchOpts -> Logger -> Metrics -> Endpoint -> Manager -> IO IndexEnv -mkIndexEnv esOpts logger metricsStorage galleyEp rpcHttpManager = do +mkIndexEnv :: ElasticSearchOpts -> Logger -> Endpoint -> Manager -> IO IndexEnv +mkIndexEnv esOpts logger galleyEp rpcHttpManager = do mEsCreds :: Maybe Credentials <- for esOpts.credentials initCredentials mEsAddCreds :: Maybe Credentials <- for esOpts.additionalCredentials initCredentials @@ -333,8 +328,7 @@ mkIndexEnv esOpts logger metricsStorage galleyEp rpcHttpManager = do mkBhEnv esOpts.additionalInsecureSkipVerifyTls esOpts.additionalCaCert mEsAddCreds pure $ IndexEnv - { idxMetrics = metricsStorage, - idxLogger = esLogger, + { idxLogger = esLogger, idxElastic = bhEnv, idxRequest = Nothing, idxName = esOpts.index, @@ -490,6 +484,9 @@ instance Monad (AppT r) where instance MonadIO (AppT r) where liftIO io = AppT $ lift $ embedFinal io +instance MonadMonitor (AppT r) where + doIO = liftIO + instance MonadThrow (AppT r) where throwM = liftIO . throwM @@ -604,6 +601,9 @@ instance Cas.MonadClient HttpClientIO where liftIO $ runClient (view casClient env) cl localState f = local (casClient %~ f) +instance MonadMonitor HttpClientIO where + doIO = liftIO + wrapHttpClient :: HttpClientIO a -> AppT r a diff --git a/services/brig/src/Brig/Data/Client.hs b/services/brig/src/Brig/Data/Client.hs index 69e9ac0b829..b214ef7ab06 100644 --- a/services/brig/src/Brig/Data/Client.hs +++ b/services/brig/src/Brig/Data/Client.hs @@ -75,12 +75,12 @@ import Data.HashMap.Strict qualified as HashMap import Data.Id import Data.Json.Util (UTCTimeMillis, toUTCTimeMillis) import Data.Map qualified as Map -import Data.Metrics qualified as Metrics import Data.Set qualified as Set import Data.Text qualified as Text import Data.Time.Clock import Data.UUID qualified as UUID import Imports +import Prometheus qualified as Prom import System.CryptoBox (Result (Success)) import System.CryptoBox qualified as CryptoBox import System.Logger.Class (field, msg, val) @@ -289,7 +289,8 @@ claimPrekey :: ( Log.MonadLogger m, MonadMask m, MonadClient m, - MonadReader Brig.App.Env m + MonadReader Brig.App.Env m, + Prom.MonadMonitor m ) => UserId -> ClientId -> @@ -498,7 +499,8 @@ withOptLock :: forall a m. ( MonadIO m, MonadReader Brig.App.Env m, - Log.MonadLogger m + Log.MonadLogger m, + Prom.MonadMonitor m ) => UserId -> ClientId -> @@ -545,15 +547,14 @@ withOptLock u c ma = go (10 :: Int) toAttributeValue :: Word32 -> AWS.AttributeValue toAttributeValue w = AWS.N $ AWS.toText (fromIntegral w :: Int) reportAttemptFailure :: m () - reportAttemptFailure = - Metrics.counterIncr (Metrics.path "client.opt_lock.optimistic_lock_grab_attempt_failed") =<< view metrics + reportAttemptFailure = Prom.incCounter optimisticLockGrabAttemptFailedCounter reportFailureAndLogError :: m () reportFailureAndLogError = do Log.err $ Log.field "user" (toByteString' u) . Log.field "client" (toByteString' c) . msg (val "PreKeys: Optimistic lock failed") - Metrics.counterIncr (Metrics.path "client.opt_lock.optimistic_lock_failed") =<< view metrics + Prom.incCounter optimisticLockFailedCounter execDyn :: forall r x. (AWS.AWSRequest r, Typeable r, Typeable (AWS.AWSResponse r)) => @@ -563,27 +564,55 @@ withOptLock u c ma = go (10 :: Int) execDyn cnv mkCmd = do cmd <- mkCmd <$> view (awsEnv . prekeyTable) e <- view (awsEnv . amazonkaEnv) - m <- view metrics - liftIO $ execDyn' e m cnv cmd + liftIO $ execDyn' e cnv cmd where execDyn' :: forall y p. (AWS.AWSRequest p, Typeable (AWS.AWSResponse p), Typeable p) => AWS.Env -> - Metrics.Metrics -> (AWS.AWSResponse p -> Maybe y) -> p -> IO (Maybe y) - execDyn' e m conv cmd = recovering policy handlers (const run) + execDyn' e conv cmd = recovering policy handlers (const run) where run = execCatch e cmd >>= either handleErr (pure . conv) handlers = httpHandlers ++ [const $ EL.handler_ AWS._ConditionalCheckFailedException (pure True)] policy = limitRetries 3 <> exponentialBackoff 100000 handleErr (AWS.ServiceError se) | se ^. AWS.serviceError_code == AWS.ErrorCode "ProvisionedThroughputExceeded" = do - Metrics.counterIncr (Metrics.path "client.opt_lock.provisioned_throughput_exceeded") m + Prom.incCounter dynProvisionedThroughputExceededCounter pure Nothing handleErr _ = pure Nothing withLocalLock :: (MonadMask m, MonadIO m) => MVar () -> m a -> m a withLocalLock l ma = do (takeMVar l *> ma) `finally` putMVar l () + +{-# NOINLINE optimisticLockGrabAttemptFailedCounter #-} +optimisticLockGrabAttemptFailedCounter :: Prom.Counter +optimisticLockGrabAttemptFailedCounter = + Prom.unsafeRegister $ + Prom.counter + Prom.Info + { Prom.metricName = "client.opt_lock.optimistic_lock_grab_attempt_failed", + Prom.metricHelp = "Number of times grab attempts for optimisitic lock on prekeys failed" + } + +{-# NOINLINE optimisticLockFailedCounter #-} +optimisticLockFailedCounter :: Prom.Counter +optimisticLockFailedCounter = + Prom.unsafeRegister $ + Prom.counter + Prom.Info + { Prom.metricName = "client.opt_lock.optimistic_lock_failed", + Prom.metricHelp = "Number of time optimisitic lock on prekeys failed" + } + +{-# NOINLINE dynProvisionedThroughputExceededCounter #-} +dynProvisionedThroughputExceededCounter :: Prom.Counter +dynProvisionedThroughputExceededCounter = + Prom.unsafeRegister $ + Prom.counter + Prom.Info + { Prom.metricName = "client.opt_lock.provisioned_throughput_exceeded", + Prom.metricHelp = "Number of times provisioned throughput on DynamoDB was exceeded" + } diff --git a/services/brig/src/Brig/Index/Eval.hs b/services/brig/src/Brig/Index/Eval.hs index 05c5e688882..c19d000c5d9 100644 --- a/services/brig/src/Brig/Index/Eval.hs +++ b/services/brig/src/Brig/Index/Eval.hs @@ -37,7 +37,6 @@ import Data.Aeson (FromJSON) import Data.Aeson qualified as Aeson import Data.ByteString.Lazy.UTF8 qualified as UTF8 import Data.Credentials (Credentials (..)) -import Data.Metrics qualified as Metrics import Database.Bloodhound qualified as ES import Imports import System.Logger qualified as Log @@ -111,8 +110,7 @@ runCommand l = \case additionalCaCert = Nothing } - metricsStorage <- Metrics.metrics - mkIndexEnv esOpts l metricsStorage gly mgr + mkIndexEnv esOpts l gly mgr initES esURI mgr mCreds = let env = ES.mkBHEnv (toESServer esURI) mgr diff --git a/services/brig/src/Brig/Index/Migrations.hs b/services/brig/src/Brig/Index/Migrations.hs index f743f62c157..2fbb8ce5455 100644 --- a/services/brig/src/Brig/Index/Migrations.hs +++ b/services/brig/src/Brig/Index/Migrations.hs @@ -29,7 +29,6 @@ import Control.Lens (to, view, (^.)) import Control.Monad.Catch (MonadThrow, catchAll, finally, throwM) import Data.Aeson (Value, object, (.=)) import Data.Credentials (Credentials (..)) -import Data.Metrics qualified as Metrics import Data.Text qualified as Text import Database.Bloodhound qualified as ES import Imports @@ -87,7 +86,6 @@ mkEnv l es cas galleyEndpoint = do Env envWithAuth <$> initCassandra <*> initLogger - <*> Metrics.metrics <*> pure (view (Opts.esConnection . to Opts.esIndex) es) <*> pure mCreds <*> pure rpcMgr diff --git a/services/brig/src/Brig/Index/Migrations/Types.hs b/services/brig/src/Brig/Index/Migrations/Types.hs index 853570ffb6f..389868c06eb 100644 --- a/services/brig/src/Brig/Index/Migrations/Types.hs +++ b/services/brig/src/Brig/Index/Migrations/Types.hs @@ -25,7 +25,6 @@ import Cassandra qualified as C import Control.Monad.Catch (MonadThrow) import Data.Aeson (FromJSON (..), ToJSON (..), object, withObject, (.:), (.=)) import Data.Credentials (Credentials) -import Data.Metrics (Metrics) import Database.Bloodhound qualified as ES import Imports import Network.HTTP.Client (Manager) @@ -71,7 +70,7 @@ instance MonadIO m => MonadLogger (MigrationActionT m) where instance MonadIO m => Search.MonadIndexIO (MigrationActionT m) where liftIndexIO m = do Env {..} <- ask - let indexEnv = Search.IndexEnv metrics logger bhEnv Nothing searchIndex Nothing Nothing galleyEndpoint httpManager searchIndexCredentials + let indexEnv = Search.IndexEnv logger bhEnv Nothing searchIndex Nothing Nothing galleyEndpoint httpManager searchIndexCredentials Search.runIndexIO indexEnv m instance MonadIO m => ES.MonadBH (MigrationActionT m) where @@ -81,7 +80,6 @@ data Env = Env { bhEnv :: ES.BHEnv, cassandraClientState :: C.ClientState, logger :: Logger.Logger, - metrics :: Metrics, searchIndex :: ES.IndexName, searchIndexCredentials :: Maybe Credentials, httpManager :: Manager, diff --git a/services/brig/src/Brig/Phone.hs b/services/brig/src/Brig/Phone.hs index 9df603e4cc1..e87a46ea739 100644 --- a/services/brig/src/Brig/Phone.hs +++ b/services/brig/src/Brig/Phone.hs @@ -45,11 +45,11 @@ import Control.Lens (view) import Control.Monad.Catch import Control.Retry import Data.LanguageCodes -import Data.Metrics qualified as Metrics import Data.Text qualified as Text import Data.Time.Clock import Imports import Network.HTTP.Client (HttpException, Manager) +import Prometheus qualified as Prom import Ropes.Nexmo qualified as Nexmo import Ropes.Twilio (LookupDetail (..)) import Ropes.Twilio qualified as Twilio @@ -75,7 +75,7 @@ data PhoneException instance Exception PhoneException sendCall :: - (MonadClient m, MonadReader Env m, Log.MonadLogger m) => + (MonadClient m, MonadReader Env m, Log.MonadLogger m, Prom.MonadMonitor m) => Nexmo.Call -> m () sendCall call = unless (isTestPhone $ Nexmo.callTo call) $ do @@ -115,7 +115,8 @@ sendSms :: ( MonadClient m, MonadCatch m, Log.MonadLogger m, - MonadReader Env m + MonadReader Env m, + Prom.MonadMonitor m ) => Locale -> SMSMessage -> @@ -234,7 +235,7 @@ smsBudget = withSmsBudget :: ( MonadClient m, Log.MonadLogger m, - MonadReader Env m + Prom.MonadMonitor m ) => Text -> m a -> @@ -247,7 +248,7 @@ withSmsBudget phone go = do Log.info $ msg (val "SMS budget exhausted.") ~~ field "phone" phone - Metrics.counterIncr (Metrics.path "budget.sms.exhausted") =<< view metrics + Prom.incCounter smsBudgetExhaustedCounter throwM (PhoneBudgetExhausted t) BudgetedValue a b -> do Log.debug $ @@ -269,7 +270,7 @@ callBudget = withCallBudget :: ( MonadClient m, Log.MonadLogger m, - MonadReader Env m + Prom.MonadMonitor m ) => Text -> m a -> @@ -282,7 +283,7 @@ withCallBudget phone go = do Log.info $ msg (val "Voice call budget exhausted.") ~~ field "phone" phone - Metrics.counterIncr (Metrics.path "budget.call.exhausted") =<< view metrics + Prom.incCounter callBudgetExhaustedCounter throwM (PhoneBudgetExhausted t) BudgetedValue a b -> do Log.debug $ @@ -317,3 +318,26 @@ mkPhoneKey orig = x3 :: RetryPolicy x3 = limitRetries 3 <> exponentialBackoff 100000 + +------------------------------------------------------------------------------- +-- Metrics + +{-# NOINLINE callBudgetExhaustedCounter #-} +callBudgetExhaustedCounter :: Prom.Counter +callBudgetExhaustedCounter = + Prom.unsafeRegister $ + Prom.counter + Prom.Info + { Prom.metricName = "budget.call.exhausted", + Prom.metricHelp = "Number of times budget for calls got exhausted" + } + +{-# NOINLINE smsBudgetExhaustedCounter #-} +smsBudgetExhaustedCounter :: Prom.Counter +smsBudgetExhaustedCounter = + Prom.unsafeRegister $ + Prom.counter + Prom.Info + { Prom.metricName = "budget.sms.exhausted", + Prom.metricHelp = "Number of times budget for sending SMS got exhausted" + } diff --git a/services/brig/src/Brig/Run.hs b/services/brig/src/Brig/Run.hs index 8c0c6facda0..7e31ac802b1 100644 --- a/services/brig/src/Brig/Run.hs +++ b/services/brig/src/Brig/Run.hs @@ -108,7 +108,7 @@ run o = do closeEnv e where endpoint' = brig o - server e = defaultServer (unpack $ endpoint' ^. host) (endpoint' ^. port) (e ^. applog) (e ^. metrics) + server e = defaultServer (unpack $ endpoint' ^. host) (endpoint' ^. port) (e ^. applog) mkApp :: Opts -> IO (Wai.Application, Env) mkApp o = do @@ -124,7 +124,7 @@ mkApp o = do . Metrics.servantPrometheusMiddleware (Proxy @ServantCombinedAPI) . GZip.gunzip . GZip.gzip GZip.def - . catchErrors (e ^. applog) defaultRequestIdHeaderName [Right $ e ^. metrics] + . catchErrors (e ^. applog) defaultRequestIdHeaderName -- the servant API wraps the one defined using wai-routing servantApp :: Env -> Wai.Application @@ -242,10 +242,9 @@ pendingActivationCleanup = do collectAuthMetrics :: forall r. AppT r () collectAuthMetrics = do - m <- view metrics env <- view (awsEnv . amazonkaEnv) liftIO $ forever $ do mbRemaining <- readAuthExpiration env - gaugeTokenRemaing m mbRemaining + gaugeTokenRemaing mbRemaining threadDelay 1_000_000 diff --git a/services/brig/src/Brig/User/Auth/Cookie.hs b/services/brig/src/Brig/User/Auth/Cookie.hs index 1bd569bc352..ebed216d947 100644 --- a/services/brig/src/Brig/User/Auth/Cookie.hs +++ b/services/brig/src/Brig/User/Auth/Cookie.hs @@ -52,13 +52,13 @@ import Control.Monad.Except import Data.ByteString.Conversion import Data.Id import Data.List qualified as List -import Data.Metrics qualified as Metrics import Data.Proxy import Data.RetryAfter import Data.Time.Clock import Imports import Network.Wai (Response) import Network.Wai.Utilities.Response (addHeader) +import Prometheus qualified as Prom import System.Logger.Class (field, msg, val, (~~)) import System.Logger.Class qualified as Log import Web.Cookie qualified as WebCookie @@ -104,7 +104,8 @@ nextCookie :: MonadReader Env m, Log.MonadLogger m, ZAuth.MonadZAuth m, - MonadClient m + MonadClient m, + Prom.MonadMonitor m ) => Cookie (ZAuth.Token u) -> Maybe ClientId -> @@ -291,11 +292,20 @@ toWebCookie c = do -------------------------------------------------------------------------------- -- Tracking -trackSuperseded :: (MonadReader Env m, MonadIO m, Log.MonadLogger m) => UserId -> CookieId -> m () +trackSuperseded :: (MonadIO m, Log.MonadLogger m, Prom.MonadMonitor m) => UserId -> CookieId -> m () trackSuperseded u c = do - m <- view metrics - Metrics.counterIncr (Metrics.path "user.auth.cookie.superseded") m + Prom.incCounter cookieSupersededCounter Log.warn $ msg (val "Superseded cookie used") ~~ field "user" (toByteString u) ~~ field "cookie" (cookieIdNum c) + +{-# NOINLINE cookieSupersededCounter #-} +cookieSupersededCounter :: Prom.Counter +cookieSupersededCounter = + Prom.unsafeRegister $ + Prom.counter + Prom.Info + { Prom.metricName = "user.auth.cookie.superseded", + Prom.metricHelp = "Number of times user's cookie got superseded" + } diff --git a/services/brig/src/Brig/User/Phone.hs b/services/brig/src/Brig/User/Phone.hs index f12541ae0aa..f05880eeae5 100644 --- a/services/brig/src/Brig/User/Phone.hs +++ b/services/brig/src/Brig/User/Phone.hs @@ -51,6 +51,7 @@ import Data.Text qualified as Text import Data.Text.Ascii qualified as Ascii import Data.Text.Lazy (toStrict) import Imports +import Prometheus (MonadMonitor) import Ropes.Nexmo qualified as Nexmo import System.Logger.Class qualified as Log import Wire.API.User @@ -62,7 +63,8 @@ sendActivationSms :: ( MonadClient m, MonadReader Env m, MonadCatch m, - Log.MonadLogger m + Log.MonadLogger m, + MonadMonitor m ) => Phone -> ActivationPair -> @@ -77,7 +79,8 @@ sendPasswordResetSms :: ( MonadClient m, MonadReader Env m, MonadCatch m, - Log.MonadLogger m + Log.MonadLogger m, + MonadMonitor m ) => Phone -> PasswordResetPair -> @@ -92,7 +95,8 @@ sendLoginSms :: ( MonadClient m, MonadReader Env m, MonadCatch m, - Log.MonadLogger m + Log.MonadLogger m, + MonadMonitor m ) => Phone -> LoginCode -> @@ -107,7 +111,8 @@ sendDeletionSms :: ( MonadClient m, MonadReader Env m, MonadCatch m, - Log.MonadLogger m + Log.MonadLogger m, + MonadMonitor m ) => Phone -> Code.Key -> @@ -122,7 +127,8 @@ sendDeletionSms to key code loc = do sendActivationCall :: ( MonadClient m, MonadReader Env m, - Log.MonadLogger m + Log.MonadLogger m, + MonadMonitor m ) => Phone -> ActivationPair -> @@ -136,7 +142,8 @@ sendActivationCall to (_, c) loc = do sendLoginCall :: ( MonadClient m, MonadReader Env m, - Log.MonadLogger m + Log.MonadLogger m, + MonadMonitor m ) => Phone -> LoginCode -> diff --git a/services/brig/src/Brig/User/Search/Index.hs b/services/brig/src/Brig/User/Search/Index.hs index 9df5255ce84..b9c098eb4c4 100644 --- a/services/brig/src/Brig/User/Search/Index.hs +++ b/services/brig/src/Brig/User/Search/Index.hs @@ -78,19 +78,19 @@ import Data.Credentials import Data.Handle (Handle) import Data.Id import Data.Map qualified as Map -import Data.Metrics import Data.Text qualified as T import Data.Text qualified as Text import Data.Text.Encoding import Data.Text.Encoding.Error import Data.Text.Lazy qualified as LT -import Data.Text.Lazy.Builder.Int (decimal) import Data.Text.Lens hiding (text) import Data.UUID qualified as UUID import Database.Bloodhound qualified as ES import Imports hiding (log, searchable) import Network.HTTP.Client hiding (host, path, port) import Network.HTTP.Types (StdMethod (POST), hContentType, statusCode) +import Prometheus (MonadMonitor) +import Prometheus qualified as Prom import SAML2.WebSSO.Types qualified as SAML import System.Logger qualified as Log import System.Logger.Class (Logger, MonadLogger (..), field, info, msg, val, (+++), (~~)) @@ -106,8 +106,7 @@ import Wire.API.User.Search (Sso (..)) -- IndexIO Monad data IndexEnv = IndexEnv - { idxMetrics :: Metrics, - idxLogger :: Logger, + { idxLogger :: Logger, idxElastic :: ES.BHEnv, idxRequest :: Maybe RequestId, idxName :: ES.IndexName, @@ -129,7 +128,8 @@ newtype IndexIO a = IndexIO (ReaderT IndexEnv IO a) MonadReader IndexEnv, MonadThrow, MonadCatch, - MonadMask + MonadMask, + MonadMonitor ) runIndexIO :: MonadIO m => IndexEnv -> IndexIO a -> m a @@ -173,15 +173,14 @@ withAdditionalESUrl action = do -------------------------------------------------------------------------------- -- Updates -reindex :: (MonadLogger m, MonadIndexIO m, C.MonadClient m) => UserId -> m () +reindex :: (MonadLogger m, MonadIndexIO m, C.MonadClient m, Prom.MonadMonitor IndexIO) => UserId -> m () reindex u = do ixu <- lookupIndexUser u updateIndex (maybe (IndexDeleteUser u) (IndexUpdateUser IndexUpdateIfNewerVersion) ixu) -updateIndex :: MonadIndexIO m => IndexUpdate -> m () +updateIndex :: (MonadIndexIO m, Prom.MonadMonitor IndexIO) => IndexUpdate -> m () updateIndex (IndexUpdateUser updateType iu) = liftIndexIO $ do - m <- asks idxMetrics - counterIncr (path "user.index.update.count") m + Prom.incCounter indexUpdateCounter info $ field "user" (Bytes.toByteString (view iuUserId iu)) . msg (val "Indexing user") @@ -191,20 +190,18 @@ updateIndex (IndexUpdateUser updateType iu) = liftIndexIO $ do where indexDoc :: (MonadIndexIO m, MonadThrow m) => ES.IndexName -> ES.BH m () indexDoc idx = do - m <- lift . liftIndexIO $ asks idxMetrics r <- ES.indexDocument idx mappingName versioning (indexToDoc iu) docId unless (ES.isSuccess r || ES.isVersionConflict r) $ do - counterIncr (path "user.index.update.err") m + liftIO $ Prom.incCounter indexUpdateErrorCounter ES.parseEsResponse r >>= throwM . IndexUpdateError . either id id - counterIncr (path "user.index.update.ok") m + liftIO $ Prom.incCounter indexUpdateSuccessCounter versioning = ES.defaultIndexDocumentSettings { ES.idsVersionControl = indexUpdateToVersionControl updateType (ES.ExternalDocVersion (docVersion (_iuVersion iu))) } docId = ES.DocId (view (iuUserId . re _TextId) iu) updateIndex (IndexUpdateUsers updateType ius) = liftIndexIO $ do - m <- asks idxMetrics - counterIncr (path "user.index.update.bulk.count") m + Prom.incCounter indexBulkUpdateCounter info $ field "num_users" (length ius) . msg (val "Bulk indexing users") @@ -226,14 +223,11 @@ updateIndex (IndexUpdateUsers updateType ius) = liftIndexIO $ do } (ES.bhManager bhe) unless (ES.isSuccess res) $ do - counterIncr (path "user.index.update.bulk.err") m + Prom.incCounter indexBulkUpdateErrorCounter ES.parseEsResponse res >>= throwM . IndexUpdateError . either id id - counterIncr (path "user.index.update.bulk.ok") m + Prom.incCounter indexBulkUpdateSuccessCounter for_ (statuses res) $ \(s, f) -> - counterAdd - (fromIntegral f) - (path ("user.index.update.bulk.status." <> review builder (decimal s))) - m + Prom.withLabel indexBulkUpdateResponseCounter (Text.pack $ show s) $ (void . flip Prom.addCounter (fromIntegral f)) where mkAuthHeaders = do creds <- asks idxCredentials @@ -261,7 +255,7 @@ updateIndex (IndexUpdateUsers updateType ius) = liftIndexIO $ do . toListOf (key "items" . values . key "index" . key "status" . _Integral) . responseBody updateIndex (IndexDeleteUser u) = liftIndexIO $ do - counterIncr (path "user.index.delete.count") =<< asks idxMetrics + Prom.incCounter indexDeleteCounter info $ field "user" (Bytes.toByteString u) . msg (val "(Soft) deleting user from index") @@ -972,3 +966,87 @@ instance Show ParseException where ++ m instance Exception ParseException + +--------------------------------------------------------------------------------- +-- Metrics + +{-# NOINLINE indexUpdateCounter #-} +indexUpdateCounter :: Prom.Counter +indexUpdateCounter = + Prom.unsafeRegister $ + Prom.counter + Prom.Info + { Prom.metricName = "user.index.update.count", + Prom.metricHelp = "Number of updates on user index" + } + +{-# NOINLINE indexUpdateErrorCounter #-} +indexUpdateErrorCounter :: Prom.Counter +indexUpdateErrorCounter = + Prom.unsafeRegister $ + Prom.counter + Prom.Info + { Prom.metricName = "user.index.update.err", + Prom.metricHelp = "Number of errors during user index update" + } + +{-# NOINLINE indexUpdateSuccessCounter #-} +indexUpdateSuccessCounter :: Prom.Counter +indexUpdateSuccessCounter = + Prom.unsafeRegister $ + Prom.counter + Prom.Info + { Prom.metricName = "user.index.update.ok", + Prom.metricHelp = "Number of successful user index updates" + } + +{-# NOINLINE indexBulkUpdateCounter #-} +indexBulkUpdateCounter :: Prom.Counter +indexBulkUpdateCounter = + Prom.unsafeRegister $ + Prom.counter + Prom.Info + { Prom.metricName = "user.index.update.bulk.count", + Prom.metricHelp = "Number of bulk updates on user index" + } + +{-# NOINLINE indexBulkUpdateErrorCounter #-} +indexBulkUpdateErrorCounter :: Prom.Counter +indexBulkUpdateErrorCounter = + Prom.unsafeRegister $ + Prom.counter + Prom.Info + { Prom.metricName = "user.index.update.bulk.err", + Prom.metricHelp = "Number of errors during bulk updates on user index" + } + +{-# NOINLINE indexBulkUpdateSuccessCounter #-} +indexBulkUpdateSuccessCounter :: Prom.Counter +indexBulkUpdateSuccessCounter = + Prom.unsafeRegister $ + Prom.counter + Prom.Info + { Prom.metricName = "user.index.update.bulk.ok", + Prom.metricHelp = "Number of successful bulk updates on user index" + } + +{-# NOINLINE indexBulkUpdateResponseCounter #-} +indexBulkUpdateResponseCounter :: Prom.Vector Prom.Label1 Prom.Counter +indexBulkUpdateResponseCounter = + Prom.unsafeRegister $ + Prom.vector ("status") $ + Prom.counter + Prom.Info + { Prom.metricName = "user.index.update.bulk.response", + Prom.metricHelp = "Number of successful bulk updates on user index" + } + +{-# NOINLINE indexDeleteCounter #-} +indexDeleteCounter :: Prom.Counter +indexDeleteCounter = + Prom.unsafeRegister $ + Prom.counter + Prom.Info + { Prom.metricName = "user.index.delete.count", + Prom.metricHelp = "Number of deletes on user index" + } diff --git a/services/cannon/cannon.cabal b/services/cannon/cannon.cabal index e69c1a663ae..73ef7133bef 100644 --- a/services/cannon/cannon.cabal +++ b/services/cannon/cannon.cabal @@ -97,6 +97,7 @@ library , lens-family-core >=1.1 , metrics-wai >=0.4 , mwc-random >=0.13 + , prometheus-client , retry >=0.7 , safe-exceptions , servant-conduit diff --git a/services/cannon/default.nix b/services/cannon/default.nix index 2161483f93f..9278d2c1c94 100644 --- a/services/cannon/default.nix +++ b/services/cannon/default.nix @@ -26,6 +26,7 @@ , lib , metrics-wai , mwc-random +, prometheus-client , QuickCheck , random , retry @@ -77,6 +78,7 @@ mkDerivation { lens-family-core metrics-wai mwc-random + prometheus-client retry safe-exceptions servant-conduit diff --git a/services/cannon/src/Cannon/Run.hs b/services/cannon/src/Cannon/Run.hs index c3ec4f6f4d5..ba8256cb62b 100644 --- a/services/cannon/src/Cannon/Run.hs +++ b/services/cannon/src/Cannon/Run.hs @@ -27,7 +27,7 @@ import Cannon.API.Public import Cannon.App (maxPingInterval) import Cannon.Dict qualified as D import Cannon.Options -import Cannon.Types (Cannon, applog, clients, env, mkEnv, monitor, runCannon', runCannonToServant) +import Cannon.Types (Cannon, applog, clients, env, mkEnv, runCannon', runCannonToServant) import Cannon.WS hiding (env) import Control.Concurrent import Control.Concurrent.Async qualified as Async @@ -35,8 +35,6 @@ import Control.Exception qualified as E import Control.Exception.Safe (catchAny) import Control.Lens ((^.)) import Control.Monad.Catch (MonadCatch, finally) -import Data.Metrics.Middleware (gaugeSet, path) -import Data.Metrics.Middleware qualified as Middleware import Data.Metrics.Servant import Data.Proxy import Data.Text (pack, strip) @@ -47,6 +45,7 @@ import Network.Wai qualified as Wai import Network.Wai.Handler.Warp hiding (run) import Network.Wai.Middleware.Gzip qualified as Gzip import Network.Wai.Utilities.Server +import Prometheus qualified as Prom import Servant import System.IO.Strict qualified as Strict import System.Logger.Class qualified as LC @@ -68,16 +67,15 @@ run o = do when (o ^. drainOpts . gracePeriodSeconds == 0) $ error "drainOpts.gracePeriodSeconds must not be set to 0." ext <- loadExternal - m <- Middleware.metrics g <- L.mkLogger (o ^. logLevel) (o ^. logNetStrings) (o ^. logFormat) e <- - mkEnv m ext o g + mkEnv ext o g <$> D.empty 128 <*> newManager defaultManagerSettings {managerConnCount = 128} <*> createSystemRandom <*> mkClock refreshMetricsThread <- Async.async $ runCannon' e refreshMetrics - s <- newSettings $ Server (o ^. cannon . host) (o ^. cannon . port) (applog e) m (Just idleTimeout) + s <- newSettings $ Server (o ^. cannon . host) (o ^. cannon . port) (applog e) (Just idleTimeout) let middleware :: Wai.Middleware middleware = @@ -85,7 +83,7 @@ run o = do . requestIdMiddleware g defaultRequestIdHeaderName . servantPrometheusMiddleware (Proxy @CombinedAPI) . Gzip.gzip Gzip.def - . catchErrors g defaultRequestIdHeaderName [Right m] + . catchErrors g defaultRequestIdHeaderName app :: Application app = middleware (serve (Proxy @CombinedAPI) server) server :: Servant.Server CombinedAPI @@ -133,11 +131,11 @@ instance Exception SignalledToExit refreshMetrics :: Cannon () refreshMetrics = do - m <- monitor c <- clients safeForever $ do s <- D.size c - gaugeSet (fromIntegral s) (path "net.websocket.clients") m + Prom.setGauge websocketClientsGauge (fromIntegral s) + -- gaugeSet (fromIntegral s) (path "") m liftIO $ threadDelay 1000000 where safeForever :: (MonadIO m, LC.MonadLogger m, MonadCatch m) => m () -> m () @@ -146,3 +144,13 @@ refreshMetrics = do action `catchAny` \exc -> do LC.err $ "error" LC..= show exc LC.~~ LC.msg (LC.val "refreshMetrics failed") liftIO $ threadDelay 60000000 -- pause to keep worst-case noise in logs manageable + +{-# NOINLINE websocketClientsGauge #-} +websocketClientsGauge :: Prom.Gauge +websocketClientsGauge = + Prom.unsafeRegister $ + Prom.gauge + Prom.Info + { Prom.metricName = "net.websocket.clients", + Prom.metricHelp = "Number of connected websocket clients" + } diff --git a/services/cannon/src/Cannon/Types.hs b/services/cannon/src/Cannon/Types.hs index 31abc52800c..f9d34c5e788 100644 --- a/services/cannon/src/Cannon/Types.hs +++ b/services/cannon/src/Cannon/Types.hs @@ -19,7 +19,6 @@ module Cannon.Types ( Env, - mon, opts, applog, dict, @@ -32,7 +31,6 @@ module Cannon.Types runCannon', options, clients, - monitor, wsenv, runCannonToServant, ) @@ -47,12 +45,12 @@ import Cannon.WS qualified as WS import Control.Concurrent.Async (mapConcurrently) import Control.Lens ((^.)) import Control.Monad.Catch -import Data.Metrics.Middleware import Data.Text.Encoding import Imports import Network.Wai import Network.Wai.Utilities.Request qualified as Wai import Network.Wai.Utilities.Server +import Prometheus import Servant qualified import System.Logger qualified as Logger import System.Logger.Class hiding (info) @@ -62,8 +60,7 @@ import System.Random.MWC (GenIO) -- Cannon monad data Env = Env - { mon :: !Metrics, - opts :: !Opts, + { opts :: !Opts, applog :: !Logger, dict :: !(Dict Key Websocket), reqId :: !RequestId, @@ -80,7 +77,8 @@ newtype Cannon a = Cannon MonadIO, MonadThrow, MonadCatch, - MonadMask + MonadMask, + MonadMonitor ) mapConcurrentlyCannon :: Traversable t => (a -> Cannon b) -> t a -> Cannon (t b) @@ -99,7 +97,6 @@ instance HasRequestId Cannon where getRequestId = Cannon $ asks reqId mkEnv :: - Metrics -> ByteString -> Opts -> Logger -> @@ -108,8 +105,8 @@ mkEnv :: GenIO -> Clock -> Env -mkEnv m external o l d p g t = - Env m o l d (RequestId "N/A") $ +mkEnv external o l d p g t = + Env o l d (RequestId "N/A") $ WS.env external (o ^. cannon . port) (encodeUtf8 $ o ^. gundeck . host) (o ^. gundeck . port) l p d g t (o ^. drainOpts) runCannon :: Env -> Cannon a -> Request -> IO a @@ -127,9 +124,6 @@ options = Cannon $ asks opts clients :: Cannon (Dict Key Websocket) clients = Cannon $ asks dict -monitor :: Cannon Metrics -monitor = Cannon $ asks mon - wsenv :: Cannon WS.Env wsenv = Cannon $ do e <- asks env diff --git a/services/cargohold/cargohold.cabal b/services/cargohold/cargohold.cabal index f3c5ad95c44..2a8a5b2ba93 100644 --- a/services/cargohold/cargohold.cabal +++ b/services/cargohold/cargohold.cabal @@ -115,6 +115,7 @@ library , metrics-core , metrics-wai >=0.4 , mime >=0.4 + , prometheus-client , resourcet >=1.1 , retry >=0.5 , servant diff --git a/services/cargohold/default.nix b/services/cargohold/default.nix index 58b2e770a30..32c9e73b371 100644 --- a/services/cargohold/default.nix +++ b/services/cargohold/default.nix @@ -43,6 +43,7 @@ , mmorph , mtl , optparse-applicative +, prometheus-client , resourcet , retry , safe @@ -108,6 +109,7 @@ mkDerivation { metrics-core metrics-wai mime + prometheus-client resourcet retry servant diff --git a/services/cargohold/src/CargoHold/App.hs b/services/cargohold/src/CargoHold/App.hs index 36af17c0051..1f334acb8c2 100644 --- a/services/cargohold/src/CargoHold/App.hs +++ b/services/cargohold/src/CargoHold/App.hs @@ -29,7 +29,6 @@ module CargoHold.App multiIngress, httpManager, http2Manager, - metrics, appLogger, requestId, localUnit, @@ -62,8 +61,6 @@ import Control.Lens (Lens', makeLenses, non, view, (?~), (^.)) import Control.Monad.Catch (MonadCatch, MonadMask, MonadThrow) import Control.Monad.Trans.Resource (ResourceT, runResourceT, transResourceT) import qualified Data.Map as Map -import Data.Metrics.Middleware (Metrics) -import qualified Data.Metrics.Middleware as Metrics import Data.Qualified import HTTP2.Client.Manager (Http2Manager, http2ManagerWithSSLCtx) import Imports hiding (log) @@ -72,6 +69,7 @@ import Network.HTTP.Client.OpenSSL import Network.Wai.Utilities (Error (..)) import OpenSSL.Session (SSLContext, SSLOption (..)) import qualified OpenSSL.Session as SSL +import Prometheus import qualified Servant.Client as Servant import System.Logger.Class hiding (settings) import qualified System.Logger.Extended as Log @@ -84,7 +82,6 @@ import qualified Wire.API.Routes.Internal.Brig as IBrig data Env = Env { _aws :: AWS.Env, - _metrics :: Metrics, _appLogger :: Logger, _httpManager :: Manager, _http2Manager :: Http2Manager, @@ -101,7 +98,6 @@ settings = options . Opt.settings newEnv :: Opts -> IO Env newEnv opts = do - metricsStorage <- Metrics.metrics logger <- Log.mkLogger (opts ^. Opt.logLevel) (opts ^. Opt.logNetStrings) (opts ^. Opt.logFormat) checkOpts opts logger httpMgr <- initHttpManager (opts ^. Opt.aws . Opt.s3Compatibility) @@ -109,7 +105,7 @@ newEnv opts = do awsEnv <- initAws (opts ^. Opt.aws) logger httpMgr multiIngressAWS <- initMultiIngressAWS logger httpMgr let localDomain = toLocalUnsafe (opts ^. Opt.settings . Opt.federationDomain) () - pure $ Env awsEnv metricsStorage logger httpMgr http2Mgr (RequestId "N/A") opts localDomain multiIngressAWS + pure $ Env awsEnv logger httpMgr http2Mgr (RequestId "N/A") opts localDomain multiIngressAWS where initMultiIngressAWS :: Logger -> Manager -> IO (Map String AWS.Env) initMultiIngressAWS logger httpMgr = @@ -205,7 +201,8 @@ newtype AppT m a = AppT (ReaderT Env m a) MonadThrow, MonadCatch, MonadMask, - MonadReader Env + MonadReader Env, + MonadMonitor ) type App = AppT IO diff --git a/services/cargohold/src/CargoHold/Metrics.hs b/services/cargohold/src/CargoHold/Metrics.hs index aa21c396891..34d0c08fca4 100644 --- a/services/cargohold/src/CargoHold/Metrics.hs +++ b/services/cargohold/src/CargoHold/Metrics.hs @@ -17,17 +17,32 @@ module CargoHold.Metrics where -import CargoHold.App (Env, metrics) -import Control.Lens (view) -import Data.Metrics.Middleware (counterAdd, counterIncr, path) import Imports +import qualified Prometheus as Prom -s3UploadOk :: (MonadReader Env m, MonadIO m) => m () -s3UploadOk = - counterIncr (path "net.s3.upload_ok") - =<< view metrics +s3UploadOk :: Prom.MonadMonitor m => m () +s3UploadOk = Prom.incCounter netS3UploadOk -s3UploadSize :: (MonadReader Env m, MonadIO m, Integral n) => n -> m () +{-# NOINLINE netS3UploadOk #-} +netS3UploadOk :: Prom.Counter +netS3UploadOk = + Prom.unsafeRegister $ + Prom.counter + Prom.Info + { Prom.metricName = "net.s3.upload_ok", + Prom.metricHelp = "Number of successful S3 Uploads" + } + +s3UploadSize :: (Prom.MonadMonitor m, Integral n) => n -> m () s3UploadSize n = - counterAdd (fromIntegral n) (path "net.s3.upload_size") - =<< view metrics + void $ Prom.addCounter netS3UploadSize (fromIntegral n) + +{-# NOINLINE netS3UploadSize #-} +netS3UploadSize :: Prom.Counter +netS3UploadSize = + Prom.unsafeRegister $ + Prom.counter + Prom.Info + { Prom.metricName = "net.s3.upload_size", + Prom.metricHelp = "Number of bytes uploaded successfully uploaded to S3" + } diff --git a/services/cargohold/src/CargoHold/Run.hs b/services/cargohold/src/CargoHold/Run.hs index 783199cccb3..6106a4c68e9 100644 --- a/services/cargohold/src/CargoHold/Run.hs +++ b/services/cargohold/src/CargoHold/Run.hs @@ -32,7 +32,6 @@ import CargoHold.Options hiding (aws) import Control.Exception (bracket) import Control.Lens ((.~), (^.)) import Control.Monad.Codensity -import Data.Metrics (Metrics) import Data.Metrics.AWS (gaugeTokenRemaing) import Data.Metrics.Servant import Data.Proxy @@ -59,7 +58,7 @@ type CombinedAPI = FederationAPI :<|> CargoholdAPI :<|> InternalAPI run :: Opts -> IO () run o = lowerCodensity $ do (app, e) <- mkApp o - void $ Codensity $ Async.withAsync (collectAuthMetrics (e ^. metrics) (e ^. aws . amazonkaEnv)) + void $ Codensity $ Async.withAsync (collectAuthMetrics (e ^. aws . amazonkaEnv)) liftIO $ do s <- Server.newSettings $ @@ -67,7 +66,6 @@ run o = lowerCodensity $ do (unpack $ o ^. cargohold . host) (o ^. cargohold . port) (e ^. appLogger) - (e ^. metrics) runSettingsWithShutdown s app Nothing mkApp :: Opts -> Codensity IO (Application, Env) @@ -81,7 +79,7 @@ mkApp o = Codensity $ \k -> . requestIdMiddleware (e ^. appLogger) defaultRequestIdHeaderName . servantPrometheusMiddleware (Proxy @CombinedAPI) . GZip.gzip GZip.def - . catchErrors (e ^. appLogger) defaultRequestIdHeaderName [Right $ e ^. metrics] + . catchErrors (e ^. appLogger) defaultRequestIdHeaderName servantApp :: Env -> Application servantApp e0 r cont = do let rid = getRequestId defaultRequestIdHeaderName r @@ -99,10 +97,10 @@ mkApp o = Codensity $ \k -> toServantHandler :: Env -> Handler a -> Servant.Handler a toServantHandler env = liftIO . runHandler env -collectAuthMetrics :: MonadIO m => Metrics -> AWS.Env -> m () -collectAuthMetrics m env = do +collectAuthMetrics :: MonadIO m => AWS.Env -> m () +collectAuthMetrics env = do liftIO $ forever $ do mbRemaining <- readAuthExpiration env - gaugeTokenRemaing m mbRemaining + gaugeTokenRemaing mbRemaining threadDelay 1_000_000 diff --git a/services/federator/src/Federator/Env.hs b/services/federator/src/Federator/Env.hs index e15b19f532b..6d13f073ad1 100644 --- a/services/federator/src/Federator/Env.hs +++ b/services/federator/src/Federator/Env.hs @@ -22,7 +22,6 @@ module Federator.Env where import Control.Lens (makeLenses) -import Data.Metrics (Metrics) import Federator.Options (RunSettings) import HTTP2.Client.Manager import Imports @@ -40,8 +39,7 @@ data FederatorMetrics = FederatorMetrics } data Env = Env - { _metrics :: Metrics, - _applog :: LC.Logger, + { _applog :: LC.Logger, _dnsResolver :: Resolver, _runSettings :: RunSettings, _service :: Component -> Endpoint, diff --git a/services/federator/src/Federator/Interpreter.hs b/services/federator/src/Federator/Interpreter.hs index 089ef1ff07e..25923a7e824 100644 --- a/services/federator/src/Federator/Interpreter.hs +++ b/services/federator/src/Federator/Interpreter.hs @@ -114,7 +114,7 @@ serveServant env port server = do hoistServerWithContext (Proxy @api) (Proxy @'[]) (runFederator env rid) server Warp.run port . requestIdMiddleware env._applog federationRequestIdHeaderName - . Wai.catchErrors (view applog env) federationRequestIdHeaderName [] + . Wai.catchErrors (view applog env) federationRequestIdHeaderName . Metrics.servantPrometheusMiddleware (Proxy @api) $ app hoistApp where diff --git a/services/federator/src/Federator/Run.hs b/services/federator/src/Federator/Run.hs index 3ebcb41fbf1..c02d9f25f7d 100644 --- a/services/federator/src/Federator/Run.hs +++ b/services/federator/src/Federator/Run.hs @@ -38,7 +38,7 @@ import Control.Concurrent.Async import Control.Exception (bracket) import Control.Lens ((^.)) import Data.Id -import Data.Metrics.Middleware qualified as Metrics +import Data.Metrics.GC import Federator.Env import Federator.ExternalServer (serveInward) import Federator.InternalServer (serveOutward) @@ -60,6 +60,7 @@ import Wire.Network.DNS.Helper qualified as DNS -- FUTUREWORK(federation): Add metrics and status endpoints run :: Opts -> IO () run opts = do + spawnGCMetricsCollector let resolvConf = mkResolvConf (optSettings opts) DNS.defaultResolvConf DNS.withCachingResolver resolvConf $ \res -> do logger <- LogExt.mkLogger (Opt.logLevel opts) (Opt.logNetStrings opts) (Opt.logFormat opts) @@ -91,7 +92,6 @@ run opts = do newEnv :: Opts -> DNS.Resolver -> Log.Logger -> IO Env newEnv o _dnsResolver _applog = do - _metrics <- Metrics.metrics let _requestId = RequestId "N/A" _runSettings = Opt.optSettings o _service Brig = Opt.brig o diff --git a/services/galley/default.nix b/services/galley/default.nix index 26be21dac96..e85dbccf854 100644 --- a/services/galley/default.nix +++ b/services/galley/default.nix @@ -68,6 +68,7 @@ , polysemy , polysemy-wire-zoo , process +, prometheus-client , proto-lens , protobuf , QuickCheck @@ -179,6 +180,7 @@ mkDerivation { pem polysemy polysemy-wire-zoo + prometheus-client proto-lens raw-strings-qq resourcet diff --git a/services/galley/galley.cabal b/services/galley/galley.cabal index b61df20ca8b..0ebe57dc415 100644 --- a/services/galley/galley.cabal +++ b/services/galley/galley.cabal @@ -328,6 +328,7 @@ library , pem , polysemy , polysemy-wire-zoo + , prometheus-client , proto-lens >=0.2 , raw-strings-qq >=1.0 , resourcet >=1.1 diff --git a/services/galley/src/Galley/App.hs b/services/galley/src/Galley/App.hs index 086fac2cad2..4242b7f3cf6 100644 --- a/services/galley/src/Galley/App.hs +++ b/services/galley/src/Galley/App.hs @@ -22,7 +22,6 @@ module Galley.App Env, reqId, options, - monitor, applog, manager, federator, @@ -50,7 +49,6 @@ import Cassandra.Util (initCassandraForService) import Control.Error hiding (err) import Control.Lens hiding ((.=)) import Data.Id -import Data.Metrics.Middleware import Data.Misc import Data.Qualified import Data.Range @@ -162,13 +160,13 @@ validateOptions o = do (Just uri, Nothing) -> pure (Left uri) (Just _, Just _) -> error errMsg -createEnv :: Metrics -> Opts -> Logger -> IO Env -createEnv m o l = do +createEnv :: Opts -> Logger -> IO Env +createEnv o l = do cass <- initCassandra o l mgr <- initHttpManager o h2mgr <- initHttp2Manager codeURIcfg <- validateOptions o - Env (RequestId "N/A") m o l mgr h2mgr (o ^. O.federator) (o ^. O.brig) cass + Env (RequestId "N/A") o l mgr h2mgr (o ^. O.federator) (o ^. O.brig) cass <$> Q.new 16000 <*> initExtEnv <*> maybe (pure Nothing) (fmap Just . Aws.mkEnv l mgr) (o ^. journal) diff --git a/services/galley/src/Galley/Env.hs b/services/galley/src/Galley/Env.hs index 87a0ddbd70f..9d88c703b86 100644 --- a/services/galley/src/Galley/Env.hs +++ b/services/galley/src/Galley/Env.hs @@ -24,7 +24,6 @@ import Cassandra import Control.Lens hiding ((.=)) import Data.ByteString.Conversion (toByteString') import Data.Id -import Data.Metrics.Middleware import Data.Misc (Fingerprint, HttpsUrl, Rsa) import Data.Range import Data.Time.Clock.DiffTime (millisecondsToDiffTime) @@ -52,7 +51,6 @@ data DeleteItem = TeamItem TeamId UserId (Maybe ConnId) -- | Main application environment. data Env = Env { _reqId :: RequestId, - _monitor :: Metrics, _options :: Opts, _applog :: Logger, _manager :: Manager, diff --git a/services/galley/src/Galley/Monad.hs b/services/galley/src/Galley/Monad.hs index 1780f3d827c..f1a30b8b8a0 100644 --- a/services/galley/src/Galley/Monad.hs +++ b/services/galley/src/Galley/Monad.hs @@ -29,6 +29,7 @@ import Galley.Env import Imports hiding (log) import Polysemy import Polysemy.Input +import Prometheus import System.Logger import System.Logger.Class qualified as LC @@ -42,7 +43,8 @@ newtype App a = App {unApp :: ReaderT Env IO a} MonadMask, MonadReader Env, MonadThrow, - MonadUnliftIO + MonadUnliftIO, + MonadMonitor ) runApp :: Env -> App a -> IO a diff --git a/services/galley/src/Galley/Run.hs b/services/galley/src/Galley/Run.hs index 8110fc4454a..4ac4bc764ca 100644 --- a/services/galley/src/Galley/Run.hs +++ b/services/galley/src/Galley/Run.hs @@ -32,9 +32,7 @@ import Control.Lens (view, (.~), (^.)) import Control.Monad.Codensity import Data.Aeson qualified as Aeson import Data.ByteString.UTF8 qualified as UTF8 -import Data.Metrics (Metrics) import Data.Metrics.AWS (gaugeTokenRemaing) -import Data.Metrics.Middleware qualified as M import Data.Metrics.Servant import Data.Misc (portNumber) import Data.Singletons @@ -58,6 +56,7 @@ import Network.Wai.Middleware.Gzip qualified as GZip import Network.Wai.Utilities.Error import Network.Wai.Utilities.Request import Network.Wai.Utilities.Server +import Prometheus qualified as Prom import Servant hiding (route) import System.Logger qualified as Log import System.Logger.Extended (mkLogger) @@ -77,10 +76,9 @@ run opts = lowerCodensity $ do (unpack $ opts ^. galley . host) (portNumber $ fromIntegral $ opts ^. galley . port) (env ^. App.applog) - (env ^. monitor) forM_ (env ^. aEnv) $ \aws -> - void $ Codensity $ Async.withAsync $ collectAuthMetrics (env ^. monitor) (aws ^. awsEnv) + void $ Codensity $ Async.withAsync $ collectAuthMetrics (aws ^. awsEnv) void $ Codensity $ Async.withAsync $ runApp env deleteLoop void $ Codensity $ Async.withAsync $ runApp env refreshMetrics @@ -90,8 +88,7 @@ mkApp :: Opts -> Codensity IO (Application, Env) mkApp opts = do logger <- lift $ mkLogger (opts ^. logLevel) (opts ^. logNetStrings) (opts ^. logFormat) - metrics <- lift $ M.metrics - env <- lift $ App.createEnv metrics opts logger + env <- lift $ App.createEnv opts logger lift $ runClient (env ^. cstate) $ versionCheck schemaVersion let middlewares = versionMiddleware (foldMap expandVersionExp (opts ^. settings . disabledAPIVersions)) @@ -99,7 +96,7 @@ mkApp opts = . servantPrometheusMiddleware (Proxy @CombinedAPI) . GZip.gunzip . GZip.gzip GZip.def - . catchErrors logger defaultRequestIdHeaderName [Right metrics] + . catchErrors logger defaultRequestIdHeaderName Codensity $ \k -> finally (k ()) $ do Log.info logger $ Log.msg @Text "Galley application finished." Log.flush logger @@ -179,17 +176,26 @@ type CombinedAPI = refreshMetrics :: App () refreshMetrics = do - m <- view monitor q <- view deleteQueue safeForever "refreshMetrics" $ do n <- Q.len q - M.gaugeSet (fromIntegral n) (M.path "galley.deletequeue.len") m + Prom.setGauge deleteQueueLengthGauge (fromIntegral n) threadDelay 1000000 -collectAuthMetrics :: (MonadIO m) => Metrics -> AWS.Env -> m () -collectAuthMetrics m env = do +{-# NOINLINE deleteQueueLengthGauge #-} +deleteQueueLengthGauge :: Prom.Gauge +deleteQueueLengthGauge = + Prom.unsafeRegister $ + Prom.gauge + Prom.Info + { Prom.metricName = "galley.deletequeue.len", + Prom.metricHelp = "Length of the galley delete queue" + } + +collectAuthMetrics :: (MonadIO m) => AWS.Env -> m () +collectAuthMetrics env = do liftIO $ forever $ do mbRemaining <- readAuthExpiration env - gaugeTokenRemaing m mbRemaining + gaugeTokenRemaing mbRemaining threadDelay 1_000_000 diff --git a/services/gundeck/default.nix b/services/gundeck/default.nix index 4fe37c9149d..b925700365e 100644 --- a/services/gundeck/default.nix +++ b/services/gundeck/default.nix @@ -47,6 +47,7 @@ , network , network-uri , optparse-applicative +, prometheus-client , psqueues , QuickCheck , quickcheck-instances @@ -123,6 +124,7 @@ mkDerivation { metrics-wai mtl network-uri + prometheus-client psqueues raw-strings-qq resourcet @@ -168,7 +170,6 @@ mkDerivation { kan-extensions lens lens-aeson - metrics-wai network network-uri optparse-applicative diff --git a/services/gundeck/gundeck.cabal b/services/gundeck/gundeck.cabal index 28d8753c5e1..e2150a6251c 100644 --- a/services/gundeck/gundeck.cabal +++ b/services/gundeck/gundeck.cabal @@ -143,6 +143,7 @@ library , metrics-wai >=0.5.7 , mtl >=2.2 , network-uri >=2.6 + , prometheus-client , psqueues >=0.2.2 , raw-strings-qq , resourcet >=1.1 @@ -309,7 +310,6 @@ executable gundeck-integration , kan-extensions , lens , lens-aeson - , metrics-wai , network , network-uri , optparse-applicative diff --git a/services/gundeck/src/Gundeck/Env.hs b/services/gundeck/src/Gundeck/Env.hs index b9d5f5c073d..8fc8b78abaf 100644 --- a/services/gundeck/src/Gundeck/Env.hs +++ b/services/gundeck/src/Gundeck/Env.hs @@ -27,7 +27,6 @@ import Control.Concurrent.Async (Async) import Control.Lens (makeLenses, (^.)) import Control.Retry (capDelay, exponentialBackoff) import Data.ByteString.Char8 qualified as BSChar8 -import Data.Metrics.Middleware (Metrics) import Data.Misc (Milliseconds (..)) import Data.Text qualified as Text import Data.Time.Clock @@ -50,7 +49,6 @@ import System.Logger.Extended qualified as Logger data Env = Env { _reqId :: !RequestId, - _monitor :: !Metrics, _options :: !Opts, _applog :: !Logger.Logger, _manager :: !Manager, @@ -67,8 +65,8 @@ makeLenses ''Env schemaVersion :: Int32 schemaVersion = 7 -createEnv :: Metrics -> Opts -> IO ([Async ()], Env) -createEnv m o = do +createEnv :: Opts -> IO ([Async ()], Env) +createEnv o = do l <- Logger.mkLogger (o ^. logLevel) (o ^. logNetStrings) (o ^. logFormat) n <- newManager @@ -105,7 +103,7 @@ createEnv m o = do { updateAction = Ms . round . (* 1000) <$> getPOSIXTime } mtbs <- mkThreadBudgetState `mapM` (o ^. settings . maxConcurrentNativePushes) - pure $! (rThread : rAdditionalThreads,) $! Env (RequestId "N/A") m o l n p r rAdditional a io mtbs + pure $! (rThread : rAdditionalThreads,) $! Env (RequestId "N/A") o l n p r rAdditional a io mtbs reqIdMsg :: RequestId -> Logger.Msg -> Logger.Msg reqIdMsg = ("request" Logger..=) . unRequestId diff --git a/services/gundeck/src/Gundeck/Monad.hs b/services/gundeck/src/Gundeck/Monad.hs index 66b234569d3..a3a9207864f 100644 --- a/services/gundeck/src/Gundeck/Monad.hs +++ b/services/gundeck/src/Gundeck/Monad.hs @@ -21,7 +21,6 @@ module Gundeck.Monad ( -- * Environment Env, reqId, - monitor, options, applog, manager, @@ -61,6 +60,7 @@ 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 import System.Logger.Class @@ -84,6 +84,10 @@ newtype Gundeck a = Gundeck MonadUnliftIO ) +-- This can be derived if we resolve the TODO above. +instance MonadMonitor Gundeck where + doIO = liftIO + -- | 'Gundeck' doesn't have an instance for 'MonadRedis' because it contains two -- connections to two redis instances. When using 'WithDefaultRedis', any redis -- operation will only target the default redis instance (configured under diff --git a/services/gundeck/src/Gundeck/Push.hs b/services/gundeck/src/Gundeck/Push.hs index b11785fa770..009052623d0 100644 --- a/services/gundeck/src/Gundeck/Push.hs +++ b/services/gundeck/src/Gundeck/Push.hs @@ -108,10 +108,9 @@ instance MonadPushAll Gundeck where -- | Another layer of wrap around 'runWithBudget'. runWithBudget'' :: Int -> a -> Gundeck a -> Gundeck a runWithBudget'' budget fallback action = do - metrics <- view monitor view threadBudgetState >>= \case Nothing -> action - Just tbs -> runWithBudget' metrics tbs budget fallback action + Just tbs -> runWithBudget' tbs budget fallback action -- | Abstract over all effects in 'nativeTargets' (for unit testing). class Monad m => MonadNativeTargets m where diff --git a/services/gundeck/src/Gundeck/Push/Native.hs b/services/gundeck/src/Gundeck/Push/Native.hs index 752351340d4..917960c4e7e 100644 --- a/services/gundeck/src/Gundeck/Push/Native.hs +++ b/services/gundeck/src/Gundeck/Push/Native.hs @@ -28,7 +28,6 @@ import Control.Monad.Catch import Data.ByteString.Conversion.To import Data.Id import Data.List1 -import Data.Metrics (counterIncr, path) import Data.Set qualified as Set import Data.Text qualified as Text import Data.UUID qualified as UUID @@ -43,6 +42,7 @@ import Gundeck.Push.Native.Types as Types import Gundeck.Types import Gundeck.Util import Imports +import Prometheus qualified as Prom import System.Logger.Class (MonadLogger, field, msg, val, (.=), (~~)) import System.Logger.Class qualified as Log import UnliftIO (handleAny, mapConcurrently, pooledMapConcurrentlyN_) @@ -60,6 +60,66 @@ push m addrs = do -- parallelizing only chunkSize native pushes at a time Just chunkSize -> pooledMapConcurrentlyN_ chunkSize (push1 m) addrs +{-# NOINLINE nativePushSuccessCounter #-} +nativePushSuccessCounter :: Prom.Counter +nativePushSuccessCounter = + Prom.unsafeRegister $ + Prom.counter + Prom.Info + { Prom.metricName = "push.native.success", + Prom.metricHelp = "Number of times native pushes were successfully pushed" + } + +{-# NOINLINE nativePushDisabledCounter #-} +nativePushDisabledCounter :: Prom.Counter +nativePushDisabledCounter = + Prom.unsafeRegister $ + Prom.counter + Prom.Info + { Prom.metricName = "push.native.disabled", + Prom.metricHelp = "Number of times native pushes were not pushed due to a disabled endpoint" + } + +{-# NOINLINE nativePushInvalidCounter #-} +nativePushInvalidCounter :: Prom.Counter +nativePushInvalidCounter = + Prom.unsafeRegister $ + Prom.counter + Prom.Info + { Prom.metricName = "push.native.invalid", + Prom.metricHelp = "Number of times native pushes were not pushed due to an invalid endpoint" + } + +{-# NOINLINE nativePushTooLargeCounter #-} +nativePushTooLargeCounter :: Prom.Counter +nativePushTooLargeCounter = + Prom.unsafeRegister $ + Prom.counter + Prom.Info + { Prom.metricName = "push.native.too_large", + Prom.metricHelp = "Number of times native pushes were not pushed due to payload being too large" + } + +{-# NOINLINE nativePushUnauthorizedCounter #-} +nativePushUnauthorizedCounter :: Prom.Counter +nativePushUnauthorizedCounter = + Prom.unsafeRegister $ + Prom.counter + Prom.Info + { Prom.metricName = "push.native.unauthorized", + Prom.metricHelp = "Number of times native pushes were not pushed due to an unauthorized endpoint" + } + +{-# NOINLINE nativePushErrorCounter #-} +nativePushErrorCounter :: Prom.Counter +nativePushErrorCounter = + Prom.unsafeRegister $ + Prom.counter + Prom.Info + { Prom.metricName = "push.native.errors", + Prom.metricHelp = "Number of times native pushes were not pushed due to an unexpected error" + } + push1 :: NativePush -> Address -> Gundeck () push1 = push1' 0 where @@ -86,7 +146,7 @@ push1 = push1' 0 field "user" (toByteString (a ^. addrUser)) ~~ field "notificationId" (toText (npNotificationid m)) ~~ Log.msg (val "Native push success") - view monitor >>= counterIncr (path "push.native.success") + Prom.incCounter nativePushSuccessCounter onDisabled = handleAny (logError a "Failed to cleanup disabled endpoint") $ do Log.info $ @@ -94,13 +154,13 @@ push1 = push1' 0 ~~ field "arn" (toText (a ^. addrEndpoint)) ~~ field "cause" ("EndpointDisabled" :: Text) ~~ msg (val "Removing disabled endpoint and token") - view monitor >>= counterIncr (path "push.native.disabled") + Prom.incCounter nativePushDisabledCounter Data.delete (a ^. addrUser) (a ^. addrTransport) (a ^. addrApp) (a ^. addrToken) onTokenRemoved e <- view awsEnv Aws.execute e (Aws.deleteEndpoint (a ^. addrEndpoint)) onPayloadTooLarge = do - view monitor >>= counterIncr (path "push.native.too_large") + Prom.incCounter nativePushTooLargeCounter Log.warn $ field "user" (toByteString (a ^. addrUser)) ~~ field "arn" (toText (a ^. addrEndpoint)) @@ -112,7 +172,7 @@ push1 = push1' 0 ~~ field "arn" (toText (a ^. addrEndpoint)) ~~ field "cause" ("InvalidEndpoint" :: Text) ~~ msg (val "Invalid ARN. Deleting orphaned push token") - view monitor >>= counterIncr (path "push.native.invalid") + Prom.incCounter nativePushInvalidCounter Data.delete (a ^. addrUser) (a ^. addrTransport) (a ^. addrApp) (a ^. addrToken) onTokenRemoved retryUnauthorisedThreshold = 1 @@ -147,10 +207,10 @@ push1 = push1' 0 ~~ field "arn" (toText (a ^. addrEndpoint)) ~~ field "cause" ("UnauthorisedEndpoint" :: Text) ~~ msg (val "Invalid ARN. Dropping push message.") - view monitor >>= counterIncr (path "push.native.unauthorized") + Prom.incCounter nativePushUnauthorizedCounter onPushException ex = do logError a "Native push failed" ex - view monitor >>= counterIncr (path "push.native.errors") + Prom.incCounter nativePushErrorCounter onTokenRemoved = do i <- mkNotificationId let c = a ^. addrClient diff --git a/services/gundeck/src/Gundeck/Push/Websocket.hs b/services/gundeck/src/Gundeck/Push/Websocket.hs index 64a51c5f9d9..e6b8f2121b5 100644 --- a/services/gundeck/src/Gundeck/Push/Websocket.hs +++ b/services/gundeck/src/Gundeck/Push/Websocket.hs @@ -36,7 +36,6 @@ import Data.ByteString.Lazy qualified as L import Data.Id import Data.List1 import Data.Map qualified as Map -import Data.Metrics qualified as Metrics import Data.Misc (Milliseconds (..)) import Data.Set qualified as Set import Data.Time.Clock.POSIX @@ -49,6 +48,7 @@ import Network.HTTP.Client (HttpExceptionContent (..)) import Network.HTTP.Client.Internal qualified as Http import Network.HTTP.Types (StdMethod (POST), status200, status410) import Network.URI qualified as URI +import Prometheus qualified as Prom import System.Logger.Class (val, (+++), (~~)) import System.Logger.Class qualified as Log import UnliftIO (handleAny, mapConcurrently) @@ -101,14 +101,21 @@ bulkPush notifs = do -- | log all cannons with response status @/= 200@. monitorBadCannons :: - (MonadIO m, MonadReader Env m) => + (Prom.MonadMonitor m) => (uri, (error, [Presence])) -> m () -monitorBadCannons (_uri, (_err, prcs)) = do - view monitor - >>= Metrics.counterAdd - (fromIntegral $ length prcs) - (Metrics.path "push.ws.unreachable") +monitorBadCannons (_uri, (_err, prcs)) = + void $ Prom.addCounter pushWsUnreachableCounter (fromIntegral $ length prcs) + +{-# NOINLINE pushWsUnreachableCounter #-} +pushWsUnreachableCounter :: Prom.Counter +pushWsUnreachableCounter = + Prom.unsafeRegister $ + Prom.counter + Prom.Info + { Prom.metricName = "push.ws.unreachable", + Prom.metricHelp = "Number of times websocket pushes were not pushed due cannon being unreachable" + } logBadCannons :: Log.MonadLogger m => (URI, (SomeException, [Presence])) -> m () logBadCannons (uri, (err, prcs)) = do @@ -343,7 +350,7 @@ push notif (toList -> tgts) originUser originConn conns = do Log.debug $ logPresence p ~~ Log.msg (val "WebSocket presence gone") pure (ok, p : gone) onResult (ok, gone) (PushFailure p _) = do - view monitor >>= Metrics.counterIncr (Metrics.path "push.ws.unreachable") + Prom.incCounter pushWsUnreachableCounter Log.info $ logPresence p ~~ Log.field "created_at" (ms $ createdAt p) diff --git a/services/gundeck/src/Gundeck/Run.hs b/services/gundeck/src/Gundeck/Run.hs index cff04418894..8dcfc3b764c 100644 --- a/services/gundeck/src/Gundeck/Run.hs +++ b/services/gundeck/src/Gundeck/Run.hs @@ -26,9 +26,7 @@ import Control.Error (ExceptT (ExceptT)) import Control.Exception (finally) import Control.Lens ((.~), (^.)) import Control.Monad.Extra -import Data.Metrics (Metrics) import Data.Metrics.AWS (gaugeTokenRemaing) -import Data.Metrics.Middleware (metrics) import Data.Metrics.Middleware.Prometheus (waiPrometheusMiddleware) import Data.Proxy (Proxy (Proxy)) import Data.Text (unpack) @@ -59,17 +57,16 @@ import Wire.API.Routes.Version.Wai run :: Opts -> IO () run o = do - m <- metrics - (rThreads, e) <- createEnv m o + (rThreads, e) <- createEnv o runClient (e ^. cstate) $ versionCheck schemaVersion let l = e ^. applog - s <- newSettings $ defaultServer (unpack $ o ^. gundeck . host) (o ^. gundeck . port) l m + s <- newSettings $ defaultServer (unpack $ o ^. gundeck . host) (o ^. gundeck . port) l let throttleMillis = fromMaybe defSqsThrottleMillis $ o ^. (settings . sqsThrottleMillis) lst <- Async.async $ Aws.execute (e ^. awsEnv) (Aws.listen throttleMillis (runDirect e . onEvent)) - wtbs <- forM (e ^. threadBudgetState) $ \tbs -> Async.async $ runDirect e $ watchThreadBudgetState m tbs 10 - wCollectAuth <- Async.async (collectAuthMetrics m (Aws._awsEnv (Env._awsEnv e))) + wtbs <- forM (e ^. threadBudgetState) $ \tbs -> Async.async $ runDirect e $ watchThreadBudgetState tbs 10 + wCollectAuth <- Async.async (collectAuthMetrics (Aws._awsEnv (Env._awsEnv e))) let app = middleware e $ mkApp e runSettingsWithShutdown s app Nothing `finally` do @@ -90,7 +87,7 @@ run o = do . waiPrometheusMiddleware sitemap . GZip.gunzip . GZip.gzip GZip.def - . catchErrors (e ^. applog) defaultRequestIdHeaderName [Right $ e ^. monitor] + . catchErrors (e ^. applog) defaultRequestIdHeaderName type CombinedAPI = GundeckAPI :<|> Servant.Raw @@ -113,10 +110,10 @@ servantSitemap' env = Servant.hoistServer (Proxy @GundeckAPI) toServantHandler s toServantHandler :: Gundeck a -> Handler a toServantHandler m = Handler . ExceptT $ Right <$> runDirect env m -collectAuthMetrics :: MonadIO m => Metrics -> AWS.Env -> m () -collectAuthMetrics m env = do +collectAuthMetrics :: MonadIO m => AWS.Env -> m () +collectAuthMetrics env = do liftIO $ forever $ do mbRemaining <- readAuthExpiration env - gaugeTokenRemaing m mbRemaining + gaugeTokenRemaing mbRemaining threadDelay 1_000_000 diff --git a/services/gundeck/src/Gundeck/ThreadBudget/Internal.hs b/services/gundeck/src/Gundeck/ThreadBudget/Internal.hs index 4f311bb072c..cccfea4fdf6 100644 --- a/services/gundeck/src/Gundeck/ThreadBudget/Internal.hs +++ b/services/gundeck/src/Gundeck/ThreadBudget/Internal.hs @@ -25,14 +25,14 @@ import Control.Exception.Safe (catchAny) import Control.Lens import Control.Monad.Catch (MonadCatch) import Data.HashMap.Strict qualified as HM -import Data.Metrics (Metrics, counterIncr) -import Data.Metrics.Middleware (gaugeSet, path) import Data.Set qualified as Set import Data.Time import Data.UUID (UUID, toText) import Data.UUID.V4 (nextRandom) import Gundeck.Options import Imports +import Prometheus (MonadMonitor) +import Prometheus qualified as Prom import System.Logger.Class qualified as LC import UnliftIO.Async import UnliftIO.Exception (finally) @@ -112,26 +112,24 @@ unregister ref key = -- update the budget. runWithBudget :: forall m. - (LC.MonadLogger m, MonadUnliftIO m) => - Metrics -> + (LC.MonadLogger m, MonadUnliftIO m, MonadMonitor m) => ThreadBudgetState -> Int -> m () -> m () -runWithBudget metrics tbs spent = runWithBudget' metrics tbs spent () +runWithBudget tbs spent = runWithBudget' tbs spent () -- | More flexible variant of 'runWithBudget' that allows the action to return a value. With -- a default in case of budget exhaustion. runWithBudget' :: forall m a. - (MonadIO m, LC.MonadLogger m, MonadUnliftIO m) => - Metrics -> + (MonadIO m, LC.MonadLogger m, MonadUnliftIO m, MonadMonitor m) => ThreadBudgetState -> Int -> a -> m a -> m a -runWithBudget' metrics (ThreadBudgetState limits ref) spent fallback action = do +runWithBudget' (ThreadBudgetState limits ref) spent fallback action = do key <- liftIO nextRandom (`finally` unregister ref key) $ do oldsize <- allocate ref key spent @@ -155,9 +153,12 @@ runWithBudget' metrics (ThreadBudgetState limits ref) spent fallback action = do warnNoBudget :: Bool -> Bool -> Int -> m () warnNoBudget False False _ = pure () warnNoBudget soft' hard' oldsize = do - let limit = if hard' then "hard" else "soft" - metric = "net.nativepush." <> limit <> "_limit_breached" - counterIncr (path metric) metrics + let limit :: ByteString = if hard' then "hard" else "soft" + counter = + if hard' + then threadBudgetHardLimitBreachedCounter + else threadBudgetSoftLimitBreachedCounter + Prom.incCounter counter LC.warn $ "spent" LC..= show oldsize LC.~~ "soft-breach" LC..= soft' @@ -174,30 +175,78 @@ runWithBudget' metrics (ThreadBudgetState limits ref) spent fallback action = do -- Also, issue some metrics. watchThreadBudgetState :: forall m. - (MonadIO m, LC.MonadLogger m, MonadCatch m) => - Metrics -> + (MonadIO m, LC.MonadLogger m, MonadCatch m, MonadMonitor m) => ThreadBudgetState -> NominalDiffTime -> m () -watchThreadBudgetState metrics (ThreadBudgetState limits ref) freq = safeForever $ do - recordMetrics metrics limits ref +watchThreadBudgetState (ThreadBudgetState limits ref) freq = safeForever $ do + recordMetrics limits ref removeStaleHandles ref threadDelayNominalDiffTime freq recordMetrics :: forall m. - MonadIO m => - Metrics -> + (MonadIO m, MonadMonitor m) => MaxConcurrentNativePushes -> IORef BudgetMap -> m () -recordMetrics metrics limits ref = do +recordMetrics limits ref = do (BudgetMap spent _) <- readIORef ref - gaugeSet (fromIntegral spent) (path "net.nativepush.thread_budget_allocated") metrics + Prom.setGauge threadBudgetAllocatedGauge (fromIntegral spent) forM_ (limits ^. hard) $ \lim -> - gaugeSet (fromIntegral lim) (path "net.nativepush.thread_budget_hard_limit") metrics + Prom.setGauge threadBudgetHardLimitGauge (fromIntegral lim) forM_ (limits ^. soft) $ \lim -> - gaugeSet (fromIntegral lim) (path "net.nativepush.thread_budget_soft_limit") metrics + Prom.setGauge threadBudgetSoftLimitGauge (fromIntegral lim) + +{-# NOINLINE threadBudgetAllocatedGauge #-} +threadBudgetAllocatedGauge :: Prom.Gauge +threadBudgetAllocatedGauge = + Prom.unsafeRegister $ + Prom.gauge + Prom.Info + { Prom.metricName = "net.nativepush.thread_budget_allocated", + Prom.metricHelp = "Number of allocated threads for native pushes" + } + +{-# NOINLINE threadBudgetHardLimitGauge #-} +threadBudgetHardLimitGauge :: Prom.Gauge +threadBudgetHardLimitGauge = + Prom.unsafeRegister $ + Prom.gauge + Prom.Info + { Prom.metricName = "net.nativepush.thread_budget_hard_limit", + Prom.metricHelp = "Hard limit for threads for native pushes" + } + +{-# NOINLINE threadBudgetSoftLimitGauge #-} +threadBudgetSoftLimitGauge :: Prom.Gauge +threadBudgetSoftLimitGauge = + Prom.unsafeRegister $ + Prom.gauge + Prom.Info + { Prom.metricName = "net.nativepush.thread_budget_soft_limit", + Prom.metricHelp = "Soft limit for threads for native pushes" + } + +{-# NOINLINE threadBudgetHardLimitBreachedCounter #-} +threadBudgetHardLimitBreachedCounter :: Prom.Counter +threadBudgetHardLimitBreachedCounter = + Prom.unsafeRegister $ + Prom.counter + Prom.Info + { Prom.metricName = "net.nativepush.thread_budget_hard_limit_breached", + Prom.metricHelp = "Number of times hard limit for threads for native pushes was breached" + } + +{-# NOINLINE threadBudgetSoftLimitBreachedCounter #-} +threadBudgetSoftLimitBreachedCounter :: Prom.Counter +threadBudgetSoftLimitBreachedCounter = + Prom.unsafeRegister $ + Prom.counter + Prom.Info + { Prom.metricName = "net.nativepush.thread_budget_soft_limit_breached", + Prom.metricHelp = "Number of times soft limit for threads for native pushes was breached" + } threadDelayNominalDiffTime :: NominalDiffTime -> MonadIO m => m () threadDelayNominalDiffTime = threadDelay . round . (* 1000000) . toRational diff --git a/services/gundeck/test/integration/Util.hs b/services/gundeck/test/integration/Util.hs index b28aa32b50a..0bce9203d72 100644 --- a/services/gundeck/test/integration/Util.hs +++ b/services/gundeck/test/integration/Util.hs @@ -8,7 +8,6 @@ import Control.Lens import Control.Monad.Catch import Control.Monad.Codensity import Data.ByteString qualified as S -import Data.Metrics.Middleware (metrics) import Data.Text qualified as Text import Gundeck.Env (createEnv) import Gundeck.Options @@ -23,8 +22,7 @@ withSettingsOverrides :: (Opts -> Opts) -> TestM a -> TestM a withSettingsOverrides f action = do ts <- ask let opts = f (view tsOpts ts) - m <- metrics - (_rThreads, env) <- liftIO $ createEnv m opts + (_rThreads, env) <- liftIO $ createEnv opts liftIO . lowerCodensity $ do let app = mkApp env p <- withMockServer app diff --git a/services/gundeck/test/unit/ThreadBudget.hs b/services/gundeck/test/unit/ThreadBudget.hs index f9f21656aa3..0627c91d436 100644 --- a/services/gundeck/test/unit/ThreadBudget.hs +++ b/services/gundeck/test/unit/ThreadBudget.hs @@ -29,7 +29,6 @@ module ThreadBudget where import Control.Concurrent.Async import Control.Lens import Control.Monad.Catch (MonadCatch, catch) -import Data.Metrics.Middleware (metrics) import Data.String.Conversions import Data.Time import GHC.Generics @@ -127,17 +126,15 @@ burstActions :: NumberOfThreads -> (MonadIO m) => m () burstActions tbs logHistory howlong (NumberOfThreads howmany) = do - mtr <- metrics - let budgeted = runWithBudget mtr tbs 1 (delayms howlong) + let budgeted = runWithBudget tbs 1 (delayms howlong) liftIO . replicateM_ howmany . forkIO $ runReaderT budgeted logHistory -- | Start a watcher with given params and a frequency of 10 milliseconds, so we are more -- likely to find weird race conditions. mkWatcher :: ThreadBudgetState -> LogHistory -> IO (Async ()) mkWatcher tbs logHistory = do - mtr <- metrics async $ - runReaderT (watchThreadBudgetState mtr tbs 0.01) logHistory + runReaderT (watchThreadBudgetState tbs 0.01) logHistory `catch` \AsyncCancelled -> pure () ---------------------------------------------------------------------- diff --git a/services/proxy/src/Proxy/Env.hs b/services/proxy/src/Proxy/Env.hs index d8850dab273..d429787d1be 100644 --- a/services/proxy/src/Proxy/Env.hs +++ b/services/proxy/src/Proxy/Env.hs @@ -22,7 +22,6 @@ module Proxy.Env createEnv, destroyEnv, reqId, - monitor, options, applog, manager, @@ -34,7 +33,6 @@ import Control.Lens (makeLenses, (^.)) import Data.Configurator import Data.Configurator.Types import Data.Id (RequestId (..)) -import Data.Metrics.Middleware (Metrics) import Imports import Network.HTTP.Client import Network.HTTP.Client.TLS (tlsManagerSettings) @@ -43,7 +41,6 @@ import System.Logger.Extended qualified as Logger data Env = Env { _reqId :: !RequestId, - _monitor :: !Metrics, _options :: !Opts, _applog :: !Logger.Logger, _manager :: !Manager, @@ -53,8 +50,8 @@ data Env = Env makeLenses ''Env -createEnv :: Metrics -> Opts -> IO Env -createEnv m o = do +createEnv :: Opts -> IO Env +createEnv o = do g <- Logger.mkLogger (o ^. logLevel) (o ^. logNetStrings) (o ^. logFormat) n <- newManager @@ -66,7 +63,7 @@ createEnv m o = do let ac = AutoConfig 60 (reloadError g) (c, t) <- autoReload ac [Required $ o ^. secretsConfig] let rid = RequestId "N/A" - pure $! Env rid m o g n c t + pure $! Env rid o g n c t where reloadError g x = Logger.err g (Logger.msg $ Logger.val "Failed reloading config: " Logger.+++ show x) diff --git a/services/proxy/src/Proxy/Run.hs b/services/proxy/src/Proxy/Run.hs index 2058052a059..16d43994006 100644 --- a/services/proxy/src/Proxy/Run.hs +++ b/services/proxy/src/Proxy/Run.hs @@ -22,7 +22,6 @@ where import Control.Lens hiding ((.=)) import Control.Monad.Catch -import Data.Metrics.Middleware hiding (path) import Data.Metrics.Middleware.Prometheus (waiPrometheusMiddleware) import Imports hiding (head) import Network.Wai.Middleware.Gunzip qualified as GZip @@ -36,9 +35,8 @@ import Wire.API.Routes.Version.Wai run :: Opts -> IO () run o = do - m <- metrics - e <- createEnv m o - s <- newSettings $ defaultServer (o ^. host) (o ^. port) (e ^. applog) m + e <- createEnv o + s <- newSettings $ defaultServer (o ^. host) (o ^. port) (e ^. applog) let rtree = compile (sitemap e) let app r k = runProxy e r (route rtree r k) let middleware = @@ -46,5 +44,5 @@ run o = do . requestIdMiddleware (e ^. applog) defaultRequestIdHeaderName . waiPrometheusMiddleware (sitemap e) . GZip.gunzip - . catchErrors (e ^. applog) defaultRequestIdHeaderName [Right m] + . catchErrors (e ^. applog) defaultRequestIdHeaderName runSettingsWithShutdown s (middleware app) Nothing `finally` destroyEnv e diff --git a/services/spar/src/Spar/Run.hs b/services/spar/src/Spar/Run.hs index 8b55c3ce603..f07ca3ce871 100644 --- a/services/spar/src/Spar/Run.hs +++ b/services/spar/src/Spar/Run.hs @@ -112,7 +112,7 @@ mkApp sparCtxOpts = do . WU.heavyDebugLogging heavyLogOnly logLevel sparCtxLogger defaultRequestIdHeaderName . servantPrometheusMiddleware (Proxy @SparAPI) . GZip.gunzip - . WU.catchErrors sparCtxLogger defaultRequestIdHeaderName [] + . WU.catchErrors sparCtxLogger defaultRequestIdHeaderName -- Error 'Response's are usually not thrown as exceptions, but logged in -- 'renderSparErrorWithLogging' before the 'Application' can construct a 'Response' -- value, when there is still all the type information around. 'WU.catchErrors' is diff --git a/tools/stern/default.nix b/tools/stern/default.nix index 5c9adf4ce7d..8ccf0f63f20 100644 --- a/tools/stern/default.nix +++ b/tools/stern/default.nix @@ -24,7 +24,6 @@ , lens , lens-aeson , lib -, metrics-wai , mtl , openapi3 , optparse-applicative @@ -74,7 +73,6 @@ mkDerivation { http-types imports lens - metrics-wai mtl openapi3 schema-profunctor diff --git a/tools/stern/src/Stern/API.hs b/tools/stern/src/Stern/API.hs index a20aa359db9..154b861e8ab 100644 --- a/tools/stern/src/Stern/API.hs +++ b/tools/stern/src/Stern/API.hs @@ -84,7 +84,7 @@ start o = do Server.runSettingsWithShutdown s (requestIdMiddleware (e ^. applog) defaultRequestIdHeaderName $ servantApp e) Nothing where server :: Env -> Server.Server - server e = Server.defaultServer (unpack $ stern o ^. host) (stern o ^. port) (e ^. applog) (e ^. metrics) + server e = Server.defaultServer (unpack $ stern o ^. host) (stern o ^. port) (e ^. applog) servantApp :: Env -> Application servantApp e0 req cont = do diff --git a/tools/stern/src/Stern/App.hs b/tools/stern/src/Stern/App.hs index eccffa864f0..6042f6b88c5 100644 --- a/tools/stern/src/Stern/App.hs +++ b/tools/stern/src/Stern/App.hs @@ -33,7 +33,6 @@ import Control.Monad.Reader.Class import Control.Monad.Trans.Class import Data.ByteString.Conversion (toByteString') import Data.Id -import Data.Metrics.Middleware qualified as Metrics import Data.Text.Encoding (encodeUtf8) import Data.UUID (toString) import Data.UUID.V4 qualified as UUID @@ -59,7 +58,6 @@ data Env = Env _ibis :: !Bilge.Request, _galeb :: !Bilge.Request, _applog :: !Logger, - _metrics :: !Metrics.Metrics, _requestId :: !Bilge.RequestId, _httpManager :: !Bilge.Manager } @@ -68,9 +66,8 @@ makeLenses ''Env newEnv :: Opts -> IO Env newEnv o = do - mt <- Metrics.metrics l <- Log.mkLogger (O.logLevel o) (O.logNetStrings o) (O.logFormat o) - Env (mkRequest $ O.brig o) (mkRequest $ O.galley o) (mkRequest $ O.gundeck o) (mkRequest $ O.ibis o) (mkRequest $ O.galeb o) l mt (RequestId "N/A") + Env (mkRequest $ O.brig o) (mkRequest $ O.galley o) (mkRequest $ O.gundeck o) (mkRequest $ O.ibis o) (mkRequest $ O.galeb o) l (RequestId "N/A") <$> newManager where mkRequest s = Bilge.host (encodeUtf8 (s ^. host)) . Bilge.port (s ^. port) $ Bilge.empty diff --git a/tools/stern/stern.cabal b/tools/stern/stern.cabal index 9d3634cccc2..e7572f7c330 100644 --- a/tools/stern/stern.cabal +++ b/tools/stern/stern.cabal @@ -87,7 +87,6 @@ library , http-types >=0.8 , imports , lens >=4.4 - , metrics-wai >=0.3 , mtl >=2.1 , openapi3 , schema-profunctor From 5ef2be02eea0b0147cd5bfea65b7a1ba4e4ed058 Mon Sep 17 00:00:00 2001 From: Matthias Fischmann Date: Mon, 17 Jun 2024 22:26:14 +0200 Subject: [PATCH 29/64] Add weeder (dead code elimination tool) to dev environment (#4088) Co-authored-by: Akshay Mankar --- Makefile | 27 +++++++-- changelog.d/5-internal/WPB-9667-weeder | 1 + nix/overlay.nix | 7 +++ nix/pkgs/weeder/default.nix | 84 ++++++++++++++++++++++++++ nix/wire-server.nix | 5 +- weeder.toml | 6 ++ 6 files changed, 122 insertions(+), 8 deletions(-) create mode 100644 changelog.d/5-internal/WPB-9667-weeder create mode 100644 nix/pkgs/weeder/default.nix create mode 100644 weeder.toml diff --git a/Makefile b/Makefile index 40e8876bb52..4eadeb39a51 100644 --- a/Makefile +++ b/Makefile @@ -127,11 +127,8 @@ devtest: ghcid --command 'cabal repl integration' --test='Testlib.Run.mainI []' .PHONY: sanitize-pr -sanitize-pr: - ./hack/bin/generate-local-nix-packages.sh - make formatf - make hlint-inplace-pr - make hlint-check-pr # sometimes inplace has been observed not to do its job very well. +sanitize-pr: + 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 ) @git diff-index --quiet --cached HEAD -- || ( echo "There are staged changes, please take a look, consider committing them, and try again."; exit 1 ) @@ -155,7 +152,25 @@ ghcid: # Used by CI .PHONY: lint-all -lint-all: formatc hlint-check-all check-local-nix-derivations treefmt-check +lint-all: formatc hlint-check-all lint-common + +# For use by local devs. +# +# This is not safe for CI because files not changed on the branch may +# have been pushed to develop, or caused by merging develop into the +# branch implicitly on github. +# +# The extra 'hlint-check-pr' has been witnessed to be necessary due to +# some bu in `hlint-inplace-pr`. Details got lost in history. +.PHONY: lint-all-shallow +lint-all-shallow: formatf hlint-inplace-pr hlint-check-pr lint-common + +.PHONY: lint-common +lint-common: check-local-nix-derivations treefmt-check # weeder (does not work on CI yet) + +.PHONY: weeder +weeder: + weeder -N .PHONY: hlint-check-all hlint-check-all: diff --git a/changelog.d/5-internal/WPB-9667-weeder b/changelog.d/5-internal/WPB-9667-weeder new file mode 100644 index 00000000000..2be9a9adfd5 --- /dev/null +++ b/changelog.d/5-internal/WPB-9667-weeder @@ -0,0 +1 @@ +Add weeder for dead code elimination. \ No newline at end of file diff --git a/nix/overlay.nix b/nix/overlay.nix index 0d846cb52b0..81d7f887649 100644 --- a/nix/overlay.nix +++ b/nix/overlay.nix @@ -89,6 +89,13 @@ self: super: { ]; }; + haskellPackages = super.haskellPackages.override { + overrides = hself: hsuper: { + # https://github.com/ocharles/weeder/pull/165 + weeder = self.haskell.lib.dontCheck (hself.callPackage ./pkgs/weeder { }); + }; + }; + stack = staticBinaryInTarball rec { pname = "stack"; version = "2.7.3"; diff --git a/nix/pkgs/weeder/default.nix b/nix/pkgs/weeder/default.nix new file mode 100644 index 00000000000..718f820242f --- /dev/null +++ b/nix/pkgs/weeder/default.nix @@ -0,0 +1,84 @@ +{ mkDerivation +, aeson +, algebraic-graphs +, async +, base +, bytestring +, containers +, directory +, fetchgit +, filepath +, generic-lens +, ghc +, Glob +, hspec-discover +, hspec-expectations +, lens +, lib +, mtl +, optparse-applicative +, parallel +, process +, regex-tdfa +, tasty +, tasty-golden +, tasty-hunit-compat +, text +, toml-reader +, transformers +}: +mkDerivation { + pname = "weeder"; + version = "2.8.0"; + src = fetchgit { + url = "https://github.com/fisx/weeder"; + sha256 = "sha256-Cv1H4m5X1iM26svGFdfCVfMO6E/ueaKxCRjrfwsoV7M="; + rev = "0dae376b4a41d67bdaa4ec55e902df0b3cc58fba"; # https://github.com/ocharles/weeder/pull/165 + fetchSubmodules = true; + }; + isLibrary = true; + isExecutable = true; + libraryHaskellDepends = [ + algebraic-graphs + async + base + bytestring + containers + directory + filepath + generic-lens + ghc + Glob + lens + mtl + optparse-applicative + parallel + regex-tdfa + text + toml-reader + transformers + ]; + executableHaskellDepends = [ base ]; + testHaskellDepends = [ + aeson + algebraic-graphs + base + bytestring + containers + directory + filepath + ghc + hspec-expectations + process + tasty + tasty-golden + tasty-hunit-compat + text + toml-reader + ]; + testToolDepends = [ hspec-discover ]; + homepage = "https://github.com/ocharles/weeder#readme"; + description = "Detect dead code"; + license = lib.licenses.bsd3; + mainProgram = "weeder"; +} diff --git a/nix/wire-server.nix b/nix/wire-server.nix index 2f1dd00c854..eb167f38d68 100644 --- a/nix/wire-server.nix +++ b/nix/wire-server.nix @@ -32,14 +32,14 @@ # giving us the latest version. # # 3.3: External dependencies: cabal2nix sometimes fails to provide the external -# dependencies like adding protobuf and mls-test-cli as a buld tools. So, we +# dependencies like adding protobuf and mls-test-cli as buld tools. We # need to write overrides to ensure these are present during build. # # 3.4: Other overrides: We may need to override haskell package derivations for # some other reasons, like ensuring hoogle derivation produces just the # executable. We can use nix/manual-overrides.nix for this. # -# Using thse tweaks we can get a haskell package set which has wire-server +# Using these tweaks we can get a haskell package set which has wire-server # components and the required dependencies. We then use this package set along # with nixpkgs' dockerTools to make derivations for docker images that we need. pkgs: @@ -420,6 +420,7 @@ let pkgs.cfssl pkgs.awscli2 (hlib.justStaticExecutables pkgs.haskellPackages.cabal-fmt) + (hlib.justStaticExecutables pkgs.haskellPackages.weeder) ] ++ pkgs.lib.optionals pkgs.stdenv.isLinux [ pkgs.skopeo ]; diff --git a/weeder.toml b/weeder.toml new file mode 100644 index 00000000000..5e2042081e4 --- /dev/null +++ b/weeder.toml @@ -0,0 +1,6 @@ +# weeder intro and further reading: https://github.com/ocharles/weeder?tab=readme-ov-file#weeder +roots = ["^Main.main$", "^Paths_.*", "^Testlib.RunServices.main$", "^Testlib.Run.main$", "^Test.Wire.API.Golden.Run.main$"] +type-class-roots = true # `root-instances` is more precise, but requires more config maintenance. + +# FUTUREWORK: unused-types = true +# FUTUREWORK: type-class-roots = false, and see how bad it gets From c4830f158adcb5db3d24b6ad93c01f633b11e62d Mon Sep 17 00:00:00 2001 From: Paolo Capriotti Date: Wed, 19 Jun 2024 11:33:00 +0200 Subject: [PATCH 30/64] Rewrite certificate generation script (#4093) * New script to generate certificates * Update docs * Regenerate certificates * Remove old certificate generation script * Restore cleanup trap --- .../docker/elasticsearch-ca.pem | 33 ++--- .../docker/elasticsearch-cert.pem | 36 ++--- .../docker/elasticsearch-key.pem | 55 ++++---- deploy/dockerephemeral/docker/redis-ca.pem | 34 ++--- .../docker/redis-node-1-cert.pem | 35 +++-- .../docker/redis-node-1-key.pem | 55 ++++---- .../docker/redis-node-2-cert.pem | 35 +++-- .../docker/redis-node-2-key.pem | 55 ++++---- .../docker/redis-node-3-cert.pem | 35 +++-- .../docker/redis-node-3-key.pem | 55 ++++---- .../docker/redis-node-4-cert.pem | 35 +++-- .../docker/redis-node-4-key.pem | 55 ++++---- .../docker/redis-node-5-cert.pem | 35 +++-- .../docker/redis-node-5-key.pem | 55 ++++---- .../docker/redis-node-6-cert.pem | 35 +++-- .../docker/redis-node-6-key.pem | 55 ++++---- .../federation-v0/integration-ca.pem | 34 ++--- .../federation-v0/integration-leaf-key.pem | 55 ++++---- .../federation-v0/integration-leaf.pem | 37 +++-- .../federation-v0/nginz/conf/README.md | 2 +- .../federation-v0/nginz/conf/nginx.conf | 2 +- hack/bin/gen-certs.sh | 80 +++++++++++ hack/bin/selfsigned.sh | 133 ------------------ hack/helm_vars/certs/elasticsearch-ca-key.pem | 55 ++++---- hack/helm_vars/certs/elasticsearch-ca.pem | 33 ++--- .../integration-test/conf/nginz/README.md | 2 +- .../conf/nginz/integration-ca-key.pem | 55 ++++---- .../conf/nginz/integration-ca.pem | 34 ++--- .../conf/nginz/integration-leaf-key.pem | 55 ++++---- .../conf/nginz/integration-leaf.pem | 37 +++-- .../integration-test/conf/nginz/nginx.conf | 2 +- 31 files changed, 633 insertions(+), 681 deletions(-) create mode 100755 hack/bin/gen-certs.sh delete mode 100755 hack/bin/selfsigned.sh diff --git a/deploy/dockerephemeral/docker/elasticsearch-ca.pem b/deploy/dockerephemeral/docker/elasticsearch-ca.pem index f56c3396fcf..f17e9cb41ac 100644 --- a/deploy/dockerephemeral/docker/elasticsearch-ca.pem +++ b/deploy/dockerephemeral/docker/elasticsearch-ca.pem @@ -1,19 +1,20 @@ -----BEGIN CERTIFICATE----- -MIIDHjCCAgagAwIBAgIUSYROJq4Fwdnd/Jfaeyg2Fk6cCKEwDQYJKoZIhvcNAQEL -BQAwJzElMCMGA1UEAxMcZWxhc3RpY3NlYXJjaC5jYS5leGFtcGxlLmNvbTAeFw0y -NDA0MjkxMjQ2MDBaFw0yOTA0MjgxMjQ2MDBaMCcxJTAjBgNVBAMTHGVsYXN0aWNz +MIIDLzCCAhegAwIBAgIUMGKU64YSPkGrWyHiXiLsuoKC/9owDQYJKoZIhvcNAQEL +BQAwJzElMCMGA1UEAwwcZWxhc3RpY3NlYXJjaC5jYS5leGFtcGxlLmNvbTAeFw0y +NDA2MTcxMzE1MzFaFw0zNDA2MTUxMzE1MzFaMCcxJTAjBgNVBAMMHGVsYXN0aWNz ZWFyY2guY2EuZXhhbXBsZS5jb20wggEiMA0GCSqGSIb3DQEBAQUAA4IBDwAwggEK -AoIBAQDMOswRecurkvL3ONZ2g63L2UVgd8VHUYMAImbcZz8e/P0NxjR79Se2/kvV -r57A3iem4Vjqjh7OXf6AebNh6QQGyBO0SgCGOcKymPhatucDN2isTGKpMF10mUZE -RCX5JWC2nUG7lpBaKpZ5l8IWyZphh0O4JpMO9FUbnPPWg7vdVfwM4+20t4jB0LFF -21b8wxy+JZ6G8Oi9I8DwUlmpgINcmsu1PKx82gNQ6Ey5M1CUPODg3Bm5nH79m2KQ -jqWXJSvWwLqL8ZUr257pCwPgWkYuwleodcKdmSVaz3FpR28xUapFRP+/G4i/RMf3 -soAzQVinbq3qLJGOkdVwfT9iTCPjAgMBAAGjQjBAMA4GA1UdDwEB/wQEAwIBBjAP -BgNVHRMBAf8EBTADAQH/MB0GA1UdDgQWBBTMfBqgo5cmKmYOfq79rwuw4oKRfDAN -BgkqhkiG9w0BAQsFAAOCAQEAPi4E/Q23DbSFLtRMxNIWl+aX8Ps50KJzIhrv9T1d -q0t73lXe6agQjKUVBqaf662JZ/r5ihBNiiaU7x5ieaz+3OaA8QsHuGd67p/eDu1L -zoX+EfagpIuT1r3aJeo0551pGhYDw+xhtaib/kc5sxfUBL5EoCyVi0RpwAH7cFwr -FOsVaOVetqbfTUqDYdnXufrV+IX9ZtXnz6yvdKdizdDrz6P+yBxGKQeYMkCGiUvY -nFvb1F5WH0lCM1klJilW8WHvGDsEmhgCRoRfJvlUk/I217KumCXPHh6pwiT5VwWL -ANPKWH9AyHvyXsP44zF4OMtEqQJVzxzPdnmPwWWH10iptA== +AoIBAQC/oFJpJMdyG9FTpNw4K9f1pdkNikwbQsx4dokiQBMTu89IMTnNfsHz2IDr +xCKTCKC3oPupniaEPNprYpV6RMz1UPvUYu/IpvOXGeIGlVd9ixcoYN6763R2nZhM +lFS8Tma9mV+e/B0jr9DbV1pUWIPufuPrYXcOotxDO/W5I+GpKVTz/ZGD//O5odX1 +mJzkwqjeqGa1WNdg+/ALiDtVZ/YAKGdfjx81uqc16fYuYRDw3BYImBp5MyNu/jxd +gNxFB1edcVowvcKXVs5pSlay2ad0eQSa0Ux8n3RjfisjTLAHks/4dkPa3hQyBYzm +xwBhMcMDc06yxiCkXsVnlXRn9nf/AgMBAAGjUzBRMB0GA1UdDgQWBBSGMhy1Uvrs +lmdHKAGQ9avMSWhz2jAfBgNVHSMEGDAWgBSGMhy1UvrslmdHKAGQ9avMSWhz2jAP +BgNVHRMBAf8EBTADAQH/MA0GCSqGSIb3DQEBCwUAA4IBAQA4vndI6NRcMgzba1y3 +lUPxy40bs/jQajR3A5fmCCX4c0ZeRc4YqE9cdYgeGffCZvPogyYjWDlavOma2uAQ ++3lZ35k0wG9GsU2g3fDIXpUuoSUjfYRLBQ3oqD7VRKYs1rDD87c+91DrsfIVZKF1 +W1RzOOvcW9QX2RHghFS4IluX6LEboo48cKtycA/nfmYDT/L9I4oYjaxc9l+HMUSH +gkQUU1xZnQ9GCqdhL3+2dmn0jvdgJLiFuefMGkE0oP/kFD/bhuOmDhpIDb10Cuck +Nw/nOSbBLINx2qDOa1f3Kox/PesQO4tp0dMp6XqZCOPTQ95vHsIOxuX1d+pxhX2V +ToWP -----END CERTIFICATE----- diff --git a/deploy/dockerephemeral/docker/elasticsearch-cert.pem b/deploy/dockerephemeral/docker/elasticsearch-cert.pem index 0dcaef43035..3a9d4ad013f 100755 --- a/deploy/dockerephemeral/docker/elasticsearch-cert.pem +++ b/deploy/dockerephemeral/docker/elasticsearch-cert.pem @@ -1,20 +1,20 @@ -----BEGIN CERTIFICATE----- -MIIDTzCCAjegAwIBAgIUL99uqBawgDCHt3QSK/GFH1YuQ8MwDQYJKoZIhvcNAQEL -BQAwJzElMCMGA1UEAxMcZWxhc3RpY3NlYXJjaC5jYS5leGFtcGxlLmNvbTAeFw0y -NDA0MjkxMjQ2MDBaFw0yNTA0MjkxMjQ2MDBaMAAwggEiMA0GCSqGSIb3DQEBAQUA -A4IBDwAwggEKAoIBAQDAcLADA+sdJUM4cJ8NI0hF+xnlLqCNqbIt9DLgGzqflPcg -NP9grELdFlPsJwpev3vb98YQobM4IbVf/KLAgUzXxsMyGM+srmzWXdMWw3ZoRCBg -udZGHEZowJ6eqcvMYP1WIeUfyxMdJiIljUJvw2C497MGI/ltNFTkj2igub0tO9d3 -9ALIpNc+Zgv+FwrxQMQyinzzZvOd8nlZ+0mkbCTUYdVQbQV/5A5dbpPYFZqckECd -vWIdE3wEZIuKfuaXh9pP4h2eWeWqyYneHR+kk8Rg8AGyPSQDEKXbLvaVhmHBoR+Y -Dd358/B8sblwe9VjVQJisDMKdEm7fFYW7gxQEeA9AgMBAAGjgZkwgZYwDgYDVR0P -AQH/BAQDAgWgMB0GA1UdJQQWMBQGCCsGAQUFBwMBBggrBgEFBQcDAjAMBgNVHRMB -Af8EAjAAMB0GA1UdDgQWBBRl/0SDwVrMKGh7qI61cv+J5NJrKTAfBgNVHSMEGDAW -gBTMfBqgo5cmKmYOfq79rwuw4oKRfDAXBgNVHREBAf8EDTALgglsb2NhbGhvc3Qw -DQYJKoZIhvcNAQELBQADggEBALBOvIBacwxw0za1O73EsAn1WIN7sdYIMQPNk5Q5 -gSeJs7zrvIbvIuVJdA7JWppE23ex36a87UPvJg0kfPjZQbZCVakL5YQgbFuskFOn -9yGiS5c/HF0gEuAwbelkAhIzGFHOF8gOFkjgsbA7ptuWGiCdxPzDMw6LAhehrdKT -xqjxPmLOtOHSz43/8FY0BTtrB4Y/yvBkz/AWNMn9WkSr9lPUHrD3+Amemlzp8a42 -qDk9wmcia5E0u50y8TvS3dz5vIS1uEXeqoK18qW+Sb7ManDvSbXf0oxFm/ZAmC5j -9q+nOCYZHWFmjizMHDK3C2VoGYtbN3d0JLdC2B9XFC54B5g= +MIIDMDCCAhigAwIBAgIBADANBgkqhkiG9w0BAQsFADAnMSUwIwYDVQQDDBxlbGFz +dGljc2VhcmNoLmNhLmV4YW1wbGUuY29tMB4XDTI0MDYxNzEzMTUzMVoXDTI0MDcx +NzEzMTUzMVowFDESMBAGA1UEAwwJbG9jYWxob3N0MIIBIjANBgkqhkiG9w0BAQEF +AAOCAQ8AMIIBCgKCAQEAvWOmaFQEjlt8yqmMtpKFyoFoaGYfsGX5YhNoZOMtEtKX +F6ct1nIcJA9h5awgAlivRKeAkySUZSsWKCibaeNGneN9XTcrhedVpEtcz3js2CbB +1MDyfS9mrgt78uv4zQ5ZHY3wh6LC8k5Aj0aK2PJMNjJogIksO7zKBBGU/L+IMglU +j0kPIn8qiIxgNYRhqxQ0iQpiD065PrjU+jfwz7/Q1Oslq+Xxa9fY2+yYG1XMVdC8 +s2waBl953qv3gNtWZ3O+O3cS5egH/HiNKSWRmaoFebuI3RPAORbRVgHe1k/xTI7V +VE9A2IvHkETmd0Kx4qh66tAc2qayX4c979I7oA382QIDAQABo3oweDAdBgNVHSUE +FjAUBggrBgEFBQcDAQYIKwYBBQUHAwIwFwYDVR0RAQH/BA0wC4IJbG9jYWxob3N0 +MB0GA1UdDgQWBBQDv9kWb35hEik7oNPxU62c6mt6UzAfBgNVHSMEGDAWgBSGMhy1 +UvrslmdHKAGQ9avMSWhz2jANBgkqhkiG9w0BAQsFAAOCAQEASMywZx+iTfpXH4Tu +C9261lD5Q2HZ3NtNRjGiImRjLhPQUt+5gLwwca0oiHBFa+xIt5MVwhnatJ2x8IZ1 +8ttQiqJUhXC8k62DVq1oMsgIusf+FaVxRQO5uCp5erroeUqJWvumC8013lNDjXHW +/X9PiouUTSndGI/pv6RokK+8VCT8mv7DvwhsTRyely51o7tCqHp6VjtD2wpm9ApW +qpySHKwEdwRSMvOIH2+x/Qa0ykFPKV1T+oqF4xM1x6ob06z3rS74uSK825g7Kyqd +zcjImK2DCVIkA3bSGxONQ/APTNd0TwAw9khhncjLJWjk1as6tuQGtpKWRA/01z+M +KHyT2Q== -----END CERTIFICATE----- diff --git a/deploy/dockerephemeral/docker/elasticsearch-key.pem b/deploy/dockerephemeral/docker/elasticsearch-key.pem index 7a527e61e95..0f15c75e114 100755 --- a/deploy/dockerephemeral/docker/elasticsearch-key.pem +++ b/deploy/dockerephemeral/docker/elasticsearch-key.pem @@ -1,27 +1,28 @@ ------BEGIN RSA PRIVATE KEY----- -MIIEowIBAAKCAQEAwHCwAwPrHSVDOHCfDSNIRfsZ5S6gjamyLfQy4Bs6n5T3IDT/ -YKxC3RZT7CcKXr972/fGEKGzOCG1X/yiwIFM18bDMhjPrK5s1l3TFsN2aEQgYLnW -RhxGaMCenqnLzGD9ViHlH8sTHSYiJY1Cb8NguPezBiP5bTRU5I9ooLm9LTvXd/QC -yKTXPmYL/hcK8UDEMop882bznfJ5WftJpGwk1GHVUG0Ff+QOXW6T2BWanJBAnb1i -HRN8BGSLin7ml4faT+IdnlnlqsmJ3h0fpJPEYPABsj0kAxCl2y72lYZhwaEfmA3d -+fPwfLG5cHvVY1UCYrAzCnRJu3xWFu4MUBHgPQIDAQABAoIBAAof46LE+gG2jCrU -Ago26P6Fj383TMsnOnCggGy6AgOTWs0e/LChX4MyQYgTJcCGYoXYK1uEpmE1pM1A -BXALXXecxXhFRefX5XIBzbFM51Xk/68XF+boZevs9mtyk35VO/7kGaHqlT7bWsCP -BgfLR7NzlL+l9OGB91VvFhoeq41NmVP/qLEeQRxYEGIuhsQ3cuCd6GnX2lnbqMFX -1KeseJXL7IuCvkiLc0x1PFX2AwXnLXI0sVcPdcO6ekfWBJmId8/+q10/DaCbLHPY -SAbX0tmO1CAz6PpHnzWgsji0JVxlmohk8dlp+d706TCtInQmwTnm1sXnpUUMOQLZ -LmrGZQECgYEA2PksOsTL+gakrYdIGD0/p4oxlaBogkFEHNv9ul2IeZTRkbDn6kVl -beNsyBKhDqnfgtRfZiLU8bQLDMTw10vzWzXyZghWIDkePVy/98qIDZKCzQ6pTNoY -o0pUuSVcNB6DyOEDlT3pimsSDhHDhK+IPf6XMsL2P+/+D8JxkL0DxlkCgYEA4w3a -cKTj++lDsNvdIgRSjYGuW8Kj2S3nyDkL9qn/kPIDUeuZwxPCDcX+xGgHLv+YI9im -x24CMPtk7av9/YJxWj2v6chSjjr283uqrY83isAL94hAmO2HC632wvoWIIeSbgdD -u3375kvsR8M5kVltVUU03hInFVNmqP9i2SCn9IUCgYBDqgFHGpRaFrRIgYXUOVWe -lBQ+i1XMOTpanaiU9BJZiDWK79aDUrz89g24n0am4gcYL87IdVhfQDyp8MkC+2ab -LUm41CS3y9hIXqJnTjv7r5MnC8l0dBd25Pli++mzP0jt3m5Vnoc0aYup45RLzsn4 -O2s/o1lUOy3KEGOGNcv1kQKBgQCn+UO1OgeAAh4V5VI/LDt2fI3lTKWysgdbVPjI -zxNGxAQ4wrfKXf+d+PB1lRBbcLO5MTqRJ41vd0w/mJIazjnVrPVLWuvYVT8E+mRW -ajGI8HLp+V7wxCi4N0brD+D2x9VImQ8+0gFdaqWuoXshUKtV/hESiRNo735vYCBc -yY/3kQKBgAhWQTx4SnH0RZdglC7yyWRgaQLs8sTN9PIKUN7rwwCxhxLw8DblVnvN -0QuwHwhQXQuNMrVojpr+zjFR9MJqvTEapfygGxLXlUFFnUGmdG5ejpxLppy/rj8n -HJ+5kgnS2Cw8CLsK4NE26DVqdMGOywZa2UZu9Yn293RO0Wu8pNRa ------END RSA PRIVATE KEY----- +-----BEGIN PRIVATE KEY----- +MIIEvgIBADANBgkqhkiG9w0BAQEFAASCBKgwggSkAgEAAoIBAQC9Y6ZoVASOW3zK +qYy2koXKgWhoZh+wZfliE2hk4y0S0pcXpy3WchwkD2HlrCACWK9Ep4CTJJRlKxYo +KJtp40ad431dNyuF51WkS1zPeOzYJsHUwPJ9L2auC3vy6/jNDlkdjfCHosLyTkCP +RorY8kw2MmiAiSw7vMoEEZT8v4gyCVSPSQ8ifyqIjGA1hGGrFDSJCmIPTrk+uNT6 +N/DPv9DU6yWr5fFr19jb7JgbVcxV0LyzbBoGX3neq/eA21Znc747dxLl6Af8eI0p +JZGZqgV5u4jdE8A5FtFWAd7WT/FMjtVUT0DYi8eQROZ3QrHiqHrq0BzaprJfhz3v +0jugDfzZAgMBAAECggEAKZ8z3CvS0IJ0u4llnl43PxkPnBoNjtPqac6AG+P9bOyR +PiaEoWN0ocwrpLEeW8WnxzvUuwHIBy/f77V06mGDjIGJdKoCS6xamv/hBsu5qYti +/+HjqPV46HknpWyMwmwL0731BaoUk/H0qEhFjYY6j5KmetEqwnosH5bJmn5xbSVU +yrXSoWYX5yX9e2gL2QD3IyVdlIzbRnWwxaHhSUSo4jIlw7t/oaLL2gurzYQVpI6R +a+0HsQ81IulEIMH6iWZCyKn3NCcB/5TifA3e3DwjiYxYxGC2JmxRBb84F0pV8DhX +vETgIhG8vrkz8h2coCzYe7XIwiklMpbijMREpC6QnQKBgQDrfD0JjHWhQ9u1qCAb +E1vN+xVAZ9LUJVFoex+BeOjU0JkcM7i1tQy4mEcq8LGjpPCX7k5XqtMo2UUPDhLf +bppuNWCmFeDJjetj3b/zxEe0UMz4+Z8anW9AZpIJYkeRN6R4/ptiErbygxqr0Wus +inT+qRvjZuSz6ajj8qdeZun9NwKBgQDN42I84JYtViVptJeIG2TcJVSVRq24ADNy +w9V/y53Nc4zRCfR5Yz9pw0pRuFaSgaDZvKFGwU51j/8/t/nDyO7+Y4fFziiDpsFP +LBKc9fI4UTpPP8QEPBxQ7gK4vTN0ouziqQ1bA7kXF3mPh/g1rRBesEEFtnu+lcoR +nnz5HtlebwKBgHH30PqcFhoUY3NJiTBRcC8Cg8iF9w1hekLcw+S/hb/prRBvH8gh +daSpXlgz4WVX4HFHjnbzX/r3HGsq3otwViFciAgZso8ZtoDAw7PQnPtx16Hv/ca9 +xygd/DO6cvSfP2SnpMAUWqKIPRJG6pu47uKJKcwm8iz4uxqHR+VyXXCFAoGBAMPv +jlEDJshUgFxdigv0jgLX3+wEDFTclBm29xqcizu3qJ5TS/6tje639KVaucDJbmto +kU8FrgZBmJdqHV7OfWtJCzAa5wGLE9KlzbzkbrRb0RMUSxYAoq3+JEbtf+eTGb8H +RPeFzoKES6JlsrhaUAbc07R9GrygTmKAIszuJ80vAoGBAIudK5mEcqD8VNMnMAo/ +atWoImkCKLNDkAxr1E34BCorQ3ZvJZ5k+vjxTtiaOIzo6/qj1MAzfHBx22sCyJ36 +4RhCfk56XiAzZiwTRALDcd0l40Z6OoitwsXdXazeG6PMPleZmV+t7lejYfGokeI6 +6jRKZxwsF6kSk7XNnHmeB9qX +-----END PRIVATE KEY----- diff --git a/deploy/dockerephemeral/docker/redis-ca.pem b/deploy/dockerephemeral/docker/redis-ca.pem index 11abcf1541f..85d169823c6 100644 --- a/deploy/dockerephemeral/docker/redis-ca.pem +++ b/deploy/dockerephemeral/docker/redis-ca.pem @@ -1,19 +1,19 @@ -----BEGIN CERTIFICATE----- -MIIDDjCCAfagAwIBAgIUXuktejnrKBHV68B+WH1eONMIhDcwDQYJKoZIhvcNAQEL -BQAwHzEdMBsGA1UEAxMUcmVkaXMuY2EuZXhhbXBsZS5jb20wHhcNMjQwNDI5MTI0 -NjAwWhcNMjkwNDI4MTI0NjAwWjAfMR0wGwYDVQQDExRyZWRpcy5jYS5leGFtcGxl -LmNvbTCCASIwDQYJKoZIhvcNAQEBBQADggEPADCCAQoCggEBAO2+EAh/J21wqCmM -tcFh2vPZXb7ssVY75FfhUw/2JVjhh46vI3aO58g6FW6MT6tmJL81/HnGSiDaKw2o -5MD8wi0QMiTUp5sfwNuF3MfKKXxK3/S7Ue6SXMbpvpQkrQjdQmQ8pqC07CPUSetG -WhUPO/Pb7SKYZgY+XG2FsPQFH0cpPqTcqDX9ZA3Ron45ox5WCQB9tLnNU5+OB3vt -lvvCr5s7cAtsV/T6TGUD3obILWimjnNOBbHBc37qGSCzwerIgbZX2EgVEaKvAIDw -kUkxqisjukcnmG7KlvXF/YeD2dXrDr5MqusSWUY/zSfMDvFtCKAfzKANM+XKm4Lr -c0HBAEECAwEAAaNCMEAwDgYDVR0PAQH/BAQDAgEGMA8GA1UdEwEB/wQFMAMBAf8w -HQYDVR0OBBYEFEPmDlC9GfIxXt/Bj53TrS99/NXaMA0GCSqGSIb3DQEBCwUAA4IB -AQAw5CtNPdpPusNGBfKvcEfpBmedi7AgkY5bDqQiy3GOPB/PgnxS0zkKzLN0GoTg -I7azplHoUwoUX1mOGPraB0POuLMq9it4+tn5NChNSeAOVuomS83/AJkALaZRHQvp -0+7DWd7gYe6b0TPjErpKQS0OJO5IxozNQxTo39X6pGVV46mvtvHrVJWEecWjhyKi -viEB3ellqCqGK4opWq7rxvlvJvOiUPwNM7eCigFFWODtMCmcjNpgUqlGWa9rmrlY -Xn6jFWU+JzxXfrM8Isnk1TWinwnSFs9q9xV725g4Oaze87uvgkapMTGtGLWiSszG -DpxpABe/kIz5EkTBfJSL9Q7i +MIIDHzCCAgegAwIBAgIUba2QSPicJVmpvwiyTu4YRiUzi5QwDQYJKoZIhvcNAQEL +BQAwHzEdMBsGA1UEAwwUcmVkaXMuY2EuZXhhbXBsZS5jb20wHhcNMjQwNjE3MTMx +NTMyWhcNMzQwNjE1MTMxNTMyWjAfMR0wGwYDVQQDDBRyZWRpcy5jYS5leGFtcGxl +LmNvbTCCASIwDQYJKoZIhvcNAQEBBQADggEPADCCAQoCggEBALm/Ta6NRzTQLyTJ +PbktHqHLhRnlrtsCp3IfJ7JGiuc5HLJL1NbNbLw+XgZwjiVwmeQeZMjH8Sa7tRay +9OtqeP55zbgww4nZtTFKH6AdDVVJDg5X10xghijqhjRRUSh1dRxI4q4f/bjKhvc9 +Uk9B6gMIIS5gzS+XCf+WxQ0Zp2Zr11wbFlQ2ynp8Bb1k1Fyao3e0cHzIRrCn0qbv +VNOtNwDL5/M6sJyu3gvuxOGKhFJ9GzPtSYjTSIkQnddmoMQuDT6GZMo9RkcWTRFh +6f0EDan1iAIWNcK5NrHZKA/L3gPLIb+d29HuKbZcdgcQLfMkfgX49cTDcSv3XI90 +Fz1IAVMCAwEAAaNTMFEwHQYDVR0OBBYEFIeV2duiox4T4NjZWcFgRiS44y44MB8G +A1UdIwQYMBaAFIeV2duiox4T4NjZWcFgRiS44y44MA8GA1UdEwEB/wQFMAMBAf8w +DQYJKoZIhvcNAQELBQADggEBAG1E1db7eaoS5OW+7XQcXHPpqvIP1GRPnsetN+L/ +1fc5lH0lzRyiY2BHNJUMsENiDXMbgPzuVR0Eks8i8goSM9F9rZK7znpnesgS3ec9 +alTIDHIgsgSrRTJWXsGFq4GH1atcjX3nkxETx/o4sV9MC2h5SrfiKnO7nc+/LUDC +hxrGLQikDmt+thygMG8LguCtEAVr8QghbAGxPyKKCLai4S8w+Mo1YtQYLLKhSeWl +Wmf+IpdLXZy1MS/G3b0Wy5py8ZkYQORL0UQMk2kCFj3J5m2N1xo0KsiXY7yZE9Wr +XNeZPtygtjDqTME+GvPB6vQloizMom8E3p40vdSx3Rsr+wc= -----END CERTIFICATE----- diff --git a/deploy/dockerephemeral/docker/redis-node-1-cert.pem b/deploy/dockerephemeral/docker/redis-node-1-cert.pem index afe2ff8f0bc..37bd4bc75dd 100644 --- a/deploy/dockerephemeral/docker/redis-node-1-cert.pem +++ b/deploy/dockerephemeral/docker/redis-node-1-cert.pem @@ -1,20 +1,19 @@ -----BEGIN CERTIFICATE----- -MIIDSzCCAjOgAwIBAgIUWt3CgFmrYNrum+X6kJUSXzoOL7wwDQYJKoZIhvcNAQEL -BQAwHzEdMBsGA1UEAxMUcmVkaXMuY2EuZXhhbXBsZS5jb20wHhcNMjQwNDI5MTI0 -NjAwWhcNMjUwNDI5MTI0NjAwWjAAMIIBIjANBgkqhkiG9w0BAQEFAAOCAQ8AMIIB -CgKCAQEAsDlKPvdkaOLaSQ9KaSy6sDn6eLPAGDQz6yihfsEVUN4wIwT4KnMxOODv -BdEx/iag9VgbRW1nAWLibLJ+MO4lPKBp4mfnILzZJVMdDJS/NL5qar0eojcpZt5d -IMPiNm1aY/bnIE3H/+mWy10E1vGaNFRyHEZo9+Y9b/smHbMc6HeDTma+uYnE5JAR -0lLTWB4Owk8i+4gdqExOfzZCThzTyqDOnXclEySiWUSuLEX/DKiyutZ1VO4dXyR3 -Zuig5ZD7NKQcx9GekIM5bQ3ms7qrSZ+yf86NzlM+jrVdGu0V5TSm+8TXjvRDrw1f -rBpm6l6pApKr2dogCkUlVj0051ncsQIDAQABo4GdMIGaMA4GA1UdDwEB/wQEAwIF -oDAdBgNVHSUEFjAUBggrBgEFBQcDAQYIKwYBBQUHAwIwDAYDVR0TAQH/BAIwADAd -BgNVHQ4EFgQUgpwh2XebMZ8EUmWOXPbiV5jj/gUwHwYDVR0jBBgwFoAUQ+YOUL0Z -8jFe38GPndOtL3381dowGwYDVR0RAQH/BBEwD4IHcmVkaXMtMYcErBQAHzANBgkq -hkiG9w0BAQsFAAOCAQEAjyD3Uqajjrr2R1r5rJPL2LIMN51BVy/NqrONNdPgUFvf -xELDlAqJDYsXVZwimUVN/SfqwOuN93Q6VQjrIQosnpQKpKApDQ95frq9nmzhIFTG -XOUpgUv96KWfsQmS4TVu38fVdE/J2FAcEOtqgMyxpX/oTDbU4XD1WDVHT4EAWQDh -/MuoQRBqmVP1viZLRNVIrld5SR4WBtNCwAyR40jxpH5hRH6QzasjkHAV01/Gc+pD -E9WJXRemXRkrNlWKktPAz3qzpnbI1Pupd2GrYrp/mmyY07XERaQ+VfJvnxj8TN3L -f9fxNAbyGAGIgOhQgyALgHQxGgz9i2j4mr+FVvp/rw== +MIIDGDCCAgCgAwIBAgIBADANBgkqhkiG9w0BAQsFADAfMR0wGwYDVQQDDBRyZWRp +cy5jYS5leGFtcGxlLmNvbTAeFw0yNDA2MTcxMzE1MzJaFw0yNDA3MTcxMzE1MzJa +MAAwggEiMA0GCSqGSIb3DQEBAQUAA4IBDwAwggEKAoIBAQCkyI311U2ZCCKvnPqv +K0y5A8CI8A3W146s2490ReOZp1xA+l1bPcVJan2N0Na/kLNYo9Lm1xbuNWxadllq +0DnhYTMzP48Rlh69lPL1GjWWI0vZjC4qcv0r6k4DrKVn6yvzs8jQDiykvsIXHcPi +OovQ+ol30xd01KV8k7CsAgFpDON9PgaLKTV5S9I2R+zfTGWHWZCfJlJea2fbf6Ui +O4VwNCO62C46aRLUh0qgdkqvjts1BV9/rzeLQ6UQBU3o4h+9obTOI56ZaUk5fU5v +mb9P0Fj+NLlEqIb2Zl7IopwiIBQSzA+3USFYMQl/fppyCm5X7OrQ1tjJNZ3Tpm+K +7CflAgMBAAGjfjB8MB0GA1UdJQQWMBQGCCsGAQUFBwMBBggrBgEFBQcDAjAbBgNV +HREBAf8EETAPggdyZWRpcy0xhwSsFAAfMB0GA1UdDgQWBBT7rOsZpR0sBNmrAIIj +raJniMK0FTAfBgNVHSMEGDAWgBSHldnboqMeE+DY2VnBYEYkuOMuODANBgkqhkiG +9w0BAQsFAAOCAQEAcYPqHdms1aYR5aWdqJYPRgydaAdTp14J6jXNQh8NU9jMIV0S +CTVuZwuSMoiMzQXezicHJjMc5YZTvB6SHNi0bidvx48Xuw/JUvlDHVysZgPZYR11 +diAsp+iD0+EB2hR5vHseehwTmyfyVIbFvWXNDNvRrU628gzWUlC4adsUVue8xsfp +dzQQUJKizO4sBM9hpxjF2iWnRDsE/QZPmPpuRD3ys8ym08zUH+R3dLFbNuDkWb9t +mr8IQJI6eALdbcn9vVHlGIluRni4Oe9d/lZ+adbLvbwsZsyeUldn/VzPUIAFE1P9 +HqWg9/JFnc3EQeuLGEqea+nk6WCHJyU5w7GETQ== -----END CERTIFICATE----- diff --git a/deploy/dockerephemeral/docker/redis-node-1-key.pem b/deploy/dockerephemeral/docker/redis-node-1-key.pem index b90430b476b..024e676a48f 100644 --- a/deploy/dockerephemeral/docker/redis-node-1-key.pem +++ b/deploy/dockerephemeral/docker/redis-node-1-key.pem @@ -1,27 +1,28 @@ ------BEGIN RSA PRIVATE KEY----- -MIIEowIBAAKCAQEAsDlKPvdkaOLaSQ9KaSy6sDn6eLPAGDQz6yihfsEVUN4wIwT4 -KnMxOODvBdEx/iag9VgbRW1nAWLibLJ+MO4lPKBp4mfnILzZJVMdDJS/NL5qar0e -ojcpZt5dIMPiNm1aY/bnIE3H/+mWy10E1vGaNFRyHEZo9+Y9b/smHbMc6HeDTma+ -uYnE5JAR0lLTWB4Owk8i+4gdqExOfzZCThzTyqDOnXclEySiWUSuLEX/DKiyutZ1 -VO4dXyR3Zuig5ZD7NKQcx9GekIM5bQ3ms7qrSZ+yf86NzlM+jrVdGu0V5TSm+8TX -jvRDrw1frBpm6l6pApKr2dogCkUlVj0051ncsQIDAQABAoIBACixAejqPUBO6bKn -GjqQ/obEzIZkkz3DiB2L40aelSp4M8tSUW+T69DDd83zEUUrbE1ay+lLKtbSG5CX -4rWvt9949xo1fdQ8ZzPMLlACZOhr86y0AMfaTvAW9pAjSy/gLlgY4iO+cikwqgZJ -c12iqkXdHgBTbdeYTaV268U937X5yFcuf70ySLBAFJc2AYp8IVnpQtt3zZC214Ag -9ot3hPppn7l8BS5DWncbSwtAfSd+1Tujj1a7qESO4zlFWp3F404lvsnezHolgL1p -+blY1u8GmNkFAYCRMTwaqfNcMNr3BE2KqqMDa2ByGEqvPgtu+4GVnJjuLt32UGuG -wLXHNkECgYEA6Ezr7uuUUKTCI3Q+KV036BzLg+69pL0NEo1cnwUZFoX6tMAwxK0p -u3R7k1bvOysQlcYjekCtmUOCTNvaqaVK0eNiffJQ5OdxfX/DW+KqRPw7Vmg9Rgru -DojbL8Xe7kPUN/hWGOhkVZEIU2+Gt5fjMr1lvMezOmP0Smh7k7dKvOkCgYEAwjPK -6dyBuqW7NQGwTTNjrOnY3koATPXudBMiYpJY6EErtOMMPVeb2gvRAJpxZuykGD66 -4Zj/SQxWkbtxgWP1r/2NQYcz2Zmblwh20+h77yS/y+ac9f7LfG4yLTr3puimF4t1 -x2+Qr07VUDp8sx30nsarr/q+NAWsC+e7Kdk6JIkCgYBi/TxgsGSgRMUxxHwktkN3 -lqWmz9piU+k5KaH5ZXu+XFNsKKXfeYbaCZYLQDVrejt0B13g36TaNalVxS4VsokC -janPz61nDbUP7Jy8EAfMo8tJU9wgd9HfwbPdVK1dzOum+hz+OjFfQRFSNKksnP3F -Bm5PFq4qSKO1/XYDiUzA2QKBgHKwg7V5NGQ2XEkBpkzxfHwx3pHowiSxWRHT+wqb -w0XmtxksvZ28j55GPDhO/Yn7Vy26XkO9R4ascrO+L1pq3j4BT9rTLhvkS672oLal -Jgwld9/DYg8lWqcxrRBpMrivzOc6xWPyz0+5DuFCqUJe/oiGa/6R5qJydxjQ0gf0 -8hGBAoGBAOKZuY994jVHkm+yqgtyJkQQRoSoW8dSfrr087YqDv4ibxlmyyEGvm+e -06TQiq9I8mr+kijNHeHGZbE/JzQEdve5QH6LODMjnqR6r9Z2TY7GqGYssZFdCohG -EE9zSR2j4CFkdSc+/VF1oYamsz9KpwmHyYTFdYEj+6fmUU1FHccd ------END RSA PRIVATE KEY----- +-----BEGIN PRIVATE KEY----- +MIIEvQIBADANBgkqhkiG9w0BAQEFAASCBKcwggSjAgEAAoIBAQCkyI311U2ZCCKv +nPqvK0y5A8CI8A3W146s2490ReOZp1xA+l1bPcVJan2N0Na/kLNYo9Lm1xbuNWxa +dllq0DnhYTMzP48Rlh69lPL1GjWWI0vZjC4qcv0r6k4DrKVn6yvzs8jQDiykvsIX +HcPiOovQ+ol30xd01KV8k7CsAgFpDON9PgaLKTV5S9I2R+zfTGWHWZCfJlJea2fb +f6UiO4VwNCO62C46aRLUh0qgdkqvjts1BV9/rzeLQ6UQBU3o4h+9obTOI56ZaUk5 +fU5vmb9P0Fj+NLlEqIb2Zl7IopwiIBQSzA+3USFYMQl/fppyCm5X7OrQ1tjJNZ3T +pm+K7CflAgMBAAECggEAKKucSBbVoGXe47+nqrjR5p8rs9Cl5ccNnpHRQgYm4uto +7Fuu04B3M0POicRH4H+XGFNU0Cc5sGDspZYswx1yD7O1FprDFbjazPlYjtChdbUv ++RltYoo/fMmHaEZCC9hCIJPYxisdbyrqzhhJWsqO7C0N5U5rLWl3j7wHAKk9Dl9b +lIdn+AlEiA2cpAk/5rqSZysOv0+v56jh1ay6Hqsp7jm9NAdEoSpJMDwZ/FJxu4PZ +vvxxpACJhyVZkJuuJPc68HbwXIPhEImPzc2TA2Zok+PdgEpnNWpiSGainsaDY6l3 +9XQabptbwhHke0eikQQ+27PXFl5XuvU6qHBEXnFXQQKBgQDdDRILeIUyZHFRJCaJ +uaK9/0IXgTD2p5/ef6a5RcoSEDda+fvKUbd7MlLnLkSOWko27uheVwnpVC3RtgQf +XmMenbAcsh+3a6bDHBK1VwJZAHTb11aLOVzBiof16FTr89OO5gu4WEM2XedOW+Lz +o6QJQsoJfR/6Q7jfwSwNQR54pQKBgQC+1hRuRJsJiaDRIq/T/9dmNhMdPMw1ojM2 +i4EeS1wYUnDr2D/KfpDFKZ/uVobFekH1eqKOQhaUkND9/kHyx/4XBZYcabxxyC2w +SoY26G6ha/gKNlgKhioqAtMc8f7caNwZADrggYIilfPc2uQAaAtKbWb8TuJlGDmF +WcxPRvSOQQKBgQCEZo3GXRu6wTq2VSbYG16E2t1lYrZHJsO061SbaFfOVfQyA8Vy +u1tg6RWK7sWVVjNZj+OSjiObpBYFpDX36/sGnYCcz3v7yvkJqEj0YPdBA+r6upJV +tbf/HNCu08f5xAOVdejTM9qeN8SRxKu9LujTuzN0V4PNzL5xFy0hiz2LGQKBgEO1 +CMKmrKsRnXEV8XQyDWZCQT3aWEmfJrRvgnwRGLe4aEAFFXzussaBIjEZme9ulQBX +Zl06rXBAgSXck+Fje48HeF7UVPu5nhwyFLReewHioLpe1ZXGTCdjoStf4KCqw4xL +PJhy2o0SztbJAqPyRi896ZATHNfpZF8foRFvh00BAoGAIrvHzt0EBLUaquJEKotX +b56F7s7uhgoc/ugcHgAK/b7K82B4/3K8lg3naynmabkU0/rdmcnyVfyXnjVFevpe +szUiOX+zG20LJnN9G589fRxFJM9Vny2WLV+7y7VoDoLl5BkjR9VBUo11aYVW97QH +Vr72lA4ZaymQK2MtMWlTXsQ= +-----END PRIVATE KEY----- diff --git a/deploy/dockerephemeral/docker/redis-node-2-cert.pem b/deploy/dockerephemeral/docker/redis-node-2-cert.pem index 197c0fe13f4..4681392ce71 100644 --- a/deploy/dockerephemeral/docker/redis-node-2-cert.pem +++ b/deploy/dockerephemeral/docker/redis-node-2-cert.pem @@ -1,20 +1,19 @@ -----BEGIN CERTIFICATE----- -MIIDSzCCAjOgAwIBAgIUTfzZA/HviaUtA/woHZJ/zXlvNHUwDQYJKoZIhvcNAQEL -BQAwHzEdMBsGA1UEAxMUcmVkaXMuY2EuZXhhbXBsZS5jb20wHhcNMjQwNDI5MTI0 -NjAwWhcNMjUwNDI5MTI0NjAwWjAAMIIBIjANBgkqhkiG9w0BAQEFAAOCAQ8AMIIB -CgKCAQEAtIF3npW2eNVRJpkyHkj9WjfZu4Lzjwkbx58LUIdQEV+F2Qm6bZkHLjEi -yqofA8vtuqixbmNuAeTrbpA8ChtGetmUhz8+iyWGNe6LwS15opb3FGA9Kj5Lwp4z -GtVdrbE+NauBRElILXXyirt9NsJTM6RWY8tZrhrjz4m20yGRRsVvVbi2tBsGDRDe -6TL+6acxtVi1DBCYXB5IaffM2Bjvu04ZWpDrRtfuiuyRmcO5E0D8UOAem83ujmtI -vl5dWfqSsfDl1YW708l4cfWq2ZSONmflKGU0+Nw4fVuiMfnKFN6y20ZfAMSdSs4+ -uKv1UoEwESgfjw783PfSBAso7aQNSwIDAQABo4GdMIGaMA4GA1UdDwEB/wQEAwIF -oDAdBgNVHSUEFjAUBggrBgEFBQcDAQYIKwYBBQUHAwIwDAYDVR0TAQH/BAIwADAd -BgNVHQ4EFgQURKDvYGOeSDaI9TkmN12XKCr62EswHwYDVR0jBBgwFoAUQ+YOUL0Z -8jFe38GPndOtL3381dowGwYDVR0RAQH/BBEwD4IHcmVkaXMtMocErBQAIDANBgkq -hkiG9w0BAQsFAAOCAQEAm2hcglMpoiTcDXkNo2rh8OknE8Fb4o79xmzKEABVCmOm -aAiniZAKBUz+vW6mT4GTGegyLHh0g82PZMYSk/UOtRitKkrpiBBNZBnUGtpUgN+C -Yalx6RCc6nbhSbzi5jk+DIG/6CswpzkXG4Hrw0zEFQWNBIL4sI7K6cjXKmKL7jfV -fo4DcjszkmFcgXxjz7UTCZKMF0pZ3qKnCvO8pq3wQ80pgnK9o4E8cOmRZpybMObL -JwApaUoxNik3yFzfeiVSEm9K3fFyJ/6jrvqPPIWUKPOTdcQdUTv+1jcnwZ3GFzya -WfgPqF32QQCapRCUCyzXgU98N+LsUOFCM7Mt+td5Xw== +MIIDGDCCAgCgAwIBAgIBADANBgkqhkiG9w0BAQsFADAfMR0wGwYDVQQDDBRyZWRp +cy5jYS5leGFtcGxlLmNvbTAeFw0yNDA2MTcxMzE1MzJaFw0yNDA3MTcxMzE1MzJa +MAAwggEiMA0GCSqGSIb3DQEBAQUAA4IBDwAwggEKAoIBAQDusjRUdb9cOIGhRXVG +WqsawsdIqljT2r2G7wTtSPfTPpLqMY1rcw1VJdHKG4Kx8SYEZZ02IOjHkV8Ik7/m +0kiKUNo+nRURvNkWsedoQt8/5NvL6O0d15BoHMSjJMkQYKDew2pEbcR3YyLrndjl +qRv4QSaESA1c854IejG1V91Tvk7KC4jqmisZEz6hrHg5XBPGk0cTb3rAQhFgpZo1 +tpjhc9CHQzNv+FM6lgy/n53kpTDYpGJgYN1I+lqU1qN29WHKaMNHXBj3GT9uZ64e +4IPmbCIn+U3+KWZACaD2HbDq8QLcTFxT3kyETH27UPkETDa56pPHgqRWziaNbwgS +cZx5AgMBAAGjfjB8MB0GA1UdJQQWMBQGCCsGAQUFBwMBBggrBgEFBQcDAjAbBgNV +HREBAf8EETAPggdyZWRpcy0yhwSsFAAgMB0GA1UdDgQWBBRd+gHa2Eis8uVk//hq +jqoBINup4DAfBgNVHSMEGDAWgBSHldnboqMeE+DY2VnBYEYkuOMuODANBgkqhkiG +9w0BAQsFAAOCAQEAV8hQotbxJAdXEyZQjQPmG8AmUZSi4U8LnMDe9od58sD59J7o +m26WbNvq7tDRVpBsrUCk/rfVT8I26h1ImS2tlZtyW5LiKOi9t3I3W1s2fnWk6GBg +tH3SKf0aZRw96RSoYa7DNp4MilRtF3pQF8rg78b3BYaAUezCe2KO9Ddlym2YhAth +rzSY4cek3Gsd62SFyq8ufFq54Q3pImcVF6shGidmqfeAgRRXumekdDSr7rkvEJ+5 +6fAVMhLRu4YGGH5SPF2dauFgpMCgMFHp5uUmAcq4sLbnLZhSckuzaagoaQRZAALT +NdJ9nFHupmUGV/dagYSx+cFccEVJ0nl29YF4qg== -----END CERTIFICATE----- diff --git a/deploy/dockerephemeral/docker/redis-node-2-key.pem b/deploy/dockerephemeral/docker/redis-node-2-key.pem index b85a0f9c29e..ab7fffcf64c 100644 --- a/deploy/dockerephemeral/docker/redis-node-2-key.pem +++ b/deploy/dockerephemeral/docker/redis-node-2-key.pem @@ -1,27 +1,28 @@ ------BEGIN RSA PRIVATE KEY----- -MIIEpAIBAAKCAQEAtIF3npW2eNVRJpkyHkj9WjfZu4Lzjwkbx58LUIdQEV+F2Qm6 -bZkHLjEiyqofA8vtuqixbmNuAeTrbpA8ChtGetmUhz8+iyWGNe6LwS15opb3FGA9 -Kj5Lwp4zGtVdrbE+NauBRElILXXyirt9NsJTM6RWY8tZrhrjz4m20yGRRsVvVbi2 -tBsGDRDe6TL+6acxtVi1DBCYXB5IaffM2Bjvu04ZWpDrRtfuiuyRmcO5E0D8UOAe -m83ujmtIvl5dWfqSsfDl1YW708l4cfWq2ZSONmflKGU0+Nw4fVuiMfnKFN6y20Zf -AMSdSs4+uKv1UoEwESgfjw783PfSBAso7aQNSwIDAQABAoIBAQCrVu22EgS4ZDx4 -uBhz2PLsrXE3ZdFN5+Z/sT+rPBZLt3G1GF/nYsgHF8sftyZjkzLg6Porf6RPlf3I -4I6tRUC8okYzr1vt9zuTfBEa2NDJ/iUhKU1GCQYfAc4e3YPjuQgFJ/w3Vpx10qzc -9aWg0grqTUdXyRIiixHN0bpCZW2iT3UJV43aK2Y19Sv/IMw4ANFn2Kn14m7iHLTT -Oh7gVHxPQWgnw1xItfpmKEnqWeyI4IqzMU/FlxrNaUGBiq4/+It/zZAtczRIwa3X -bjis//xHbzU9e/8dPFaEASiorIcfXqv5alO9O7pkDO+9iQYHIpIkX1u3NRDm5/S0 -6j92f8VZAoGBANYVGs1WtRjfCBCSAfme3KvlCgAbhzKiM9333CdCfhYMdBxbWaG3 -sfC/xmCmnCDtF8d9zbhiTxJ/MrsRLJajmH6Bps+PZZPUQEctPR9W+cMWqjgUjfSY -rwb9V9liKx/UIXQehwkbE8JJDCeMF00BSJ0aM0fnH9jTaHrFqyrF8QAVAoGBANfZ -U/g2phWaAJWIn6a1yxjezgwPNJOe0J9K+zTif9CxRK4qjgGDyAAr6yBCnW2k9xbs -wjcvQe3OV097GIBznZDQmF+3llUXn0FnTe7dne+wh+RsbldakeA6dSNM+jM+LSSh -X0MqtVjAKDR43lZNLWzK7R87lkTyRuUeUnogFM/fAoGAUFT7CbJPolWOoSkotJJ4 -G8iGSCQMR2O2MsSfR9wblAp4R2u/5n8Xtk9AEWRzkadmFOWQHHBHW5l/X9LB+ITK -5C2ieqBEbYRn2k2PcgMhFaObnA+adP4WL3lBTcEYjYj8RKZv5WrTr0PZ270lwS+K -H+mE9KY1vRcXTXp/ED3WgUECgYEAqe1UJ9KOCe+FijNWzJ3N2DR/rgrCb3zV7LHQ -9h9iVF9aHGswBI1EhK4OmwUWft0iERAvDdbMZnTNU6sq7OUYJIuziZc0aKUCITE8 -r1IVJj+pm/CpJWgN86LR2Qqe5nyKeY35Ox2CSu5sOHL3RqXXnxBagP4eHQVHPtUS -RUbAW60CgYA9lLqeekzDjM5zZSSOWpnlh39ObsQ0dHA6d/OlEqZnI/vcUH0HSh2K -qKtalL7vv3nwt4cB51Bhyl1BXOtPKRnUEGIWaM4c/qxXE0R8PqfQa003gPALgwaZ -74bNvJTut/AnKuoWugWWwLdPWgr3Xi2D5cDIea+wX7IsIluRMgMHmw== ------END RSA PRIVATE KEY----- +-----BEGIN PRIVATE KEY----- +MIIEvgIBADANBgkqhkiG9w0BAQEFAASCBKgwggSkAgEAAoIBAQDusjRUdb9cOIGh +RXVGWqsawsdIqljT2r2G7wTtSPfTPpLqMY1rcw1VJdHKG4Kx8SYEZZ02IOjHkV8I +k7/m0kiKUNo+nRURvNkWsedoQt8/5NvL6O0d15BoHMSjJMkQYKDew2pEbcR3YyLr +ndjlqRv4QSaESA1c854IejG1V91Tvk7KC4jqmisZEz6hrHg5XBPGk0cTb3rAQhFg +pZo1tpjhc9CHQzNv+FM6lgy/n53kpTDYpGJgYN1I+lqU1qN29WHKaMNHXBj3GT9u +Z64e4IPmbCIn+U3+KWZACaD2HbDq8QLcTFxT3kyETH27UPkETDa56pPHgqRWziaN +bwgScZx5AgMBAAECggEAGaBQNfEeRkxavnGykYcSb6ERvB9twfDuABqRMNhwouFI +7JO9VxfXCpkw2L3zXh9BsZ8nLbSCyUo2JbmXFLTmzNK5W5eJt4nK1MDs0yi6xyVO +46lyK44FFuhfxBQi8fstyjy4n/gY66hdC2a67o0lT5XPCMyjgqM1CDv2Mj3oqSDE +QXxQtT3sSVLWGT+ztQhcLBdUpIG6Q3qaXr/JTLDDNn3kIAB9XOw21tDibRPGdw/P +54b4fx7x9K/0bYZg0STh6xWUBTM3geUEW3tRUMkaqtbjXltu12j6rf6FfBOip397 +pdER/YCFn23nIHAn44jp60S4eT2p9QYPxPcAeFnIcQKBgQD/VYO+G3peH7fKI9FO +kY8bLIr9aiF4F8AzPBeUgJjK3MrhkV2wZULT/VD0JMJubAICfSwYgBvQXiDNwD82 +CeMasapzlolnMTa7zYyjIYZSeBXvJpOcSyuPNy8DCPp5mwfEXeoGcpbuUjPBIBsD +rHO45gFS75kf6YBO8/h3AuJNOwKBgQDvUZSqTDDF3sF/Z2C7Kn2cBgoB6tsUqTQV +ZdKRjSoIjSI3XoPzyCQdLrnq1bn7aUXt6IlQySZNjJ4hXr/yduf141l8j4XTNMPe +kisPNNwIPvsDOVO/27+emn44Py4IMIr3kdwoO7YnVHXu4IM6DEhbVC3Pi0glSxol +ydODQh/x2wKBgQCsog6+vClR9jP3MZxUeMm+37DhgZ47aiODAIAY4ZFspzdspzIn +D2/NkJnpV+k1a0U4lZT4w7UKfnnDYtXaHXk1FSZfnEouQPH2rBUIPqRoodSCqxxm +MdSzseXRMYLYMV9g/vY5gcRWQbHIQ4LASxq6ypfekSyAjQk5WG6HWKXU/QKBgQDl +ejqtmWVjNxggDIbKshHEHF5YPFVa2Gyi4AIro0rc7EgVA8JPbmiCux13Ov2dP/LY +EBQrrNXXorC2mt4/pxkBxME4GX9faMcwksRLTop2Nb4H916BKDvz33yMfrirDbET +d3+97JPb3rc/GXV7oe93854B1zKU4BDwjzkMMcnj5QKBgHsko7YzcZKjmaEV9ecr +/9wrBA5OkckoxeJo5qlqxg7p63V7gEZ6/QjfJcuCvDMEYMKjhgb8bbq+JgCyjCHB +0dll5cH6Foe7RTePT07zhAEutLxUU32XiwKtN9dyBQlXoMmJl8o+G+pfcWb59jJx +Rv22/ufIlLl6Z4JZ9RWM3/Ka +-----END PRIVATE KEY----- diff --git a/deploy/dockerephemeral/docker/redis-node-3-cert.pem b/deploy/dockerephemeral/docker/redis-node-3-cert.pem index e883bdb2c3d..f676a744e30 100644 --- a/deploy/dockerephemeral/docker/redis-node-3-cert.pem +++ b/deploy/dockerephemeral/docker/redis-node-3-cert.pem @@ -1,20 +1,19 @@ -----BEGIN CERTIFICATE----- -MIIDSzCCAjOgAwIBAgIUTorva53MIkurIdKFSyZmJR/8UKMwDQYJKoZIhvcNAQEL -BQAwHzEdMBsGA1UEAxMUcmVkaXMuY2EuZXhhbXBsZS5jb20wHhcNMjQwNDI5MTI0 -NjAwWhcNMjUwNDI5MTI0NjAwWjAAMIIBIjANBgkqhkiG9w0BAQEFAAOCAQ8AMIIB -CgKCAQEA00nlA/2dwqnzW+fvLfeje12cbB6gFf3w9+UU4R6uXmXYguVK0QquIcqd -e2vvsR3So4nryGQucZYzDVqhFx11Q+nXFj3ucMmffXy1fLPxsExlct234sKvZJ5k -WlI9nd3ApJ65KfRQVyk6hI+Z30+0NJS6YeDNSAy5uP7Ir3r3l++uFxsfmeTN7Gjy -HtCVdXrGACXxnm5A9mYApnIaArSdBjpY0PTusPhMj/2OnCjnY06Q4xm3jaPpO6ku -f8m+W3CQlZg7/JYLBafHyS0OxNWNxNY839pSV3C5PVlcl8dKPjZvYmBotDig8LmI -GNfKzyP5PHd4+q4YrCY7gtTslah25QIDAQABo4GdMIGaMA4GA1UdDwEB/wQEAwIF -oDAdBgNVHSUEFjAUBggrBgEFBQcDAQYIKwYBBQUHAwIwDAYDVR0TAQH/BAIwADAd -BgNVHQ4EFgQUenIQo9JRyLCNWRFssHJoc16LtEYwHwYDVR0jBBgwFoAUQ+YOUL0Z -8jFe38GPndOtL3381dowGwYDVR0RAQH/BBEwD4IHcmVkaXMtM4cErBQAITANBgkq -hkiG9w0BAQsFAAOCAQEAGici445nGuUKcjXtknyYbDD5bMA8+69SO27AaH/xvR5G -nLJe1b0lhVvZk6n8ZELvpSTPe5Uk2DmoME3FioA80tNURz5f+xtnVnyjoJE30/vs -Gdh6yym/GO0zlZc769toW/NVFMQqjyrFJuvzWyvYDXW1Fc2M41bnOIe5t7GAxGl8 -XX3TO7l6S50JoYRtC/xZQe2EOj6h37lyA3Ks3p5uHSwPTFZzOsLGzPApTInifZ9w -LUDABGLjghAUz80+YiV91TBYf9knTIwW+1SUltRnjnrLKLeXmWE2nKKsPmxgr9Xt -GuxsycvyGDhwv4jlEvLVpzUPQC4CB0ksxW42nX2sGg== +MIIDGDCCAgCgAwIBAgIBADANBgkqhkiG9w0BAQsFADAfMR0wGwYDVQQDDBRyZWRp +cy5jYS5leGFtcGxlLmNvbTAeFw0yNDA2MTcxMzE1MzNaFw0yNDA3MTcxMzE1MzNa +MAAwggEiMA0GCSqGSIb3DQEBAQUAA4IBDwAwggEKAoIBAQDYU44MmK1l+2zjBrHY +/ORzWNWNsM9cMuh31KuNBDf1yD8Wg4YxfRgrqI2la88qRVNz3bUr5P8P/ubk1UH2 +agK5Drta7fYkvDPhveeTIOKz9l/ojxb4mXQ5aNmRZThtftokSbnPj8rCLRTvwpxW +wtZGBPAOTHcIRAZs3w8XPIFY/2FnOILHMpGUD6MrG0texcV05GLi10ZEevVb4tPl +1QF4dvyQdGjpOZ9qVn27xl2GAxX7yOlxC5AgLS7HuzLyCP5eyB4i7hRK06XjrVu+ +VUi1nzrOneDJzBFZLhcY1ktEKnmqvZ9Wh6eZGepXo8lV6QCH77OJ1TNSL2ke8qUb +IMJHAgMBAAGjfjB8MB0GA1UdJQQWMBQGCCsGAQUFBwMBBggrBgEFBQcDAjAbBgNV +HREBAf8EETAPggdyZWRpcy0zhwSsFAAhMB0GA1UdDgQWBBSq82oTIR7xwMx2Cfim +DbOoj8FPajAfBgNVHSMEGDAWgBSHldnboqMeE+DY2VnBYEYkuOMuODANBgkqhkiG +9w0BAQsFAAOCAQEATue+pKPQpi+RUUNsxi7REOmKjVwvEOUePqsovmXzE8aC3P8v +akpVDDggA7JeAgWcFfFng8SimNTq+TqfNRx06E7MYc0Fcekqa1wfTe7eEdaHrekd +vR/HvKONaenxQ0jDD7PLQi+8dZAvValb9avw8howkrQlt0lLt3KVUHepO9ErDJ3P +ymhAl1Dc/8PiwH0wicXmJSnxSpIttv1WHW1wj31G8f6D8W8k6i8fQYPeMI/OyGu6 +tpSe8SXZ/P/trEVFCWISYaq861jufkaTdHGKVMv+rL0E+Ow+zmLmeBRLq+rrmTT7 +gWCV/wl41D9nrzWYtSmBEnwcDHK7eRqb5NiGmA== -----END CERTIFICATE----- diff --git a/deploy/dockerephemeral/docker/redis-node-3-key.pem b/deploy/dockerephemeral/docker/redis-node-3-key.pem index 7b111f5e89a..0264fce611d 100644 --- a/deploy/dockerephemeral/docker/redis-node-3-key.pem +++ b/deploy/dockerephemeral/docker/redis-node-3-key.pem @@ -1,27 +1,28 @@ ------BEGIN RSA PRIVATE KEY----- -MIIEpAIBAAKCAQEA00nlA/2dwqnzW+fvLfeje12cbB6gFf3w9+UU4R6uXmXYguVK -0QquIcqde2vvsR3So4nryGQucZYzDVqhFx11Q+nXFj3ucMmffXy1fLPxsExlct23 -4sKvZJ5kWlI9nd3ApJ65KfRQVyk6hI+Z30+0NJS6YeDNSAy5uP7Ir3r3l++uFxsf -meTN7GjyHtCVdXrGACXxnm5A9mYApnIaArSdBjpY0PTusPhMj/2OnCjnY06Q4xm3 -jaPpO6kuf8m+W3CQlZg7/JYLBafHyS0OxNWNxNY839pSV3C5PVlcl8dKPjZvYmBo -tDig8LmIGNfKzyP5PHd4+q4YrCY7gtTslah25QIDAQABAoIBAQCZpO2VplKXYRCn -r5Q9IAxQxHTgJrEQ7PXSvlIdljsESBlWrjhmpNaVmgpE2uuVJ3OqGrxLn5YqYSfE -uTfVYEWK2jvfX6/JcsS48vvir9O7+QH4soRqsFns2EVvbMiDyOKykv1hJdlaWI/G -H8qsGgCYD+MtE9UTZLWVcikrekcbwwvIXqNNskHcViYXOabYEvgyQ5KvqLi6AYtY -NQl8UgPY5VGWCzJqBmuH13wS3/bPxF3jIEWQbErD7coRr992F5KTQMQ9k5w8PXQo -ZLmXaceQV0KqWdlXRfB43W1OyH7mLp+zrJLitjRYIozkwTeFc+FN9PYlJqIeBejI -6C8l3eOtAoGBAO27YamdcG9lkXIwvZPRQM1/hHTy7/1d5xB0hpSWmDDg7iA3kSZg -gooEqr1TQV/jDicoPcEe4iNJwc5pKBxF5qZqyrup77nETuvZc0Zd5J2YfQFJtIG8 -RkJV1/97HFy3Sns1mqfHOqjzcqq9pGdfHq/ElZoDtAWqcYIItpygCP2bAoGBAOOG -U0bEVq1AXsM/EKXZ3pMoio4uMhir94VN8/TYkDbdNViBV31Ri8UvitARn7Sq93Co -I0+71iRK6QOD2BdAk6ZqJksJ9zuMiAarVWgu4qInW/NoqECqNeb4XMEou863cm4W -/nnYe3vmnTWjiSQctsD2imcYIH3IO9nkFiLj9eV/AoGAOIe2UX7+nX6pd13ftqar -ojIQbT7XkoghyefrmKm2xui1tzN/cIDCic9SSnLhuMtlMip/hMyzOXDwhQS8ZPy6 -PBho3Pcr6iCkI7ExmCn7kv4Pu56rLa53ho6jLj04IVP0ghfdDshxSnuZaMBvt6UG -xwUYDeeTh0VgeGtaASSM/sECgYEAy1ns6BznEyWrDHo7GOBmq8PaQkVLhP191mjb -l4RPMJn46ceAOIM/ltdtC5YU1VbQnKHKHaNWO02wgPG/mtienmfVHdAkZdauZLeR -N/JfoGnpJt3tMw5t6qcjz4fmg1U2MureOmyfwRdWfvBQzDPVqxUukgHgWEs0IwRW -PIzd42UCgYAgbp1uGhGUMGodtl+donLLZwQtS190UOQ/WLY4RiIZLW76PAvWFOo0 -qy7pbYbewGiLOjKTO4UWndHOaCE6zQr7qIcBdlCGSO56azCYaOb3xe/jbn6EDq2R -mutZBgUms0OXPHfa2tB1ndrvedLI8fRWazWrol6OTD78hH5bb6MD2A== ------END RSA PRIVATE KEY----- +-----BEGIN PRIVATE KEY----- +MIIEvAIBADANBgkqhkiG9w0BAQEFAASCBKYwggSiAgEAAoIBAQDYU44MmK1l+2zj +BrHY/ORzWNWNsM9cMuh31KuNBDf1yD8Wg4YxfRgrqI2la88qRVNz3bUr5P8P/ubk +1UH2agK5Drta7fYkvDPhveeTIOKz9l/ojxb4mXQ5aNmRZThtftokSbnPj8rCLRTv +wpxWwtZGBPAOTHcIRAZs3w8XPIFY/2FnOILHMpGUD6MrG0texcV05GLi10ZEevVb +4tPl1QF4dvyQdGjpOZ9qVn27xl2GAxX7yOlxC5AgLS7HuzLyCP5eyB4i7hRK06Xj +rVu+VUi1nzrOneDJzBFZLhcY1ktEKnmqvZ9Wh6eZGepXo8lV6QCH77OJ1TNSL2ke +8qUbIMJHAgMBAAECggEAMnVG2GRSacu8CbZZjHHsfYU2hq67p1dOhwjpnOJjhSZY +pNE331o85Y4SwAeGEmeKQCfyJtNqtRnxVGXz1VzD1tN7WwnPVKE7fsezeMt+ZZit +pUqfAoyUogF1YicYgt3IVxeFSkdRdXpbfFNJ8SjQHxPuxH8McrafQwzCcdqQlyfI +fnhNYxHt9lL262lywRLkuAwXB69cUdLXaemfvNVcTW9+QUnz+Emx3KnlhRyRlMNn +hgkwsp4NB4nElHKHntYaoVlEqrDRJyz7mCXNviHb/WC7kNznLEArzPJJa4YjAedy +P9kXTlYEkUcmrv/furc7wrAYeJ/+qQ27ToGk+JI9UQKBgQD0LsPKfD/ep8Y7Qcvl +VOSYqUrjQ9azW2IXkK8L5U5IOZbXScsB3gdxhLhSk2MDz2R8n0BUlYEihdzRBA4K +aH+4qW0OipwjQD+qUU5oW9SJ6SaHRp8Mpq7d/mSR7HnNfXCz60YjYPID+71nK+6q +FcBvFvLxopQt7ZDFaONHMWNodwKBgQDiy6wP5b3ncfG3LzapKM73X765scTUXuZa +ow0aHMJ9nRi0aiLnlGzIPwh3QU5L5mpG+gAIUlaguI29x08BtkeorKhOJ0M/taT1 +nbf0FLIQBm2uzpm4ICTlGEi/drUwssw5kFou4AA3pscdY7dam7BRb7eMcaABECz9 +WlJldDC4sQKBgA4vNUJq607k0hgZH14IC2tu0iHXi/5JPa5+whxfyqdZaRDCgZ9v +JWGLwyVQ2HydLIosuhDvyluWCRi/Mo2aOmkgtmwU0zMdBVXAeVyIkRUdzRYonQ6g +FCJjJ7ZuVTkBo21gKmfdttFSa1M18xxAPTh2zdAJkLAGT9WX3TQCg3LLAoGAXQKE +LPzeNdXP+H0/YH5g6qh0cnlKLIJC3Db0P5o91QAhSpQgfnKrbjATi7zXnF8BhNww +OTlzV3R4hLUBXMVhe/ZbC7okZTNcVHJ7J3l5UQMh5kfKWO2t09pyszq+shsRkCX4 +JjMtQ6V9ETt8zYb991fmoY1TvjvhB4IMOpk9BfECgYBZ6TaBR81zK0bX2dJpvWBu +ECwG9vg80NuM8UIjeQ7iCzfSD/6MsYDedU8+u7seV7LZx01DISUFu6q4rWpncJ/1 +W3+LU/apgy7+jeJmUjN0lFCEbf7f0h4x4GGXYbDCiPdzcrL7g5gcwaaf0+0PO4bZ +t7SfNCX7wVFT8ipYG2vTNQ== +-----END PRIVATE KEY----- diff --git a/deploy/dockerephemeral/docker/redis-node-4-cert.pem b/deploy/dockerephemeral/docker/redis-node-4-cert.pem index 30a51cf51fc..e8ebd88bce0 100644 --- a/deploy/dockerephemeral/docker/redis-node-4-cert.pem +++ b/deploy/dockerephemeral/docker/redis-node-4-cert.pem @@ -1,20 +1,19 @@ -----BEGIN CERTIFICATE----- -MIIDSzCCAjOgAwIBAgIUAkSg4x2WvodAayAK7Zt6uLHvUJcwDQYJKoZIhvcNAQEL -BQAwHzEdMBsGA1UEAxMUcmVkaXMuY2EuZXhhbXBsZS5jb20wHhcNMjQwNDI5MTI0 -NjAwWhcNMjUwNDI5MTI0NjAwWjAAMIIBIjANBgkqhkiG9w0BAQEFAAOCAQ8AMIIB -CgKCAQEAyzoes8dqU5BusBBM0u/If98TW+0ynKLHynX7DAhd7kTzc35EMNAKDcRv -Z9gaLftyyV901PkkFJ3eLh6lYzadSwTfkxXZdcc08rLWNzeFRDTBRu0XMOZds57S -ETcn0g2KEp2m0uSY7gaXyc0OE1/S3WQtfu1HDLQfp3/Ls0GUQtprWfP2OEHCa7sl -oPUKfwAhhhjbcphxs9P/Pdl55+H12GFKlj0N5ir879nqn5QTAPDt3kCkT9WHyJMi -TLhLFhI+NtimXblXYEghRnpKWLa7IdbDliElug0PmaKaPtlPUdmOcEtVudvKQWtr -6oOlVMQ04I/PpF1E0vIcSZQDC4XqnwIDAQABo4GdMIGaMA4GA1UdDwEB/wQEAwIF -oDAdBgNVHSUEFjAUBggrBgEFBQcDAQYIKwYBBQUHAwIwDAYDVR0TAQH/BAIwADAd -BgNVHQ4EFgQUklfbcU7/m4zAPaap6+bo4kOHX0wwHwYDVR0jBBgwFoAUQ+YOUL0Z -8jFe38GPndOtL3381dowGwYDVR0RAQH/BBEwD4IHcmVkaXMtNIcErBQAIjANBgkq -hkiG9w0BAQsFAAOCAQEATdOKVE/9GqS1UrbmMys6aFS6DQLdpOcEKJYwqSgRjOBO -rVS7fMW6WIK9XKKuiKsd7jL1myMa1qdLocICwsikOW5YZUXKEymQtp7+Ex/2q5mO -cgOgA5z/L699e4U8FI564OLJdgs81ZTn8qbdFHXG1WPWm2Bki/eZ+6tDH2dEgK3E -5UC4CyfpG4De4XBgI+8FgYRkeip4i1REyzMJ/h2tvXo5vfI1ER/hPB120uJJPzNq -VhhvrJXHOsoldNoquXeQ/c/cdVnnthtABrT+X2YzeFj8vUZIU1VEJubobvLCpm+q -ZdSzH+NN3iWVTAXG0sSzJxg3iGr/ICY+ySR8z+87uQ== +MIIDGDCCAgCgAwIBAgIBADANBgkqhkiG9w0BAQsFADAfMR0wGwYDVQQDDBRyZWRp +cy5jYS5leGFtcGxlLmNvbTAeFw0yNDA2MTcxMzE1MzNaFw0yNDA3MTcxMzE1MzNa +MAAwggEiMA0GCSqGSIb3DQEBAQUAA4IBDwAwggEKAoIBAQCvitE2tBIZ5zco7Acg +zZXive6YAUJTrsyfLAFWWJo7rOZJ3vlVvKlGgRLcDRTqS7Rjs5ZiKKjO+vbCo9GH +akHz1hzDQpXUoSeyRlu/AausQbBB1ZhDOzlcg2bmhhG3CYswrSSXM6GdV7C1J4wS +0pmXoZJO9QKvgdskkgHn4I8RGGIshtKRA040yoRQPNJeC7QUOZj94YC+pyR0Yb0e +pawKDllkhpCIosg9TWqEeOFTdm4ibN+g4M5xihqsHTkBlQjvb4U45ybZyJdT3bw2 +inN2f/FZsyOp8as4JoMbXnp/Bwd01Ze/cQ5pVVz4pnvW9jaUzJ5yRi4du3v70Ft0 +mP4TAgMBAAGjfjB8MB0GA1UdJQQWMBQGCCsGAQUFBwMBBggrBgEFBQcDAjAbBgNV +HREBAf8EETAPggdyZWRpcy00hwSsFAAiMB0GA1UdDgQWBBR2P9NFa+sluP6Ic0su +lqWSIP2i4zAfBgNVHSMEGDAWgBSHldnboqMeE+DY2VnBYEYkuOMuODANBgkqhkiG +9w0BAQsFAAOCAQEAjInARY3/TdhAT0RJDdDLyxfx/NF3VD+L0GlA5YGAqj9lLyr9 +rE96N7y6/imhc8r+zecHKcJVNZ+NkA9YHhK0NqkC8UXcV/te6KWxe8KbvrFfuhep +BlWQ0RhQYUDDoFuyZ9FoH+gdynz3OU1J1LyGZG280O5/QQL+ON5t9rD1wYCcTRM6 +zlUyWtbUWxrGVvGClRn6lrTNphOTxBtKM0cqXD6jnnGUqLhCY1y801HHzfJ07jIY +b5iLW+kRiwdnDIvuiJ8gRmqHgr+rHwpv15HfumedQBUuZsVTPpcFiAqs1wrT8BFn +EWPtolHtCOwd57X4UP/LpPnUAHwQJPmloDaL8g== -----END CERTIFICATE----- diff --git a/deploy/dockerephemeral/docker/redis-node-4-key.pem b/deploy/dockerephemeral/docker/redis-node-4-key.pem index 88d64e27c4a..5da453ec076 100644 --- a/deploy/dockerephemeral/docker/redis-node-4-key.pem +++ b/deploy/dockerephemeral/docker/redis-node-4-key.pem @@ -1,27 +1,28 @@ ------BEGIN RSA PRIVATE KEY----- -MIIEogIBAAKCAQEAyzoes8dqU5BusBBM0u/If98TW+0ynKLHynX7DAhd7kTzc35E -MNAKDcRvZ9gaLftyyV901PkkFJ3eLh6lYzadSwTfkxXZdcc08rLWNzeFRDTBRu0X -MOZds57SETcn0g2KEp2m0uSY7gaXyc0OE1/S3WQtfu1HDLQfp3/Ls0GUQtprWfP2 -OEHCa7sloPUKfwAhhhjbcphxs9P/Pdl55+H12GFKlj0N5ir879nqn5QTAPDt3kCk -T9WHyJMiTLhLFhI+NtimXblXYEghRnpKWLa7IdbDliElug0PmaKaPtlPUdmOcEtV -udvKQWtr6oOlVMQ04I/PpF1E0vIcSZQDC4XqnwIDAQABAoIBAG81m813Z5jY5alV -EiUv8AEBep+IWnTaowgIrdt0zKnxc2OVCg3IGmhUQT6LRDA7dCH8KXvN5k+d4BJO -1ORI46REw2/CuiA4ZaIV+SF4MWYUlFuSrGkm9smvNHcVPqY0oIT1Xm/zhjhixTc6 -DeTOQB7EjhzyDTpHazcGuNqcHVzDHeJSJHOaAfQ46eKvy2X29mczk4f63mclWYTS -nXuloohabZRkC7TmyfIbfQDJ0PieK4w05jc4JI256cxlgmLPacecE8DHUyXp34zd -YxQnZ3ysAYgUNX3N1+Bgvb50tLQTcmDK0u4Y1vJ+DMqsk3TNCeQrjt5z0ZC8bako -gOQX8oECgYEA6Ki2Ka5rsIvnQpR4qVwLe7TCxJ/+bKculkKSpyS6rdy0tn8/TfTR -9sxn5O4N/mUlmjpwGqbbpZtN7nUosbIXb0WOR2wX9WtZgcnxbNs2EUF57trzJUdQ -jeMs5h0jK3o2zghsJm4dS9RPrvORdv1fRzFwJ8U6OOQrL9rwBOz9s0ECgYEA352E -peLwpheDqouHLdXhkIJAYF1GKeWmyHRrXKhc1qCaspQkY3lSPI+5CkgJHMdfVnMf -CMq6/zWKTe4jGVPc6Lf8RooEjFBHziiLzntSbKTMHYFauA8P7UcgdvDjvPlkPt91 -OeWTW1/5VGI7T82M9HiZKcfyZi2Qu+xk+cDmhd8CgYArAyXKRui51uOGN5SnGtE0 -qZJob3vF8pJ2TRB3vh6VDfyK0LOPYfd/PQLoG+qSYXi2Lp+TDc4Fq9SYhShk0Zvr -glxvb9huEs6VZBQyH8S7I/O66NeSyMBnutwOHszluM5xALWd1TWtUy74FSeLbAQ1 -UTp+38OHyQcC7eL5xiaRAQKBgFwa03JIgXrIILF0ex+EAz60h7Opd6b2MrZKTZaC -uoqk6FM59asLY7YSNNNpTGeQL1K6ZEQIzPElqmvi9I4QHuO0NLMRUkJBJvJhfQR1 -g0PAtVpJ14YMnjDLpTGYkxVZW9MR04UfbIysgVQiie+a6L4hlmTBOLShfAYLnqPI -sqrdAoGAV1phwzzbtCrI6BupI+jsIIc+TgXg1yk+KYtUL9N3xU1mjjKFxOwS9QSK -79+33lXMUCgXchLxYD89BF9gprdvRm3w03T0npj1ZPvixNKWtkrFjCJJ4pdkq8Y5 -qROO3h8GI0rkHMe3ODPUIiJRe+7rPb5jjlzcA2jXR2RI4lXl6T4= ------END RSA PRIVATE KEY----- +-----BEGIN PRIVATE KEY----- +MIIEvQIBADANBgkqhkiG9w0BAQEFAASCBKcwggSjAgEAAoIBAQCvitE2tBIZ5zco +7AcgzZXive6YAUJTrsyfLAFWWJo7rOZJ3vlVvKlGgRLcDRTqS7Rjs5ZiKKjO+vbC +o9GHakHz1hzDQpXUoSeyRlu/AausQbBB1ZhDOzlcg2bmhhG3CYswrSSXM6GdV7C1 +J4wS0pmXoZJO9QKvgdskkgHn4I8RGGIshtKRA040yoRQPNJeC7QUOZj94YC+pyR0 +Yb0epawKDllkhpCIosg9TWqEeOFTdm4ibN+g4M5xihqsHTkBlQjvb4U45ybZyJdT +3bw2inN2f/FZsyOp8as4JoMbXnp/Bwd01Ze/cQ5pVVz4pnvW9jaUzJ5yRi4du3v7 +0Ft0mP4TAgMBAAECggEACYE2L8STQFTNH0mcXzHSfkrzasaSrU5HJQ0wa1jzzOxh +MbnBfVtwPPGLMGAC9Gax9z4Hk/wIm+Bp0QMmurLNrGK4/veRfkhVimkV2aNBBNwv +q3jhvC4uPmyc+zliJyt8nl+Znhg9FXRkjIJ+Kpy9lUC5182bXh5lW7cOJFx70pyM +5+UZ3+ogNnGqEtTSRSEKR0TzCLC6hORmlWCbnyYCaVG/H3tKAjg8Mwb7vFpreXSQ +QXqeRT8i/wVcWGvnuYyhkIfuLWOFXMswazLPyf1H8pF6xAxqeaX5QKhv19mE6xf3 +A7ZdBgsCigWcKuNDb9Fx2s/5xZM5SygzbStOvH27xQKBgQDbcZr3mZx2NaYLbDWX +Rk9b/plm7sYBCbenUXHZVE4px2DJ+r4V5XjVvzHM8cLRcNmSPhZJjamhVNsLNUOS +L39ouxuSqarLd7bxB5i2vCUEqnqVs2JhgVAjucIuOhtEGhk1yR9gGIgadXYhO93Q +bdHbop2qgxut7XWPWhuqe/u5zwKBgQDMyP0dOpElgmpzJ9mzgNNvwtxzA4uqllEH +Mst1I+8mQRRVEaqmB+TpfeoR/OUKKKk3XcziDTLCCkwyplahDW7AHbYeizevg++6 +G/09Z0XyZZ51L7LxjVi1ORWyCDrTFMASjPzUGedcIANKkCHZ5q3971iSyjFmXrKa +G/i6pyF8fQKBgQDIuDQf7/CuK0oyvoqSUOx73/ger56LCoFi2NtDB5rrGgRNGz3N +N3T8RgLeS/B/tDI+Uu3930beW4hzyweAalOmzyZcUzb3HwxFkUY9NwDBMNIppcgC +Gc7crqePsvSHqTuP9+Pr+ORdFz2zDlhIsnq25BpFAeFKiJ30Pl555SgN/wKBgGV/ +UISGHJ58rwn4PFxNg34nFGAk57pa2jo5IMIkV0mcg9lN8khsLTbU44ia0WJhmM0K +Ppvjcr7dn7qS2ujj4Xpyv2sQET96ovyZFsCySObFGu51/7jdF5RqgKhGj/FCnZgU +LNNrK1Jrw3XXTg/T13S+hiXq9OUKFndvWa4ZW+15AoGABGPWL6H0hQWyzYq1CZl6 +kdCW0b1cZeuJyl8C3MCFq5f20myvTehua0DdROT+MaLJQ+20etJ9TRHpKiUKhcgq +gJ9y/8tcMG0hMPjQkFzFsHuDiIE3UOtJd9kUwLbl97WUZX1EZ5jmIVdCpcsx6WcU +PFoetX5NdFoY2jhfWym5WcY= +-----END PRIVATE KEY----- diff --git a/deploy/dockerephemeral/docker/redis-node-5-cert.pem b/deploy/dockerephemeral/docker/redis-node-5-cert.pem index 5196275ab92..d771a21b461 100644 --- a/deploy/dockerephemeral/docker/redis-node-5-cert.pem +++ b/deploy/dockerephemeral/docker/redis-node-5-cert.pem @@ -1,20 +1,19 @@ -----BEGIN CERTIFICATE----- -MIIDSzCCAjOgAwIBAgIUNSrcSVi4+37eJ5x864GYsVzmIpkwDQYJKoZIhvcNAQEL -BQAwHzEdMBsGA1UEAxMUcmVkaXMuY2EuZXhhbXBsZS5jb20wHhcNMjQwNDI5MTI0 -NjAwWhcNMjUwNDI5MTI0NjAwWjAAMIIBIjANBgkqhkiG9w0BAQEFAAOCAQ8AMIIB -CgKCAQEAog895utST5jUQP2og9DIfTXIkwm0wy8QgMTTzoZfD447BMvnKCO0JIP7 -q/03I+WTKsX+b8uGxqdgoqD+3xYpA7doSjDjaQWtRpHpwyXDL/LGySB1u5OdvMln -EDv3aVNwx23FnZqhE38jAbMt+1yC2S5Y/erMAnBrMhCSHQeRUPcPwsMoMo5Kufns -0wo+1XZcj4mKI6adygFSYDD4vLXv82usl/w4/VEB+rJUr+Zy+ZxqQlCqSa4K/qnQ -KZXuYMF4+GaUnFhu1QCU6ePQYeDEPPdBWnJBu62hYa7i2e01wOp66dGzMp9aOBOJ -VdwRrDDC2/a0HP1i7jJ+Nwjfps4QLQIDAQABo4GdMIGaMA4GA1UdDwEB/wQEAwIF -oDAdBgNVHSUEFjAUBggrBgEFBQcDAQYIKwYBBQUHAwIwDAYDVR0TAQH/BAIwADAd -BgNVHQ4EFgQUqZm4VY5DqFEAT7QW05oRkEPUVy4wHwYDVR0jBBgwFoAUQ+YOUL0Z -8jFe38GPndOtL3381dowGwYDVR0RAQH/BBEwD4IHcmVkaXMtNYcErBQAIzANBgkq -hkiG9w0BAQsFAAOCAQEA4PD/ogU9UACl/iHCEsNf+YRHlkOmu5nGh2pWiMKCS4DF -B62EdjFLCVs95W+mfAG3s3z1JmkHy8/vSpqQ+LNZqWFwlSmvzeD/krTUa4ZrknHK -Uq3NBzY1HkW9HKZv7Tp/3S8kt6/rM1rcQRJe8TcfzmuyKafIzV9WAmx87pvckH7Y -jPkoCLFl9Sn4zQX5YWPxWrSHtmjopUWyE+OXdPd+9duAeWWFYgKqiFAhXaUSTfX2 -8G/bPk/szSoxIvFArbVuUHBoiNuGbVagTfQG1dXHMfWyupZLlMybenQ4g5uixSiY -XajQHvllsdcjcJ0U9dUey3o+Rkngz+z4mwux+iXjJw== +MIIDGDCCAgCgAwIBAgIBADANBgkqhkiG9w0BAQsFADAfMR0wGwYDVQQDDBRyZWRp +cy5jYS5leGFtcGxlLmNvbTAeFw0yNDA2MTcxMzE1MzNaFw0yNDA3MTcxMzE1MzNa +MAAwggEiMA0GCSqGSIb3DQEBAQUAA4IBDwAwggEKAoIBAQCiYYwsg3+qF8hXrp0A +ni/h4oySwTN7JBsElWzipzoY5k5VLZWdYITaYc+mypys1OSHiVsDff12FGWAsKMD +ItoFC2jnMGx9FQcXMokNRmEdmvcOMEx6Y314U/63HzAKYC7XCrV6TdK12zmVxiCc +pZ7Iz8Ch7bzeFTQQY4cdvA9sJJeJ5oJ5Tm/JJGgSzNPBOHbdeDuprQayihA3Hfac +19oM7tZGEqvjk/otzxmi0X7qMKFO43cxD4URqHWa6So2T2g//HvwMoq0AUajmXUI +9DYgownjfZNJ0ISEouuPLHe4C3jdG8ku24r25cugpkY57zN7BlDU0trOFk4TeeyM +HXD1AgMBAAGjfjB8MB0GA1UdJQQWMBQGCCsGAQUFBwMBBggrBgEFBQcDAjAbBgNV +HREBAf8EETAPggdyZWRpcy01hwSsFAAjMB0GA1UdDgQWBBTM1a20hY1IgokeC3tT +zg6shjIA7TAfBgNVHSMEGDAWgBSHldnboqMeE+DY2VnBYEYkuOMuODANBgkqhkiG +9w0BAQsFAAOCAQEABtQ69VGkEHPkIotuB6kqtz7LtDAf4D7N1lIE3pib02n+5wHi +ITzzv0uuNpdzAPfvaR8OU3/8uNzA6GvrspNLaDbhRnXdTI4eDpFro+vRGvsqaLPa +FWpooa+zNgoIqPzQ/3exN6nA0APYqvxRUcAdsaP3C4clecBvHWOpZya3Q1sdvCH9 +b0Fidfb24D0B6arHrx3hEwufmamkMxOnvUFh7mqyEwuyb2lF2x0VKT5/u8+rfOSj ++xmv0A5gsc/Q1jIkzdfGco7i+BWbINS8dj77ajDykpxvbdP1mGzXCqJdBkxaFhO+ +iLUAqbXLDw47wCi3Pe7wDaWFqQfgs97j585lUA== -----END CERTIFICATE----- diff --git a/deploy/dockerephemeral/docker/redis-node-5-key.pem b/deploy/dockerephemeral/docker/redis-node-5-key.pem index 337d6e60584..6167a8e8275 100644 --- a/deploy/dockerephemeral/docker/redis-node-5-key.pem +++ b/deploy/dockerephemeral/docker/redis-node-5-key.pem @@ -1,27 +1,28 @@ ------BEGIN RSA PRIVATE KEY----- -MIIEpAIBAAKCAQEAog895utST5jUQP2og9DIfTXIkwm0wy8QgMTTzoZfD447BMvn -KCO0JIP7q/03I+WTKsX+b8uGxqdgoqD+3xYpA7doSjDjaQWtRpHpwyXDL/LGySB1 -u5OdvMlnEDv3aVNwx23FnZqhE38jAbMt+1yC2S5Y/erMAnBrMhCSHQeRUPcPwsMo -Mo5Kufns0wo+1XZcj4mKI6adygFSYDD4vLXv82usl/w4/VEB+rJUr+Zy+ZxqQlCq -Sa4K/qnQKZXuYMF4+GaUnFhu1QCU6ePQYeDEPPdBWnJBu62hYa7i2e01wOp66dGz -Mp9aOBOJVdwRrDDC2/a0HP1i7jJ+Nwjfps4QLQIDAQABAoIBABosC/s3Fdv0+pJk -ZMqk9TwDa5kTgDXla+zf3LUFzmRcu/tSUsqQuY8MIaDtC/KoKNRHlYfIfsOmVFzv -UzoEAiuvexBARPm5CPrUpcP2XUdpFeF1dI4OkPLkM9jTVmmUKCqM99U0G79iUOz9 -Wve1QQyCB606NihOr4EuW+qERlukyPkDkhMcq2/ZmHHZRWOgVFKxMCG7xGB8HeKx -QnayjU2pAUeqoiTdG8TME2Ir2WjxCnAni42aK2R/4DTQxEVyLyLC6VDusXa4rSom -/zop33zLnFicL62331aJk0+2urYRYSoFVezNHWYviSIj36PPZ7nl3IlRtllSXlEY -hOh8SgECgYEA02lB6CVGBuoKfLfGrxiZT1Wl8fL2AaJ6lXK2iQrOrKC2Hzb9lYvz -+DLjabD2s4nXja7pkekGgo+orU2jJiTphKzt0RelOO9476GWGkfawVzD/UBPPqjZ -qW+BqGGZgNgZy/aTVgqKx2ZcTqOzksshdEAV0VFh1GTaW35fuqVFT90CgYEAxD1W -aX4feLjJgT6iAfpCD0gTIIlpcqSD3/rZtPgFvTkDwHJQo3R6PckqoeU4OTm5K36m -eTJFBH/ChZ+/F2sYR2FJpQvDNoolcoRhm8H0XOKkDHcyfCiCxRgUm/Zwer5W/Z9N -Ejh0TXds8SAja+x/1puMwF9KS4Mii4Org8vn5JECgYEAmRngDeN4bCdvwtRAQauZ -0zdefvKJr7Nf/PzfLi2ycJfObJqhWHzLCNKpmG/8qRbJEKU8J1vPSBwLdr4Dyerv -ZhLqAwORtsLOHRQzJQMma+PnV28MNH+JacgD6NINnZ5iSDBgkO3/hNofPSAWOtd6 -ebqzUiwSogMLkzjY0M1Bfc0CgYEAmB8ARGirltaQBet6hNPtr5DsmtVKc79KJy96 -4kk9kbCH0wAKuJrLQ+gUb0mUKvAvNaNJAzxPuiwbq5/o7wtq17J390RGAJpYawxp -6ecROYvLJYqlDRAORyDioQAJs2ynXJXHle9DYOXKAqUqMDg15TPRiTKVEjJGbiYU -p+dCDLECgYBpMUhl4/eTnHqpcbmSRo8GGp3nmO8910MvGaqyYdiDGTfnXUTk2X8T -0SjPiSGv5kc3SWnkBJV+ZMEtuELHwFxaOuYJxcFBKcCiKmaVTs4s7vTUXLGnNuD8 -++lQ8Iqol87XVCaz6YwPHjU0Fe+PP9TKpN5ztcR7x1HChfW8MEQNZg== ------END RSA PRIVATE KEY----- +-----BEGIN PRIVATE KEY----- +MIIEvAIBADANBgkqhkiG9w0BAQEFAASCBKYwggSiAgEAAoIBAQCiYYwsg3+qF8hX +rp0Ani/h4oySwTN7JBsElWzipzoY5k5VLZWdYITaYc+mypys1OSHiVsDff12FGWA +sKMDItoFC2jnMGx9FQcXMokNRmEdmvcOMEx6Y314U/63HzAKYC7XCrV6TdK12zmV +xiCcpZ7Iz8Ch7bzeFTQQY4cdvA9sJJeJ5oJ5Tm/JJGgSzNPBOHbdeDuprQayihA3 +Hfac19oM7tZGEqvjk/otzxmi0X7qMKFO43cxD4URqHWa6So2T2g//HvwMoq0AUaj +mXUI9DYgownjfZNJ0ISEouuPLHe4C3jdG8ku24r25cugpkY57zN7BlDU0trOFk4T +eeyMHXD1AgMBAAECggEAHJX6IIr8wkOiDgeMFaQDb2tbzmkLKFI8nGO20bbZRDFl +GFsoQ9aORMijzuvLxaRL3+1nE5gOMweXr95IsEBmK62sx8hPTPzS7PtFQ8xAQ/84 +H2wSxpf1qmV1CaVIpob0sAAvXwrMvZ2Mh2ij7Je+eoESWx9YWKtYaUswKeSlvWZy +2OQVQ72eX3MTMTjwXBTqo7cVC+j0/yMxAha6lRRd4BlWDuUi9VZIRS2LC934sPbx +dDDm3qkP9zXF4xg/8MrWe5BTA9pxVcAT+RMIhnk5g+mjHxKL3B7Klbhzn+SLWc9A +1TWRntwbUC+8RYWqCNesAdoLIlEJrNUncOhY+CrPgQKBgQDVFO9yUbp0uMeAJFD2 +qQEwnybIWyB0SWUEq91kFQ3cSFoVSiIvaLYZM6n9lSRwxdXS/KtLnhdyUbkOR0rD +VOJmPf136MwlTHMud3YPxku7YWEDH40BIbFvBNUYj9y4GpPGANen7NgF4Vnn8T6G +7SInfx79y+JhQ+Oxd2DFikQXgQKBgQDDFljiqPQeGUz6B/y4CHBfc+e8eagdt3km +NXsgFuGmu3ksy5uBcgCebXthh3coKPeP2cIwob4sfnjq8vuOWSsIqquLZmidyyb9 +ARBQ/CtSnBXAyakoOnI4usPQmrbFq58xIh6I0MRk1N1L1D2MTz4i6QZzRekxAFdc +nBpaclAzdQKBgFfvadm9zLr6vqotUpRYrrsIExNAOCaFW4EQBC+XWL79xN9gVrdF ++VBxN8gE0qMPoeyOhYqRVY/CFiLEXSA7WatkDcR8eDM0V5xnhHuCFCLiTwzg6mn7 +I6RzVBXs2OPJZA6krlsIrSXQGDBWKL26AwxVs859Y5FMWR0V7QPYyb0BAoGAJZ4A +g6wqbkdYpXm2zFGsQWubCqe2uAwxyyFS3Ywr9Ld/lRipops17VaVDOhPHKpRmiZW +IIR/pBq6/CrgQMGG38PxEg8sKwkKOozi9Yq6W9KHC0aXXI9wiOnSaj368kC2kIXQ +t3bx97Nn/IAvYgfBpn+iY8XeQjmbntrm5fvW5SUCgYBmqOIT2yiFGjJybTvwcDr8 +Lz9QpCnP2mHYiTmzXnPZGCaLIeSmXxCr4YDTgKajKcx0NVZmX/iGm9VDrfZn593w +EVy/oxg+vpME2RnnBLDstO8dVMOuSs8/ao0PZWylkuC+5bMvYO8iaGk3EZSX2fmY +AH0a1dtdGMveeGsFqnQyjg== +-----END PRIVATE KEY----- diff --git a/deploy/dockerephemeral/docker/redis-node-6-cert.pem b/deploy/dockerephemeral/docker/redis-node-6-cert.pem index 66defdb9c21..9e323b2b5cd 100644 --- a/deploy/dockerephemeral/docker/redis-node-6-cert.pem +++ b/deploy/dockerephemeral/docker/redis-node-6-cert.pem @@ -1,20 +1,19 @@ -----BEGIN CERTIFICATE----- -MIIDSzCCAjOgAwIBAgIUY4v82n3xCyE0Li63Fti2N2Lv9zowDQYJKoZIhvcNAQEL -BQAwHzEdMBsGA1UEAxMUcmVkaXMuY2EuZXhhbXBsZS5jb20wHhcNMjQwNDI5MTI0 -NjAwWhcNMjUwNDI5MTI0NjAwWjAAMIIBIjANBgkqhkiG9w0BAQEFAAOCAQ8AMIIB -CgKCAQEArky8eJPNGRVXh8+lhWeN/4RKMPdW44fWVCvkWJDIkHMu1qH+3h8Qx9Ms -qbex+h9l71xT5bWe6PxY81v6LF3+FOXkO+FuIwYYSCAzUj6pfNMyQB9BIix96er8 -Sp6WzqC8jpUZFvcQ7dIfQqlliXogzbvRQQhHMeT2zzueAxwn+8S2+Y5axhYsATin -U+xBD3xZ2ParsdeWeMCkVfOfcewWca0K+oawAcVod4r+2rBmlipW8sYZS/6bvAVI -T4dVHFvPtiRqtyVR7oY8uOJ2R0Ko7ddOp+xUjgpzb9VgdV4unC/ysIAKZQl+Fd8G -64jFJXr11chRd3n4oGsuGv+4jFzkFQIDAQABo4GdMIGaMA4GA1UdDwEB/wQEAwIF -oDAdBgNVHSUEFjAUBggrBgEFBQcDAQYIKwYBBQUHAwIwDAYDVR0TAQH/BAIwADAd -BgNVHQ4EFgQUImh6q8TU3QsrteCJMNhCpl9rOFgwHwYDVR0jBBgwFoAUQ+YOUL0Z -8jFe38GPndOtL3381dowGwYDVR0RAQH/BBEwD4IHcmVkaXMtNocErBQAJDANBgkq -hkiG9w0BAQsFAAOCAQEAwRryg+yRLwa0pblMTSwd4MUcfucDOZ5liA0ZVtPqSwlB -SESq2NfyrqEAP+iafuAmIThb/i94ONOSfRIqpR05lcgdlobq2eq1DXrPjdtTPyeO -MjFYmOd5UqdUF3UNbO7PyL9BZ5eSlg18zBMuVWoPcP/0IMn6FojQZWdNaTEhcPnm -qdPrZLt5zc7Wn/f/hp226YJ4KpGLg6SkirzHkasGdEv6ZhXiJ3AGs9DZGcNOFyiw -RqrXbBx1T58qvzZ9Ha/ER00Jj+y4Kx7dOwbIh62QeHzyAIVlIhAkKAIG1hiONPdD -8lNSIx7CawFyf0u//a2SY2b7IRlDSyfmcLytuMs+DA== +MIIDGDCCAgCgAwIBAgIBADANBgkqhkiG9w0BAQsFADAfMR0wGwYDVQQDDBRyZWRp +cy5jYS5leGFtcGxlLmNvbTAeFw0yNDA2MTcxMzE1MzNaFw0yNDA3MTcxMzE1MzNa +MAAwggEiMA0GCSqGSIb3DQEBAQUAA4IBDwAwggEKAoIBAQC6YjcRhT/CWKdXQXIZ ++qee0UPul0gw+QHPcc8MHsO06bDN8y40//sa2/5fhp80SkFCZSlT99tCBBO+M8Nx +ALADOGvl01aOL9LY9O2nXkya6/6DkIsV+GssBtC1OIBOiSrHfHy+C7ICbV1Ax5Nk +HWEXpkKc8kAZo3ETDqXzCoYq+01qgb12RBBwQxz0yxHDOZcfXFaffIM3+Wv7XnHp +RT22tWJuw7h5TTxx9u1dhZKBWERa2kVUhA6/Ihk/zCpASWbRwOf355jTNAuO+pQT +mXFDwr+/JcenBiwCQzxaTFkUDPwy0UvhrKvK6WsXuySNO6QNFZXPyuus2IOlnXd0 +8+vBAgMBAAGjfjB8MB0GA1UdJQQWMBQGCCsGAQUFBwMBBggrBgEFBQcDAjAbBgNV +HREBAf8EETAPggdyZWRpcy02hwSsFAAkMB0GA1UdDgQWBBR6J2P3AJJ/LRcvVhcE +nrAvvFDyqTAfBgNVHSMEGDAWgBSHldnboqMeE+DY2VnBYEYkuOMuODANBgkqhkiG +9w0BAQsFAAOCAQEAtt28vPDd4DnT9/vIfIAR0xdLVrw6EGBqrsDtGHbF+0SJ0GJA ++2DxQazJGGgBYXqfjZz1+yBImHP3Rio8+gdU84C+K3CKsa6k4N76f2Ym85FrOOjY +nMNVhdPSdlFptq67euCbSJc9fzXE6Aq73Zm9dRtsLQVmYOAMOkw6EPXNLrwVRaCP +FUswJctD0RcRareRsgiDVgRXfPBzfuxMYMYNwWNcQ6R9dL1r0db4O3Py4L2GkB3o +ukPcoemA2FA1ExA+shzzXBIBr2aK79VkaWPzoUuY/TeRmqdxKeDiaFT9F2eUCdez +FbId94n/8E69dSSCtmbEwwQMsxgMxALZEFustA== -----END CERTIFICATE----- diff --git a/deploy/dockerephemeral/docker/redis-node-6-key.pem b/deploy/dockerephemeral/docker/redis-node-6-key.pem index 44d74245715..a214d2d810f 100644 --- a/deploy/dockerephemeral/docker/redis-node-6-key.pem +++ b/deploy/dockerephemeral/docker/redis-node-6-key.pem @@ -1,27 +1,28 @@ ------BEGIN RSA PRIVATE KEY----- -MIIEogIBAAKCAQEArky8eJPNGRVXh8+lhWeN/4RKMPdW44fWVCvkWJDIkHMu1qH+ -3h8Qx9Msqbex+h9l71xT5bWe6PxY81v6LF3+FOXkO+FuIwYYSCAzUj6pfNMyQB9B -Iix96er8Sp6WzqC8jpUZFvcQ7dIfQqlliXogzbvRQQhHMeT2zzueAxwn+8S2+Y5a -xhYsATinU+xBD3xZ2ParsdeWeMCkVfOfcewWca0K+oawAcVod4r+2rBmlipW8sYZ -S/6bvAVIT4dVHFvPtiRqtyVR7oY8uOJ2R0Ko7ddOp+xUjgpzb9VgdV4unC/ysIAK -ZQl+Fd8G64jFJXr11chRd3n4oGsuGv+4jFzkFQIDAQABAoIBACeZJWRbZ8ggEh+3 -rAoPybHYMybGuoW8sZOz2Q/J7NbsZCK88PMzqZNMRaRVKGkDwxvLJQBV78FMu0Sm -i8KSpAvJYr277FKmqtOQBTjVJZpHPO5Wa2zBIOYIzcKCHw7Yc54M/4M5JC5zg0iY -xYmjJlq3JcYZhFswgmX4TGC2f9rxqMZYxmccVqniSV4vpMU/u8KQcCa1QlW3lmUP -fvNUmqtnclbGDCVWNDuOw876Qh/JiEye63m4RuKN7uAecs8ZhmD2EtmguiTaPMrj -lWPyUSKswbRIgwnJm9fAJtuIlAu33MwZVGYzz/KPB7n94Qknuszxg1a571UDnvWm -SYskM+0CgYEA42TvDjRJ4oK087Oi7UKAfiSPp9PB0E0QrdE4HrKVRJZY59NPslSB -zNaSP5tuSkruOQX/SpW9QTE6TpB0KMj7HfI/W5gYKdOxUh4FBsrG2fdNpV16DjbO -Cco1gFMqFJyhpfwiMCURI3TAZ2LZxVSMMaBqGA6HsmIlmg1FZkAVLIcCgYEAxDnu -otVSqUt3dIz+o0XUwlasz189FCDSeB1u8DOGpzc6YqEYgez6io8xdqRFccOUssl9 -rh5VkDUMzbqmhq/6c4PSj8nUGBHz/e3AFKixtb1er+1NpW9h3gsjLMWxXcnplyM7 -D4q1WMiC4Dv0OLFnMXs4s8rB/i86WeYx3grpzYMCgYBIKbnrqhBgf9ZpGHL2FIqu -fW/RdNQnBK3sW18R7t6L+6KPP3IlR8hBdz7GTM89aHYdRpfz1X1P+Q1l7VXPs6ht -onkU2jmg3HuDcd9qfmOIvIC5n+aiKCZO2QsNhFbwX5y1DkTTPpAnzl9Y7/foNaKg -BSZmKAZMR/Vi5B9ICcIudQKBgA4HCi0vzMn3cCGv1qA7ZLtD0PS+HTKsKf+WMxEO -zeh0RUM5uvPGyh5PoDyX/7LjRWUGjGp/FqTJdhHa7v6f4+qQGORYjEXwOp4DegDA -EnwofnVbJHrYHInwB+Kyezx2K7G3PgidZNtk8h4viwTmgbcC1QndS8LtA2Hb1+LE -qvQbAoGASwIG310GGjFhRI7XwBL7zSmlrx5UncM17vEV6PKeYbr6tc4eS7ZFOXZP -HeQiyvbTUc+44k00AVfI8R64BdJnRAkriTU83P0bP9xbfv9+/Rp6aQDZl14zvXcr -We6StfbmHH68FblHFhERA+HtVSYpyC8ha4EIjipgFbl7zPbSmSg= ------END RSA PRIVATE KEY----- +-----BEGIN PRIVATE KEY----- +MIIEvAIBADANBgkqhkiG9w0BAQEFAASCBKYwggSiAgEAAoIBAQC6YjcRhT/CWKdX +QXIZ+qee0UPul0gw+QHPcc8MHsO06bDN8y40//sa2/5fhp80SkFCZSlT99tCBBO+ +M8NxALADOGvl01aOL9LY9O2nXkya6/6DkIsV+GssBtC1OIBOiSrHfHy+C7ICbV1A +x5NkHWEXpkKc8kAZo3ETDqXzCoYq+01qgb12RBBwQxz0yxHDOZcfXFaffIM3+Wv7 +XnHpRT22tWJuw7h5TTxx9u1dhZKBWERa2kVUhA6/Ihk/zCpASWbRwOf355jTNAuO ++pQTmXFDwr+/JcenBiwCQzxaTFkUDPwy0UvhrKvK6WsXuySNO6QNFZXPyuus2IOl +nXd08+vBAgMBAAECggEAEori36NaDIO1YkDokR0Wv/4hvALg875SJ8kyyAnnfoAh +Ttv6pNsyqCFq1SYXgKRCidB2pBvsfEzbifisYPmoiSl70omL+ulXGK6FVjlTdbY0 +w/IFZFIql162NNFCMo4C64W/A0k2lHc858zzJOqnVir8RZD0P5i7DyJN8DgD0RKz +uDpulugDgHgWuyfhkve3rmN8RAJkFiSlyJJCKPA1YoSdKrUmqwjZ9WJfV8UrUPPC +PoEksVEiLB0NrE2X0CtcSRuSZV0JDDciCLiCHkwDSWRgLzWnE7ECa8BNgdz+MyUH +WQjAoG5ZNP/9pPtVb2yyHqrC7ekc0wZyzahgiKb+gQKBgQDp8cMdHxf4kBwcJIXq +69OB1/0BwnXs0nXVaWQycy2pEFRC6CGfXkUEG9nT/nnHiQyD2ENcjgR9ATFe4Tx0 +CRfB6LQBmpsBK3fidYyBIUqDypMmrzFfc0Kj00o2v8TlO6bj2cFxYwWiu7VQ4E6i +ACmWfi5Aww+yCVPxzKgbAdkULQKBgQDL9JOjvkFbtFmbOn5yvoiIAOMnVlM6BvAd +vzUxg9Hp+xxYaBLPSEhqqc+kcCUdVzGOKeCZheB+D6OzZ9tAMqv46qBk6gsBdhk0 +uieaD5gNnVJm+l2ziTLNGdIF1StqaqXC/GU58BYqiajZABoePdS9pGK3BprDr1NW +8pcy8laOZQKBgGa3fuq/Zz/8zkrRAnemOcSt9+mY3zwvIAum7ZZ1Gdw8TjLeRzz5 +ICZwsBCzj/a7RuJwxwrRVEkqh+nXzTpJb8P1D2wQ3PQDiOzGnf1oh5YcEMYQcAYv +zleuAszNIH9h1KIATz4gsy3DaxXqlrvshFYOavKGctLB47isGjdZdV21AoGANh2d +8utvUhLHV82scWumtFdv7icUjCf9HBd42Lt+PhQX0ElE/GTUeiC2bI4o+uEA0BTC +eFmyWCB0Mg0TerQ3NyOiDUSgSPH5/CiMi28pzCr7C0HRDOsRZKQ+Orf1/hVwCA2K +GlZeu0itWW6Sf4WuZecxHhkNhXCGr2JMxgLQ/pUCgYAYw3Zvvs1C88geKyugdjtA +RIHPrkU5iPk7N+lr3Fb7HQft063f+ejuUIR6RJUUQsAf1OCsYK2AT9xd6JqAfpZA +AhDHPd8lMy1mepqG7MscICH31pFdLjfyBP9z/aktVgzDgQ5c/VbTxrW/+Zm6vQUC +JAeAbzN4IggEBDj6higxWg== +-----END PRIVATE KEY----- diff --git a/deploy/dockerephemeral/federation-v0/integration-ca.pem b/deploy/dockerephemeral/federation-v0/integration-ca.pem index df568861a0e..304fc892245 100644 --- a/deploy/dockerephemeral/federation-v0/integration-ca.pem +++ b/deploy/dockerephemeral/federation-v0/integration-ca.pem @@ -1,19 +1,19 @@ -----BEGIN CERTIFICATE----- -MIIDAjCCAeqgAwIBAgIUBYyNbkD7QQIo+K40IXL+UuYmaEMwDQYJKoZIhvcNAQEL -BQAwGTEXMBUGA1UEAxMOY2EuZXhhbXBsZS5jb20wHhcNMjQwNDI5MTI0NjAwWhcN -MjkwNDI4MTI0NjAwWjAZMRcwFQYDVQQDEw5jYS5leGFtcGxlLmNvbTCCASIwDQYJ -KoZIhvcNAQEBBQADggEPADCCAQoCggEBAMXiU6bohYYGxQANCiN+0Xup4SnfFHLl -2d0ioAZcXo/pEbOoa8QP+ovCzN2IYUx7sOZ90fwyZT91c9g3++/z3QE2nSZsmsnu -dMKUaRn5EKkb0CESfKR3faMjvDuiXZm7YOIGE3XdpyHKs6HzNTz8Us1Ze9U+U16z -jjC+h12OZxYdI7GX4rqR4U9GZc+bu6onbc/gIb1t6CT44Y020SMbFb1Tu4ukZY67 -AbuiR+Ja2ILH9f5UEyUjS6lXHbeJVmO4RZi+J91O7MPE/MCjgk2+RK84d8Uv+PrM -V0sZxkTVnhgKH5QGt0a2XhN1EME6wcDKINMSfb/n/dDmSPqqWa4j2hcCAwEAAaNC -MEAwDgYDVR0PAQH/BAQDAgEGMA8GA1UdEwEB/wQFMAMBAf8wHQYDVR0OBBYEFAg4 -MuTnP5GWVyzC1y/L0dIti5y8MA0GCSqGSIb3DQEBCwUAA4IBAQBledBrBHZ10aUW -yxY/5Gj/pXiiZoyeTF3esxFUM6cGEyXpetk7SWAmIkVp2q+7uO9r94D8umXGZJhQ -nOPkNlWggrSeDy5U5akdhiOrLt+r4bZPKdNLLeiJKd94vqS9Opq51YBq4FC/8MxK -fRf6/zPjMMqZjKudlFniwxeg6CHghMqERzL66EZF29/hb1O8AFGC+J5WioA5+Cbj -se9k2mWbm+F7BjMUW4n4Fz2YR3SGtSZ4h8vzTsBmLSn4GsmLuoHZ1ccSDY/WoNDs -sSyEAr4dGN+e4pV5Uyu5h5bg/BZt86w8psbK5Z0dxTrmSC74E/hKF9JNwxK4iuV+ -4RaUWHE2 +MIIDEzCCAfugAwIBAgIUQ35aUV70pJjvDTbfgFUj5YmchHQwDQYJKoZIhvcNAQEL +BQAwGTEXMBUGA1UEAwwOY2EuZXhhbXBsZS5jb20wHhcNMjQwNjE3MTMxNTMxWhcN +MzQwNjE1MTMxNTMxWjAZMRcwFQYDVQQDDA5jYS5leGFtcGxlLmNvbTCCASIwDQYJ +KoZIhvcNAQEBBQADggEPADCCAQoCggEBAJQlUOLNmd7Ll7iskcSnsv9xcx/+TnMw +qtqkK17w54/Kto+NJJAkD1L+X5EkSPZ7FDKqt2bGfoETWGnlpH/zsUTUpchlf6Jf +w6TJOejQer5FQNLCtQSnOIchlAFKzFxhGSvcOrRWiBAPjTVIkv9eiCNXcJ5PE9Sk +8+bmn2ztz7LVHcv46PmT/+ihRxKJ01T5CsXWPUHOZQRfGvKZmyGf+iTBuhcxMPYC +nXb7/M3rYCQXL8FQZiaqbIVMqNRpMBVkAqU3l2JnSrlNIjIh6Nqowjog8QYGuIz6 +fxwWkw6EU5ZBwHIr2rOakCnQoKeXVqBJdWZNRMX1Vtqeh7O9zDoW4/0CAwEAAaNT +MFEwHQYDVR0OBBYEFHNgZ4nZQoNKnb0AnDkefTXxxYDqMB8GA1UdIwQYMBaAFHNg +Z4nZQoNKnb0AnDkefTXxxYDqMA8GA1UdEwEB/wQFMAMBAf8wDQYJKoZIhvcNAQEL +BQADggEBAIuLuyF7m1SP6PBu29jXnfGtaGi7j0jlqfcAysn7VmAU3StgWvSatlAl +AO6MIasjSQ+ygAbfIQW6W2Wc/U+NLQq5fRVi1cnmlxH5OULOFeQZCVyux8Maq0fT +jj4mmsz62b/iiA4tyS5r+foY4v1u2siSViBJSbfYbMp/VggIimt26RNV2u/ZV6Kf +UrOxazMx1yyuqARiqoA3VOMV8Byv8SEIiteWUSYni6u7xOT4gucPORhbM1HOSQ/S +CVq95x4FeKQnbEMykHI+bpBdkoadMVtrjCbskU49mOrvl/pli9V44R8KK6C1Nv3E +VLLcoOctdw90aT3sIjaXBcZtDTE6p6g= -----END CERTIFICATE----- diff --git a/deploy/dockerephemeral/federation-v0/integration-leaf-key.pem b/deploy/dockerephemeral/federation-v0/integration-leaf-key.pem index a429e5651d5..1e7a83068de 100644 --- a/deploy/dockerephemeral/federation-v0/integration-leaf-key.pem +++ b/deploy/dockerephemeral/federation-v0/integration-leaf-key.pem @@ -1,27 +1,28 @@ ------BEGIN RSA PRIVATE KEY----- -MIIEowIBAAKCAQEAmSV2VmlVfsqBNCk/EoW9aN71BGRgVhF+zTojHf/DgPv94jH5 -/IjpNa5yfmT5M0invDwGJQOI3z3sz8kOdg7FvZtrhcyHACDl337gwRPy28hWELbj -IjmBOE73ck5B0dYAsqFnwxpDiepqfHlou+oL5osTerI93pN9IALjYpTZuhK+BPeZ -zlzNLk6VbVqQhd3aaVOJg7VVWPZkCdTRwP10ijPJQVgG42uM3X9BXhYmZk0yN+4M -MNKQ+P+jTL3PguqS9DKC3ObN6OvfOsuZGZaFjVtHnwW4NtiRB1E2nbcK3wgE7r9L -pgW4LSw86gQxhHcMQi1GxnWy1yUg9DJAcQkGwwIDAQABAoIBADc2HUqb4Pm78gan -FBkOZDHJp5W0xlJhLlC4s+5dxdLbhjUlBVX42fLDeH1+06ScffRLw39WneK1xYlH -l9ISE1H/FS2Ahe8S7Sy85jRVh8mamQSfmpU9HAv71BO+iNYoi8najLj24AB5pXhI -oOyWPUIZQ6WJWurCS2rd/7ILrc754gjEmPayiGXdvJhgOcjDzK65XhzTcaoocNRV -Z9/48udPFvhYKqIaHxQU/XIVwTxDQgmMnY08t7DNwRygknWFXsMxbHnIh6QztVM9 -KrFo4lXt2CgIp/vGe588iihD2QAoyhJGdc09n0dPBOY1F7djEnR4mwVg2wuGiiMJ -jTnD37ECgYEAxYaanwd6H62xlpuzktpd/cy8tJvRcSljkP//Ks53yI3jmWoyM+dx -DKarQIVRch0sIHYKV4oxvtoHAgHTTIMhldY5xTnqvvJXv66fCh3ZLcyXxfuPqK+k -7uZ+mYgvK6McB5AT3xiHTNcW6DD1706xt3ZdzqsjY3bydXjdNtEEHekCgYEAxnuV -JABIw8DXkJIr73RU8zgBu2402Ho52NOoHvaWU5908nzTQBnt5c/1lhaMN7Q07UGS -166ncRkjGrpWH+aS4t5TEMALT0LoZ0l9YMP8qmeks46Vg8BMI06ORcnC2CigeklZ -7sWPiHYvM+w1Rsm/X6hmmiPLvq4jl1KCUIEud8sCgYA4GhEUlhUTpkvIURTh4u/L -RDlcutzz3SOQbYVV7SqMZfB9BHKZ12R+iWAehT8qwCpmVeB+GJwkbtyKr2YKVzxU -yHHEGL0Z2s8dfEVjpDKpFXEOJHMbIDgiOok+pjVvmXY+l6dtOBRFuNmivTU88Qb8 -6rueFXGJsKEQyHFcPmWC8QKBgCY+odoyA9NUUTUWNUkKjWPgItVOwvgDdSoGfpqY -wRaT3yDqVHpBhMmHbLbi2VnSa3Bb9kOA79qnEVCRHw8+iocUd8T+fC9loQpl6ra+ -jOz404+VpdGhOAqFlHx2CAlGqsVlZOLRRnrw6t+CYDGnpix0cnC4/QVc4JbD20BP -4/hJAoGBAI7qa8SEcucrq28c8/mUmi+45AkCOZmmPtp31TtFoSlwkTBmAtp4+OSk -76mH5vb2kwJDWgzlmb6nPry8wPFfKQbG4NlBLbovQyc2lJtPGNOSrwboZSIcyClx -lcmE9AcCOuCBhqH18z0nE7nPQXy4IHjHBta7zEJCw+pGxCJh42ke ------END RSA PRIVATE KEY----- +-----BEGIN PRIVATE KEY----- +MIIEvwIBADANBgkqhkiG9w0BAQEFAASCBKkwggSlAgEAAoIBAQCZjOHeUnlauuxD +WgrRnh3hj5Fs+uh9vyddMX8rSWJIbWFw4QuYzYKY8CQa3MBb6qK1uUwoJ0W1w47I +RgA5VLvGxI+T1wX8E5vljVgfT3CAXHKRB88NrT8A1urQnWpzlq5sNerL6dqgBrjG +QBmFF7NxrvjGgerC2D8+srWfpQ6Jbl9by8c3JDu+T79PM+pW9ycUgdF1AJQBTz9K +zNQ7ZTlBQvJG8WhTMKioJgQsE60oEXD0C8M5yKBBb7DrqkeZInXqCw2y7DZLWzog +D+jgoAD5/9sk3d/gGNqDibzjjwMiJnH/IqBTkZsQ9OdZZPfx5v/p062hQBlM656P +2jMpJ1xxAgMBAAECggEAS3NBjWgDP4T4EUROaqACWNKeB+nmkdt68T0gGtoNVD+D +EN9UPnpFQPdHFngAgWnzF858UIKzq1Pzdg+HjqRHPK1bS67tvua3xP1GHuR/CGPk +28T1hefqPHRen7GqHDAfdwarYBWCGv4Sjz/yCkcSIrtyfMBb5fAya5GO02pckUSK +19sl7XhkPtHJVirRkjQL29R2TCpkNNpQMjkuYLk7mox+6pNTbxgbk0cnT3eGj1pV +mlPqpwzC5GevRziE/VE/WXFLChY+8KB4fDLRqWnyvabDvQ4coaXgzwbdScJyM5hX ++Dxdfni/P2m7xAZXUyfBsr0VUzqUkJfK3WWvvAGTDQKBgQDNi3RUEjVnU/MN4aDz +iZB2VYGfo/K69xTPNEbLQWs1F4ZMpHVtUVXzTfx/xG9ug989ijEm6ncL9OsnhThn +UldSz2ojSJUxLmhgCHZGYHT72v/9rEqfT9JisWpIj44KXufUHCcl3Cozj1ae3EUp +NVhN1HphB2LsCIJvLYfLIGdBNwKBgQC/PhHQMm/MQe4pOHAbdzDrRZWdG2KSRVxp +9mmJ/aT8LOp7BDjq+Dkct6a56JGqlOTeJirMTTmCKiOiTInuB9S+K7kWJJiYg9g4 +UCiuMU+40Px/1Z4/uxRj3DSdGLXG7S6kPeADx9f9BUNpAytGqOnSnfbDiDVvQVbp +0N0+nIXDlwKBgQC2uZOXrXxGOE4pd/ySpCeF2yvZ1HDTnxWjwlBxHt4Em74rYkR2 +A0mKezjOCL4bHCaYWcKqWuOsAHYQcxEaYQv6NSOg7ESdLSlivgMPO26j+yN5yvGn +wNlCHYBjsyLNu2MSoFh5AsmNfo69uQnOwXqX7h1BJsTdGg+CcJJ4lHzWbwKBgQCD +/CRzGbwKrh3eGPNWIUaDuTxudy3qYTBMeSGReJpa5+zUBa/6imFwLldEyvttTOE/ +Z/v1j/52lPqO0mAHBSSQMsDERXGDIMsi4j+RKLsqhCEfYKCcv1JtMNam7RzXM24T +MBjgwxWPrAg/+03ssDrffuGFRQYLyH5hVCK9SW0P9QKBgQDJ1ZSto+RWxv/uOKNr +7FYeQoKpMb2IvNvnGlnYHC8KS9qRq6wUE+FtuKcdLBQP4M9Cgq71VD/dsawrhEw7 +1rAYk3OqmHxBOU5Dcb152NxYHEf53pfEfWc0x4AEVe+Jzynj2EYixRKNWwODNTEx +LKJOYd0CuWywxg6d9G7A7XbgWQ== +-----END PRIVATE KEY----- diff --git a/deploy/dockerephemeral/federation-v0/integration-leaf.pem b/deploy/dockerephemeral/federation-v0/integration-leaf.pem index cb0b495b92a..635d332de70 100644 --- a/deploy/dockerephemeral/federation-v0/integration-leaf.pem +++ b/deploy/dockerephemeral/federation-v0/integration-leaf.pem @@ -1,21 +1,20 @@ -----BEGIN CERTIFICATE----- -MIIDcjCCAlqgAwIBAgIUf1Euc5flsS90XTspZ7RXONZm8DgwDQYJKoZIhvcNAQEL -BQAwGTEXMBUGA1UEAxMOY2EuZXhhbXBsZS5jb20wHhcNMjQwNDI5MTI0NjAwWhcN -MjUwNDI5MTI0NjAwWjAAMIIBIjANBgkqhkiG9w0BAQEFAAOCAQ8AMIIBCgKCAQEA -mSV2VmlVfsqBNCk/EoW9aN71BGRgVhF+zTojHf/DgPv94jH5/IjpNa5yfmT5M0in -vDwGJQOI3z3sz8kOdg7FvZtrhcyHACDl337gwRPy28hWELbjIjmBOE73ck5B0dYA -sqFnwxpDiepqfHlou+oL5osTerI93pN9IALjYpTZuhK+BPeZzlzNLk6VbVqQhd3a -aVOJg7VVWPZkCdTRwP10ijPJQVgG42uM3X9BXhYmZk0yN+4MMNKQ+P+jTL3PguqS -9DKC3ObN6OvfOsuZGZaFjVtHnwW4NtiRB1E2nbcK3wgE7r9LpgW4LSw86gQxhHcM -Qi1GxnWy1yUg9DJAcQkGwwIDAQABo4HKMIHHMA4GA1UdDwEB/wQEAwIFoDAdBgNV -HSUEFjAUBggrBgEFBQcDAQYIKwYBBQUHAwIwDAYDVR0TAQH/BAIwADAdBgNVHQ4E -FgQUv8i5VPBWRk+7SbQoK3bsYK4VwncwHwYDVR0jBBgwFoAUCDgy5Oc/kZZXLMLX -L8vR0i2LnLwwSAYDVR0RAQH/BD4wPIIZKi5pbnRlZ3JhdGlvbi5leGFtcGxlLmNv -bYIUaG9zdC5kb2NrZXIuaW50ZXJuYWyCCWxvY2FsaG9zdDANBgkqhkiG9w0BAQsF -AAOCAQEAamTOVMoIb6s+q2IT/zgR/UbkRFlTAsGo7mPIgfgC0D8FkJgLJwYA3uz1 -ZEQ0XRbnmsFFeTdPYya4TOz1E0ZsA4tgK0DOJgPTRfP+DOiplFMDPCrgHPkHQGOd -LDSzQv+GrlSuYUuFxLFXXYZwWzxg5Tv0UgcL+i1wkVBSkwsUvtUkKqqOAjG1cZpI -Mc4VtMAYh5NaBb7KfCo47srRMQfg1SKiGmG65LRUJHGHoVc5PNohz/sbfef/WC0W -haih/68v9qVF/8Xmvy+XKUk5t4mHwpxu1foPCBdMDAU1Udk39VZmYNBbycp+2dt6 -BOe3K9zXlCS8KnJOVLoe9nxsWOAsgA== +MIIDQTCCAimgAwIBAgIBADANBgkqhkiG9w0BAQsFADAZMRcwFQYDVQQDDA5jYS5l +eGFtcGxlLmNvbTAeFw0yNDA2MTcxMzE1MzFaFw0yNDA3MTcxMzE1MzFaMAAwggEi +MA0GCSqGSIb3DQEBAQUAA4IBDwAwggEKAoIBAQCZjOHeUnlauuxDWgrRnh3hj5Fs ++uh9vyddMX8rSWJIbWFw4QuYzYKY8CQa3MBb6qK1uUwoJ0W1w47IRgA5VLvGxI+T +1wX8E5vljVgfT3CAXHKRB88NrT8A1urQnWpzlq5sNerL6dqgBrjGQBmFF7NxrvjG +gerC2D8+srWfpQ6Jbl9by8c3JDu+T79PM+pW9ycUgdF1AJQBTz9KzNQ7ZTlBQvJG +8WhTMKioJgQsE60oEXD0C8M5yKBBb7DrqkeZInXqCw2y7DZLWzogD+jgoAD5/9sk +3d/gGNqDibzjjwMiJnH/IqBTkZsQ9OdZZPfx5v/p062hQBlM656P2jMpJ1xxAgMB +AAGjgawwgakwHQYDVR0lBBYwFAYIKwYBBQUHAwEGCCsGAQUFBwMCMEgGA1UdEQEB +/wQ+MDyCGSouaW50ZWdyYXRpb24uZXhhbXBsZS5jb22CFGhvc3QuZG9ja2VyLmlu +dGVybmFsgglsb2NhbGhvc3QwHQYDVR0OBBYEFPowAfmLPCmdCMdSxQjsR6UQSoyH +MB8GA1UdIwQYMBaAFHNgZ4nZQoNKnb0AnDkefTXxxYDqMA0GCSqGSIb3DQEBCwUA +A4IBAQCMJwbLzUsrkQkgdGKVi/Mb5XAAV0sfkwZch1Fx0vhJI072cZSow5A2ZUHa +LScFNTPmilPKEr6MS4xIKtRQaMHInbfxSsyNViKhpzkSOKoAiJjIJ2xPKFPnbTDI +uV74nxxyf9q/p3SLQfJFk7fxbvNeLqg5bYSrMeklHj4bpMJ9fybS8/mZVc8AkTFK +fsXSu9CW1B3GF+jP3E2GrFF3Zh9MgvWjMlSYg4ljPf5FoMCUq6GmQ17hQeJFvb5h +Jqk6TcgUrp082bcVlPW17XzFwVe3n6uzvWMtwI62EztVUj98+YkBiFL3i4+OQwAU +/noc22fq20OyJtCPJY4FIK7xUcgD -----END CERTIFICATE----- diff --git a/deploy/dockerephemeral/federation-v0/nginz/conf/README.md b/deploy/dockerephemeral/federation-v0/nginz/conf/README.md index c8e81957c62..8e614e99d1b 100644 --- a/deploy/dockerephemeral/federation-v0/nginz/conf/README.md +++ b/deploy/dockerephemeral/federation-v0/nginz/conf/README.md @@ -3,5 +3,5 @@ Run from this directory: ```bash -../../../../../hack/bin/selfsigned.sh +../../../../../hack/bin/gen-certs.sh ``` diff --git a/deploy/dockerephemeral/federation-v0/nginz/conf/nginx.conf b/deploy/dockerephemeral/federation-v0/nginz/conf/nginx.conf index d67bc039716..cd4ec97a1a7 100644 --- a/deploy/dockerephemeral/federation-v0/nginz/conf/nginx.conf +++ b/deploy/dockerephemeral/federation-v0/nginz/conf/nginx.conf @@ -125,7 +125,7 @@ http { server { include integration.conf; - # self-signed certificates generated using wire-server/hack/bin/selfsigned.sh + # self-signed certificates generated using wire-server/hack/bin/gen-certs.sh ssl_certificate /etc/wire/integration-leaf.pem; ssl_certificate_key /etc/wire/integration-leaf-key.pem; diff --git a/hack/bin/gen-certs.sh b/hack/bin/gen-certs.sh new file mode 100755 index 00000000000..65d278fcaa8 --- /dev/null +++ b/hack/bin/gen-certs.sh @@ -0,0 +1,80 @@ +#!/usr/bin/env bash +set -eo pipefail + +# Create certificates needed for running integration tests. + +SCRIPT_DIR=$(cd -- "$(dirname -- "${BASH_SOURCE[0]}" )" &> /dev/null && pwd ) +ROOT_DIR=$(cd -- "$SCRIPT_DIR/../../" &> /dev/null && pwd) + +TEMP=$(mktemp -d wire-server-self-signed-XXXXXX --tmpdir) + +cleanup() { + rm -fr "$TEMP" +} +trap cleanup EXIT + +# usage: gen_ca root name +# +# Generate self-signed CA certificate and key at root/ca.pem and +# root/ca-key.pem respectively. +gen_ca() { + echo "generating CA: $2" + openssl req -x509 -newkey rsa:2048 -keyout "$1/ca-key.pem" -out "$1/ca.pem" -sha256 -days 3650 -nodes -subj "/CN=$2" 2>/dev/null + +} + +# usage: gen_cert root san name +# +# Generate leaf certificate in the given root directory. Assumes that ca.pem +# and ca-key.pem exist in the same directory. The generated certificate and +# private key will end up in root/cert.pem and root/key.pem. +gen_cert() { + echo "generating certificate: $2" + subj=() + if [ -n "$3" ]; then + subj=(-subj "/CN=$3") + fi + openssl x509 -req -in <(openssl req -nodes -newkey rsa:2048 -keyout "$1/key.pem" -out /dev/stdout -subj "/" 2>/dev/null) -CA "$1/ca.pem" -CAkey "$1/ca-key.pem" "${subj[@]}" -out "$1/cert.pem" -set_serial 0 -extfile <( echo "extendedKeyUsage = serverAuth, clientAuth"; echo "subjectAltName = critical, $2" ) 2>/dev/null +} + +# usage: install_certs source_dir target_dir ca ca-key cert key +# +# Copy certificates into the target directory, using the given file names. If a +# name is empty, the corresponding certificate is skipped. +install_certs() { + if [ -n "$3" ]; then cp "$1/ca.pem" "$2/$3.pem"; fi + if [ -n "$4" ]; then cp "$1/ca-key.pem" "$2/$4.pem"; fi + if [ -n "$5" ]; then cp "$1/cert.pem" "$2/$5.pem"; fi + if [ -n "$6" ]; then cp "$1/key.pem" "$2/$6.pem"; fi +} + +# federation +mkdir -p "$TEMP/federation" +gen_ca "$TEMP/federation" ca.example.com +gen_cert "$TEMP/federation" "DNS:*.integration.example.com, DNS:host.docker.internal, DNS:localhost" +install_certs "$TEMP/federation" "$ROOT_DIR/services/nginz/integration-test/conf/nginz" \ + integration-ca integration-ca-key integration-leaf integration-leaf-key +install_certs "$TEMP/federation" "$ROOT_DIR/deploy/dockerephemeral/federation-v0" \ + integration-ca "" integration-leaf integration-leaf-key + +# elasticsearch +mkdir -p "$TEMP/es" +gen_ca "$TEMP/es" elasticsearch.ca.example.com +gen_cert "$TEMP/es" "DNS:localhost" localhost +install_certs "$TEMP/es" "$ROOT_DIR/deploy/dockerephemeral/docker" \ + elasticsearch-ca "" elasticsearch-cert elasticsearch-key +install_certs "$TEMP/es" "$ROOT_DIR/hack/helm_vars/certs" \ + elasticsearch-ca elasticsearch-ca-key + +# redis +mkdir -p "$TEMP/redis" +gen_ca "$TEMP/redis" redis.ca.example.com +REDIS="$ROOT_DIR/deploy/dockerephemeral/docker" +cp "$TEMP/redis/ca.pem" "$REDIS/redis-ca.pem" +for redis_node in $(seq 1 6); do + gen_cert "$TEMP/redis" "DNS:redis-${redis_node}, IP:172.20.0.3${redis_node}" + chmod 0644 "$TEMP/redis/key.pem" + install_certs "$TEMP/redis" "$REDIS" "" "" \ + "redis-node-${redis_node}-cert" \ + "redis-node-${redis_node}-key" +done diff --git a/hack/bin/selfsigned.sh b/hack/bin/selfsigned.sh deleted file mode 100755 index 644eb1a02e1..00000000000 --- a/hack/bin/selfsigned.sh +++ /dev/null @@ -1,133 +0,0 @@ -#!/usr/bin/env bash - -# Create a self-signed x509 certificate in the current working directory. -# Requires 'cfssl' to be on your PATH (see https://github.com/cloudflare/cfssl) -# These certificates are only meant for integration tests that explicitly disable certificate checking - -set -euo pipefail - -SCRIPT_DIR=$(cd -- "$(dirname -- "${BASH_SOURCE[0]}" )" &> /dev/null && pwd ) -ROOT_DIR=$(cd -- "$SCRIPT_DIR/../../" &> /dev/null && pwd) - -TEMP=$(mktemp -d wire-server-self-signed-XXXXXX --tmpdir) -CSR_FEDERATION="$TEMP/csr-federation.json" -CSR_FEDERATION_CA="$TEMP/csr-federation-ca.json" -CSR_ELASTICSEARCH="$TEMP/csr-elasitcsearch.json" -CSR_ELASTICSEARCH_CA="$TEMP/csr-elasticsearch-ca.json" -FEDERATION_CA="$TEMP/integration-ca" -FEDERATION_LEAF_CERT="$TEMP/integration-leaf" -ELASTICSEARCH_CA="$TEMP/elasticsearch-ca" -ELASTICSEARCH_LEAF_CERT="$TEMP/elasticsearch-leaf" -CSR_REDIS_CA="$TEMP/csr-redis-ca.json" -CSR_REDIS="$TEMP/csr-redis.json" -REDIS_CA="$TEMP/redis-ca" -REDIS_LEAF_CERT="$TEMP/redis-leaf" - -command -v cfssl >/dev/null 2>&1 || { echo >&2 "cfssl is not installed, aborting. See https://github.com/cloudflare/cfssl"; exit 1; } -command -v cfssljson >/dev/null 2>&1 || { echo >&2 "cfssljson is not installed, aborting. See https://github.com/cloudflare/cfssl"; exit 1; } - -echo '{ - "CN": "ca.example.com", - "key": { - "algo": "rsa", - "size": 2048 - } -}' > "$CSR_FEDERATION_CA" - -# generate CA key and cert -cfssl gencert -initca "$CSR_FEDERATION_CA" | cfssljson -bare "$FEDERATION_CA" - -echo '{ - "key": { - "algo": "rsa", - "size": 2048 - } -}' > "$CSR_FEDERATION" - -# generate cert and key based on CA given comma-separated hostnames as SANs -cfssl gencert \ - -ca "$FEDERATION_CA.pem" \ - -ca-key "$FEDERATION_CA-key.pem" \ - -hostname=*.integration.example.com,host.docker.internal,localhost \ - "$CSR_FEDERATION" \ - | cfssljson -bare "$FEDERATION_LEAF_CERT" - -cp "$FEDERATION_CA.pem" "$ROOT_DIR/services/nginz/integration-test/conf/nginz/" -cp "$FEDERATION_CA-key.pem" "$ROOT_DIR/services/nginz/integration-test/conf/nginz/" -cp "$FEDERATION_LEAF_CERT.pem" "$ROOT_DIR/services/nginz/integration-test/conf/nginz/" -cp "$FEDERATION_LEAF_CERT-key.pem" "$ROOT_DIR/services/nginz/integration-test/conf/nginz/" - -cp "$FEDERATION_CA.pem" "$ROOT_DIR/deploy/dockerephemeral/federation-v0/" -cp "$FEDERATION_LEAF_CERT.pem" "$ROOT_DIR/deploy/dockerephemeral/federation-v0/" -cp "$FEDERATION_LEAF_CERT-key.pem" "$ROOT_DIR/deploy/dockerephemeral/federation-v0/" - -echo '{ - "CN": "elasticsearch.ca.example.com", - "key": { - "algo": "rsa", - "size": 2048 - } -}' > "$CSR_ELASTICSEARCH_CA" - -# generate CA key and cert -cfssl gencert -initca "$CSR_ELASTICSEARCH_CA" | cfssljson -bare "$ELASTICSEARCH_CA" - -echo '{ - "key": { - "algo": "rsa", - "size": 2048 - } -}' > "$CSR_ELASTICSEARCH" - -# generate cert and key based on CA given comma-separated hostnames as SANs -cfssl gencert \ - -ca "$ELASTICSEARCH_CA.pem" \ - -ca-key "$ELASTICSEARCH_CA-key.pem" \ - -hostname=localhost \ - "$CSR_ELASTICSEARCH" \ - | cfssljson -bare "$ELASTICSEARCH_LEAF_CERT" - -cp "$ELASTICSEARCH_CA.pem" "$ROOT_DIR/deploy/dockerephemeral/docker/elasticsearch-ca.pem" -cp "$ELASTICSEARCH_LEAF_CERT.pem" "$ROOT_DIR/deploy/dockerephemeral/docker/elasticsearch-cert.pem" -cp "$ELASTICSEARCH_LEAF_CERT-key.pem" "$ROOT_DIR/deploy/dockerephemeral/docker/elasticsearch-key.pem" - -cp "$ELASTICSEARCH_CA.pem" "$ROOT_DIR/hack/helm_vars/elasticsearch-certs/elasticsearch-ca.pem" -cp "$ELASTICSEARCH_CA-key.pem" "$ROOT_DIR/hack/helm_vars/elasticsearch-certs/elasticsearch-ca-key.pem" - -echo '{ - "CN": "redis.ca.example.com", - "key": { - "algo": "rsa", - "size": 2048 - } -}' > "$CSR_REDIS_CA" - -# generate CA key and cert -cfssl gencert -initca "$CSR_REDIS_CA" | cfssljson -bare "$REDIS_CA" - -echo '{ - "key": { - "algo": "rsa", - "size": 2048 - } -}' > "$CSR_REDIS" - - -cp "$REDIS_CA.pem" "$ROOT_DIR/deploy/dockerephemeral/docker/redis-ca.pem" - -for redis_node in $(seq 1 6); do - # generate cert and key based on CA given comma-separated hostnames as SANs - # TODO: Its not good to depend on nip.io for running integration tests locally - cfssl gencert \ - -ca "$REDIS_CA.pem" \ - -ca-key "$REDIS_CA-key.pem" \ - -hostname="redis-${redis_node},172.20.0.3${redis_node}" \ - "$CSR_REDIS" \ - | cfssljson -bare "$REDIS_LEAF_CERT-${redis_node}" - - cp "${REDIS_LEAF_CERT}-${redis_node}.pem" "$ROOT_DIR/deploy/dockerephemeral/docker/redis-node-${redis_node}-cert.pem" - cp "${REDIS_LEAF_CERT}-${redis_node}-key.pem" "$ROOT_DIR/deploy/dockerephemeral/docker/redis-node-${redis_node}-key.pem" - chmod 0644 "$ROOT_DIR/deploy/dockerephemeral/docker/redis-node-${redis_node}-key.pem" -done - -rm -rf "$TEMP" diff --git a/hack/helm_vars/certs/elasticsearch-ca-key.pem b/hack/helm_vars/certs/elasticsearch-ca-key.pem index f6dc9c0c2e1..53785fe3292 100644 --- a/hack/helm_vars/certs/elasticsearch-ca-key.pem +++ b/hack/helm_vars/certs/elasticsearch-ca-key.pem @@ -1,27 +1,28 @@ ------BEGIN RSA PRIVATE KEY----- -MIIEowIBAAKCAQEAzDrMEXnLq5Ly9zjWdoOty9lFYHfFR1GDACJm3Gc/Hvz9DcY0 -e/Untv5L1a+ewN4npuFY6o4ezl3+gHmzYekEBsgTtEoAhjnCspj4WrbnAzdorExi -qTBddJlGREQl+SVgtp1Bu5aQWiqWeZfCFsmaYYdDuCaTDvRVG5zz1oO73VX8DOPt -tLeIwdCxRdtW/MMcviWehvDovSPA8FJZqYCDXJrLtTysfNoDUOhMuTNQlDzg4NwZ -uZx+/ZtikI6llyUr1sC6i/GVK9ue6QsD4FpGLsJXqHXCnZklWs9xaUdvMVGqRUT/ -vxuIv0TH97KAM0FYp26t6iyRjpHVcH0/Ykwj4wIDAQABAoIBAGAIkebxz6zJN8i6 -iFZISxQdAbt/9ls34BLTGm0ve4X1zoSInCthtyAcacp8f3kPvbOCKY5579B4cHE3 -SPuUV5lcwa84URDM3lmfBsGZWf2wM185t/b40ClA3cLCDN0gD18viTZNcWmEtydM -Di8q85ZCxbw1H1eb2t1WK27GmTNVIN6VlgyeWJVGdRqhCazS2OJLLy1AaW1hTwFe -7GQoYjO4JG8NhEq73OfubpbFrWKizLRyFfCZK4RuR+s/6/QNItT/jzOz8ZbGzPwT -7NNAoQp0UEDEiyUaFaVeouLvIVWovkYt2yT+ry1SdyUn4PJJEF80p9Hw8TtrzA7h -ToMhjfkCgYEA9I808jib+IR/L/lli+enHzfJkJTaLBbI4N3w4zmdsBsEmKC0+Hbw -LKw2snnum2K3a7GaCFlp+MqUO1HcB796elb+/g1/FVnnVf1dw/GcmU6mcb1fSMyZ -ukfVp1RejJS0tvNmkopDLT5hEBvUEmdPoupS6v0o7MJya5ITHnGcUjUCgYEA1cic -HJY/MOCLWCLhxDjRNlPgcv1ZLgbivjkXp/A7jwdzZDkwk1DiPY2uJpgNcHdXStdc -w4Hyvcb0RtL49739IC6I9KGTqKkBWplhCGosIeWa90vNAA/nz8LAb10GBje/YkuH -ijdQU8LeFQSSzvjHDCe/GpGyO5F5bOMQQlkD4LcCgYBfE/nqnbWNpb1o4lXnUXV4 -vpCfpC856tXIDqEjRfgXSjm8OOaCnoL7ayyMsLjiMjvLI64VxuVbMy7z7PxVCs1M -GNxj2s1oeJ5moO0+S4WtWJV/LLeJrvmpIVpgBn4Hu5yScAiVuikpwtGrmJYXXZDp -bp4z+55YhbREO/Mw58x1bQKBgDdXH/pSdncrmUaueOz3nEjI+7Aonx5IEAgX9WS2 -zmQfFKLcHxPzey1d8Lfy4n+7lPA9wbimefTgfLmcwXA4UT80bKWO8g9V+JDAZZrt -CRGZQz1C9QVQGLzyeCgb14Rih/tk++gum2+jYSPltC85vSULYO/6yT2cUed6++mA -630PAoGBAM0pG5Ncu3eddlOYV34lMoSIiy+4pUcZbECMWPmYV+N9iX3GYTgRbSkf -11YImU2TOEs1gK9iFPcH826HTnunOSzyEgdXX8d7+J1tRf0gofMKu8VqW8sUDPgo -Y4KH/48LJ+k00bt1Dl5g8FTmaKRQF0JrAtlmanTPh5W9aubJpp68 ------END RSA PRIVATE KEY----- +-----BEGIN PRIVATE KEY----- +MIIEvgIBADANBgkqhkiG9w0BAQEFAASCBKgwggSkAgEAAoIBAQC/oFJpJMdyG9FT +pNw4K9f1pdkNikwbQsx4dokiQBMTu89IMTnNfsHz2IDrxCKTCKC3oPupniaEPNpr +YpV6RMz1UPvUYu/IpvOXGeIGlVd9ixcoYN6763R2nZhMlFS8Tma9mV+e/B0jr9Db +V1pUWIPufuPrYXcOotxDO/W5I+GpKVTz/ZGD//O5odX1mJzkwqjeqGa1WNdg+/AL +iDtVZ/YAKGdfjx81uqc16fYuYRDw3BYImBp5MyNu/jxdgNxFB1edcVowvcKXVs5p +Slay2ad0eQSa0Ux8n3RjfisjTLAHks/4dkPa3hQyBYzmxwBhMcMDc06yxiCkXsVn +lXRn9nf/AgMBAAECggEABQZr3GzMSImPaRvqPnrZdFkMb30QVw94YMxS9xf3dOc4 +hB8hi4PNPqf1yx9e/Lx9yNleE1BqmCf0XltWdvKPVJUlrw5TiJwZyGOZ+F9tAB81 +CA6j29YZcFoPoJDfOMghjGVIpNjdqfSC8jP0BXQ3LK22xZLOIw8eqypLKYPvkTA3 +OfuJ/1doiHl+geZkXaKcLSpCCddLKCaWSbLyqYMJxbQ5SSZ9bPUeQ7aQppb5M/wO +1B4+oMmRLcmG81QnL0kU9JiAtYaGsrP22qGuEGVjEZE8RXJz3iQ1KvSlj0xerqi7 +/LY0HLixkx4n3Qtpm9FFaT3rzeDlJIE54qmI73sdYQKBgQDw6KJJIxmQScLZb4ml +yjd+pBvPuUe9cM9KMRNk2C7Z1QMxORXsIbgCPqpkJ96XUquta2ii7rxt/sXAkrh1 +c8IYU3Qp03+585J+6lZF6yaH9TrwYfDCRqKoSgAEwhJlvtoWHSMI6YguWsaczdgH +czd+0OzJl1w4vQqQBuXFwz4eEQKBgQDLoVzk+z/1//CJUfAe/Z6WYFHmTh+M9RGP +vC7GCQVCjIFUNsXqrWLl6DL5UeipYVhqu5eB7vOo/gNnb6J1vMOO0j9e1cY1Q2lG +BdSIHUD7P1Lly1/K+pn2QqIIHp+72H5qsX+8R5Tkln00jwQ0t5DrMVgJvWBW7/GC +lach4BZlDwKBgQDjfdraE8ItJepRJ+mk3GtBNLlqk/0x4FhvKB63SQoc+/Dyx4Rz +Ing/7ms6/wdMgG3L6rS5v5XCjSayrhpwFyr/i7cTVDy2HVOGc8Waau9Mzf+lRedz +nf41ywNvetCisfIBlewim1zU4TXSlvNcPan3IFWqHDui/Kj/zvOlp7R98QKBgQCn +fdi89/TKUXT2XpFVzGLvadazyrqk5MdHJRCMD8tly9BtBoiQ2YEpfm6/KKJpAAsL +77VVSMjezeDa6bYFhfiMt18skEXydbpXwF/qfbV/c7yqCziF6s9NAc3pQ9c7WX3S +IKHiqjZMN4RRAPoCqqLm8bVqfXyKxd4u/Q12Da4d/QKBgByVkmAoFVF1iYkb5b/0 +cPRXMnn5Xw5C6CRWpEwl3dSlt/uVACcFyxKsUP7QDTbqN7DSl/RX6DxkDIR6GBEz +vt0yXsdFx8y9Lzw1TNj2zhPVrtyslX/GFmi0R7/oyTEuVOMNy1rl/wftRqRX90md +JLSFJ4QslRlPwYOWGPDjJZVe +-----END PRIVATE KEY----- diff --git a/hack/helm_vars/certs/elasticsearch-ca.pem b/hack/helm_vars/certs/elasticsearch-ca.pem index f56c3396fcf..f17e9cb41ac 100644 --- a/hack/helm_vars/certs/elasticsearch-ca.pem +++ b/hack/helm_vars/certs/elasticsearch-ca.pem @@ -1,19 +1,20 @@ -----BEGIN CERTIFICATE----- -MIIDHjCCAgagAwIBAgIUSYROJq4Fwdnd/Jfaeyg2Fk6cCKEwDQYJKoZIhvcNAQEL -BQAwJzElMCMGA1UEAxMcZWxhc3RpY3NlYXJjaC5jYS5leGFtcGxlLmNvbTAeFw0y -NDA0MjkxMjQ2MDBaFw0yOTA0MjgxMjQ2MDBaMCcxJTAjBgNVBAMTHGVsYXN0aWNz +MIIDLzCCAhegAwIBAgIUMGKU64YSPkGrWyHiXiLsuoKC/9owDQYJKoZIhvcNAQEL +BQAwJzElMCMGA1UEAwwcZWxhc3RpY3NlYXJjaC5jYS5leGFtcGxlLmNvbTAeFw0y +NDA2MTcxMzE1MzFaFw0zNDA2MTUxMzE1MzFaMCcxJTAjBgNVBAMMHGVsYXN0aWNz ZWFyY2guY2EuZXhhbXBsZS5jb20wggEiMA0GCSqGSIb3DQEBAQUAA4IBDwAwggEK -AoIBAQDMOswRecurkvL3ONZ2g63L2UVgd8VHUYMAImbcZz8e/P0NxjR79Se2/kvV -r57A3iem4Vjqjh7OXf6AebNh6QQGyBO0SgCGOcKymPhatucDN2isTGKpMF10mUZE -RCX5JWC2nUG7lpBaKpZ5l8IWyZphh0O4JpMO9FUbnPPWg7vdVfwM4+20t4jB0LFF -21b8wxy+JZ6G8Oi9I8DwUlmpgINcmsu1PKx82gNQ6Ey5M1CUPODg3Bm5nH79m2KQ -jqWXJSvWwLqL8ZUr257pCwPgWkYuwleodcKdmSVaz3FpR28xUapFRP+/G4i/RMf3 -soAzQVinbq3qLJGOkdVwfT9iTCPjAgMBAAGjQjBAMA4GA1UdDwEB/wQEAwIBBjAP -BgNVHRMBAf8EBTADAQH/MB0GA1UdDgQWBBTMfBqgo5cmKmYOfq79rwuw4oKRfDAN -BgkqhkiG9w0BAQsFAAOCAQEAPi4E/Q23DbSFLtRMxNIWl+aX8Ps50KJzIhrv9T1d -q0t73lXe6agQjKUVBqaf662JZ/r5ihBNiiaU7x5ieaz+3OaA8QsHuGd67p/eDu1L -zoX+EfagpIuT1r3aJeo0551pGhYDw+xhtaib/kc5sxfUBL5EoCyVi0RpwAH7cFwr -FOsVaOVetqbfTUqDYdnXufrV+IX9ZtXnz6yvdKdizdDrz6P+yBxGKQeYMkCGiUvY -nFvb1F5WH0lCM1klJilW8WHvGDsEmhgCRoRfJvlUk/I217KumCXPHh6pwiT5VwWL -ANPKWH9AyHvyXsP44zF4OMtEqQJVzxzPdnmPwWWH10iptA== +AoIBAQC/oFJpJMdyG9FTpNw4K9f1pdkNikwbQsx4dokiQBMTu89IMTnNfsHz2IDr +xCKTCKC3oPupniaEPNprYpV6RMz1UPvUYu/IpvOXGeIGlVd9ixcoYN6763R2nZhM +lFS8Tma9mV+e/B0jr9DbV1pUWIPufuPrYXcOotxDO/W5I+GpKVTz/ZGD//O5odX1 +mJzkwqjeqGa1WNdg+/ALiDtVZ/YAKGdfjx81uqc16fYuYRDw3BYImBp5MyNu/jxd +gNxFB1edcVowvcKXVs5pSlay2ad0eQSa0Ux8n3RjfisjTLAHks/4dkPa3hQyBYzm +xwBhMcMDc06yxiCkXsVnlXRn9nf/AgMBAAGjUzBRMB0GA1UdDgQWBBSGMhy1Uvrs +lmdHKAGQ9avMSWhz2jAfBgNVHSMEGDAWgBSGMhy1UvrslmdHKAGQ9avMSWhz2jAP +BgNVHRMBAf8EBTADAQH/MA0GCSqGSIb3DQEBCwUAA4IBAQA4vndI6NRcMgzba1y3 +lUPxy40bs/jQajR3A5fmCCX4c0ZeRc4YqE9cdYgeGffCZvPogyYjWDlavOma2uAQ ++3lZ35k0wG9GsU2g3fDIXpUuoSUjfYRLBQ3oqD7VRKYs1rDD87c+91DrsfIVZKF1 +W1RzOOvcW9QX2RHghFS4IluX6LEboo48cKtycA/nfmYDT/L9I4oYjaxc9l+HMUSH +gkQUU1xZnQ9GCqdhL3+2dmn0jvdgJLiFuefMGkE0oP/kFD/bhuOmDhpIDb10Cuck +Nw/nOSbBLINx2qDOa1f3Kox/PesQO4tp0dMp6XqZCOPTQ95vHsIOxuX1d+pxhX2V +ToWP -----END CERTIFICATE----- diff --git a/services/nginz/integration-test/conf/nginz/README.md b/services/nginz/integration-test/conf/nginz/README.md index c8e81957c62..8e614e99d1b 100644 --- a/services/nginz/integration-test/conf/nginz/README.md +++ b/services/nginz/integration-test/conf/nginz/README.md @@ -3,5 +3,5 @@ Run from this directory: ```bash -../../../../../hack/bin/selfsigned.sh +../../../../../hack/bin/gen-certs.sh ``` diff --git a/services/nginz/integration-test/conf/nginz/integration-ca-key.pem b/services/nginz/integration-test/conf/nginz/integration-ca-key.pem index 9dd119c5214..812d4ddc4a1 100644 --- a/services/nginz/integration-test/conf/nginz/integration-ca-key.pem +++ b/services/nginz/integration-test/conf/nginz/integration-ca-key.pem @@ -1,27 +1,28 @@ ------BEGIN RSA PRIVATE KEY----- -MIIEpQIBAAKCAQEAxeJTpuiFhgbFAA0KI37Re6nhKd8UcuXZ3SKgBlxej+kRs6hr -xA/6i8LM3YhhTHuw5n3R/DJlP3Vz2Df77/PdATadJmyaye50wpRpGfkQqRvQIRJ8 -pHd9oyO8O6Jdmbtg4gYTdd2nIcqzofM1PPxSzVl71T5TXrOOML6HXY5nFh0jsZfi -upHhT0Zlz5u7qidtz+AhvW3oJPjhjTbRIxsVvVO7i6RljrsBu6JH4lrYgsf1/lQT -JSNLqVcdt4lWY7hFmL4n3U7sw8T8wKOCTb5Erzh3xS/4+sxXSxnGRNWeGAoflAa3 -RrZeE3UQwTrBwMog0xJ9v+f90OZI+qpZriPaFwIDAQABAoIBAQC+aTgBRYEmJGFv -2RxGZ4N/sUm+lrAAl3f6N5UwSbWcWLL14zw/XvjBf2LOUKr/g44HXE6wlHWkiIo+ -JjDBBjFFN54kGSEg6dlkWpZ/rZAAiYjOKhHR2EEGuB4qa+QRR6LEGwCiy/REqd4M -GhDCbDHo8xAbc2uZlsFd2hg7SAmd1h8AIstvhPiq7KBB4mVMT1l0LikXNetT9H2z -teYpbd8OEYO5i6+77SrMZE7WNudtdaFzUbR90Y5qLLdSH3M2Tj/2tJW883RGWwGW -RJE65HkPSsKlyI9+KO+k+z7hAxMbBUQ4/5q1eBAd2Q49NUcGpNGWCZzO2t8yYzlQ -m+FsYD3BAoGBAOXg8GW470g0NBly6BSmxGRu0PG2zsvvegV4Ts4GbY87r4WbYR+4 -oH3cv/Jz6Ta0UIN2/l2KCZ1r2nu1J8iLNVNilfTADvNh8krb3mpbi/rm/we2ECQ2 -F0jU4kyU/IQrPx8xhQq31+a6SK1ZiVtFxFbgXUkXHKR2OuK1jWEAjbYHAoGBANxe -rj67gGqVlwfqu5iZYfUwaXD45XWGyrFHCu62MyNClDNs6oTVS8+KnNJv/M8unZQf -BoBSpW6Sdrlpt2xbG5LykG30WYUHk0DZA1HN4aJiusPzT9d4FikTgJqLHi9wnpwj -dIOsse9pkaoOMwLP5jJpZQC6dmqBJt/WGv1/7TdxAoGAUojChyMw9jGYCxMQdGmz -1YNcDYzfDqV6oAAj+yCfsW9yg3vYETWOmeHqILixIOz4g1rz1M28ygJxPT07fWtN -yBR7VpamR4gBIBN09abMyVaqdjBN91JcZc/ZODm9uA526VI0PDbpk3OKqIKfKGAS -MEb590YPCJVSaxdYHV2/g30CgYEAhhE4EsRB4RY290MQdEtEdEXKsEdMWg7yO54M -AaRpQhdcUFj/6GZXo+EhfUlSVb13csjZTLJ7IOUMQ8sUI2DeSq01vx88Yxlzta0R -PvBxSDimhVX+igjt+nl58QuYBqaOaFGNrhofepcQXpQa5qgS1TKXlzTZm/wM6Xq5 -muX8LJECgYEA0R74AEICRa6l1QJkN5S1bG7vKkHQuUxSVJFbnS7z/4iVvCpYe+Eb -iapDLWzKPW7zDfuxXWo/9XXCRIWk3Xl8xEhps9ON+/9Zrq4L43KuIZgntfJiLUhZ -qhzT7GJxopDHe/FB932JGaF2ZKPg+vXO1t4x6VXdi1GAETFPqlSI+QQ= ------END RSA PRIVATE KEY----- +-----BEGIN PRIVATE KEY----- +MIIEvQIBADANBgkqhkiG9w0BAQEFAASCBKcwggSjAgEAAoIBAQCUJVDizZney5e4 +rJHEp7L/cXMf/k5zMKrapCte8OePyraPjSSQJA9S/l+RJEj2exQyqrdmxn6BE1hp +5aR/87FE1KXIZX+iX8OkyTno0Hq+RUDSwrUEpziHIZQBSsxcYRkr3Dq0VogQD401 +SJL/XogjV3CeTxPUpPPm5p9s7c+y1R3L+Oj5k//ooUcSidNU+QrF1j1BzmUEXxry +mZshn/okwboXMTD2Ap12+/zN62AkFy/BUGYmqmyFTKjUaTAVZAKlN5diZ0q5TSIy +IejaqMI6IPEGBriM+n8cFpMOhFOWQcByK9qzmpAp0KCnl1agSXVmTUTF9Vbanoez +vcw6FuP9AgMBAAECggEACB7IgXoMEFiAAz0gS1N23gYRraQCmFFHWC8t+mkBhFHz +8kfmBGmZlm6/fcTro+kIqSNO5LkGF5ygGMPf4ayRn6h5QtP/bD7MCkUGYdLFm5bP +sA3AntXspQmL44s+SuT+nHcYl6hzkk/L6WsGNa2wkCFbmK3UdDArd1FWVUHuw8pR +2s2V1KpVR6/3Wdw86l3khcDbY3CHimenmGSxxjFPixHMpcni3cTPdnULo+vZT3fh +MMmsRMwQvcZXNFtUjzwelx+/e0MB+AyoEYPaKa+afKKQBxlVmldrn9q/m3++fkiT +PWLg4yNcG+M+78vldoJb3kHANYCNxn438LDUrgNvAQKBgQDGNoSjC6Zmt7OwmO0H +kszLTbzbtNBmV5aFNRtopSL5H/DcMpq1MUXxsCpEK8cRHlbDLaEV/lrADjFN7KNg +Hvy0B77iiHGLm2rB6psZpSafapFjFC24q0VKS95Z6UyTIUiajIj2aYEPz0HOrgFC +lw2Ba7VTV2OxWUegVLoxbaV2/QKBgQC/VhGUf53klmi2XEfh5X+CtvH6v5P48VyZ +8P8e4PcZVBvgAbuMPMT+EW6+46J73GMJ2ISs0kDZEge0k+RRzUVqWvUlBWV9nt04 +BUGZT//w8bqD8Dfo1TeRwiLYuYMUNWaAdYvs0nt49dFpX5hyd+KUB+A5v1QbjTSY +PQT3yscxAQKBgQCE4DteigrNRU0ikAImV5UOnViD+NzUHtd7CTUMm9esJmtzUkFA +Qn3fHffXp3lV0n7bbRVWByOTKHCJCqAjaeKCVcbzWgC0VEXnJX1AXeRcbjZ0syxL +ZhWXTvEKWUnKQD/Jy3htqCCrFofJJAEYQOb+4dO2wRjF5VIM+3+ubxDDiQKBgFIn +tqy4jydTneqPfR312OZbf1NXZ0YA/O3smN69YdwyTTXGCK2SelNNUOwN+fqNCslz +eqRqMwYBw+U5i1PEfAXKwHAA/S8PQ5WGTEB0JUVjxd5ZCuiihJXFcgj0vt+yfiyy +TD6HshSiGCTSszaTW2qMZy7khEzAONEVgkiTfSwBAoGAb48KvxQtxW+2RXkNWzMv +D7DyHm9jTTcTARTf7WtY0KMWQa//MPWofieD6KdzRd65lea2Z8wX5vcPVIEUp803 +zQrZMeLTcAQjsTsSP3qBWBi8F/Vd3JKc++F9+7dNfMEhN/fElxDqFrMbXeWtn/Xr +meIImb/2qCWt45/YjQGL8Do= +-----END PRIVATE KEY----- diff --git a/services/nginz/integration-test/conf/nginz/integration-ca.pem b/services/nginz/integration-test/conf/nginz/integration-ca.pem index df568861a0e..304fc892245 100644 --- a/services/nginz/integration-test/conf/nginz/integration-ca.pem +++ b/services/nginz/integration-test/conf/nginz/integration-ca.pem @@ -1,19 +1,19 @@ -----BEGIN CERTIFICATE----- -MIIDAjCCAeqgAwIBAgIUBYyNbkD7QQIo+K40IXL+UuYmaEMwDQYJKoZIhvcNAQEL -BQAwGTEXMBUGA1UEAxMOY2EuZXhhbXBsZS5jb20wHhcNMjQwNDI5MTI0NjAwWhcN -MjkwNDI4MTI0NjAwWjAZMRcwFQYDVQQDEw5jYS5leGFtcGxlLmNvbTCCASIwDQYJ -KoZIhvcNAQEBBQADggEPADCCAQoCggEBAMXiU6bohYYGxQANCiN+0Xup4SnfFHLl -2d0ioAZcXo/pEbOoa8QP+ovCzN2IYUx7sOZ90fwyZT91c9g3++/z3QE2nSZsmsnu -dMKUaRn5EKkb0CESfKR3faMjvDuiXZm7YOIGE3XdpyHKs6HzNTz8Us1Ze9U+U16z -jjC+h12OZxYdI7GX4rqR4U9GZc+bu6onbc/gIb1t6CT44Y020SMbFb1Tu4ukZY67 -AbuiR+Ja2ILH9f5UEyUjS6lXHbeJVmO4RZi+J91O7MPE/MCjgk2+RK84d8Uv+PrM -V0sZxkTVnhgKH5QGt0a2XhN1EME6wcDKINMSfb/n/dDmSPqqWa4j2hcCAwEAAaNC -MEAwDgYDVR0PAQH/BAQDAgEGMA8GA1UdEwEB/wQFMAMBAf8wHQYDVR0OBBYEFAg4 -MuTnP5GWVyzC1y/L0dIti5y8MA0GCSqGSIb3DQEBCwUAA4IBAQBledBrBHZ10aUW -yxY/5Gj/pXiiZoyeTF3esxFUM6cGEyXpetk7SWAmIkVp2q+7uO9r94D8umXGZJhQ -nOPkNlWggrSeDy5U5akdhiOrLt+r4bZPKdNLLeiJKd94vqS9Opq51YBq4FC/8MxK -fRf6/zPjMMqZjKudlFniwxeg6CHghMqERzL66EZF29/hb1O8AFGC+J5WioA5+Cbj -se9k2mWbm+F7BjMUW4n4Fz2YR3SGtSZ4h8vzTsBmLSn4GsmLuoHZ1ccSDY/WoNDs -sSyEAr4dGN+e4pV5Uyu5h5bg/BZt86w8psbK5Z0dxTrmSC74E/hKF9JNwxK4iuV+ -4RaUWHE2 +MIIDEzCCAfugAwIBAgIUQ35aUV70pJjvDTbfgFUj5YmchHQwDQYJKoZIhvcNAQEL +BQAwGTEXMBUGA1UEAwwOY2EuZXhhbXBsZS5jb20wHhcNMjQwNjE3MTMxNTMxWhcN +MzQwNjE1MTMxNTMxWjAZMRcwFQYDVQQDDA5jYS5leGFtcGxlLmNvbTCCASIwDQYJ +KoZIhvcNAQEBBQADggEPADCCAQoCggEBAJQlUOLNmd7Ll7iskcSnsv9xcx/+TnMw +qtqkK17w54/Kto+NJJAkD1L+X5EkSPZ7FDKqt2bGfoETWGnlpH/zsUTUpchlf6Jf +w6TJOejQer5FQNLCtQSnOIchlAFKzFxhGSvcOrRWiBAPjTVIkv9eiCNXcJ5PE9Sk +8+bmn2ztz7LVHcv46PmT/+ihRxKJ01T5CsXWPUHOZQRfGvKZmyGf+iTBuhcxMPYC +nXb7/M3rYCQXL8FQZiaqbIVMqNRpMBVkAqU3l2JnSrlNIjIh6Nqowjog8QYGuIz6 +fxwWkw6EU5ZBwHIr2rOakCnQoKeXVqBJdWZNRMX1Vtqeh7O9zDoW4/0CAwEAAaNT +MFEwHQYDVR0OBBYEFHNgZ4nZQoNKnb0AnDkefTXxxYDqMB8GA1UdIwQYMBaAFHNg +Z4nZQoNKnb0AnDkefTXxxYDqMA8GA1UdEwEB/wQFMAMBAf8wDQYJKoZIhvcNAQEL +BQADggEBAIuLuyF7m1SP6PBu29jXnfGtaGi7j0jlqfcAysn7VmAU3StgWvSatlAl +AO6MIasjSQ+ygAbfIQW6W2Wc/U+NLQq5fRVi1cnmlxH5OULOFeQZCVyux8Maq0fT +jj4mmsz62b/iiA4tyS5r+foY4v1u2siSViBJSbfYbMp/VggIimt26RNV2u/ZV6Kf +UrOxazMx1yyuqARiqoA3VOMV8Byv8SEIiteWUSYni6u7xOT4gucPORhbM1HOSQ/S +CVq95x4FeKQnbEMykHI+bpBdkoadMVtrjCbskU49mOrvl/pli9V44R8KK6C1Nv3E +VLLcoOctdw90aT3sIjaXBcZtDTE6p6g= -----END CERTIFICATE----- diff --git a/services/nginz/integration-test/conf/nginz/integration-leaf-key.pem b/services/nginz/integration-test/conf/nginz/integration-leaf-key.pem index a429e5651d5..1e7a83068de 100644 --- a/services/nginz/integration-test/conf/nginz/integration-leaf-key.pem +++ b/services/nginz/integration-test/conf/nginz/integration-leaf-key.pem @@ -1,27 +1,28 @@ ------BEGIN RSA PRIVATE KEY----- -MIIEowIBAAKCAQEAmSV2VmlVfsqBNCk/EoW9aN71BGRgVhF+zTojHf/DgPv94jH5 -/IjpNa5yfmT5M0invDwGJQOI3z3sz8kOdg7FvZtrhcyHACDl337gwRPy28hWELbj -IjmBOE73ck5B0dYAsqFnwxpDiepqfHlou+oL5osTerI93pN9IALjYpTZuhK+BPeZ -zlzNLk6VbVqQhd3aaVOJg7VVWPZkCdTRwP10ijPJQVgG42uM3X9BXhYmZk0yN+4M -MNKQ+P+jTL3PguqS9DKC3ObN6OvfOsuZGZaFjVtHnwW4NtiRB1E2nbcK3wgE7r9L -pgW4LSw86gQxhHcMQi1GxnWy1yUg9DJAcQkGwwIDAQABAoIBADc2HUqb4Pm78gan -FBkOZDHJp5W0xlJhLlC4s+5dxdLbhjUlBVX42fLDeH1+06ScffRLw39WneK1xYlH -l9ISE1H/FS2Ahe8S7Sy85jRVh8mamQSfmpU9HAv71BO+iNYoi8najLj24AB5pXhI -oOyWPUIZQ6WJWurCS2rd/7ILrc754gjEmPayiGXdvJhgOcjDzK65XhzTcaoocNRV -Z9/48udPFvhYKqIaHxQU/XIVwTxDQgmMnY08t7DNwRygknWFXsMxbHnIh6QztVM9 -KrFo4lXt2CgIp/vGe588iihD2QAoyhJGdc09n0dPBOY1F7djEnR4mwVg2wuGiiMJ -jTnD37ECgYEAxYaanwd6H62xlpuzktpd/cy8tJvRcSljkP//Ks53yI3jmWoyM+dx -DKarQIVRch0sIHYKV4oxvtoHAgHTTIMhldY5xTnqvvJXv66fCh3ZLcyXxfuPqK+k -7uZ+mYgvK6McB5AT3xiHTNcW6DD1706xt3ZdzqsjY3bydXjdNtEEHekCgYEAxnuV -JABIw8DXkJIr73RU8zgBu2402Ho52NOoHvaWU5908nzTQBnt5c/1lhaMN7Q07UGS -166ncRkjGrpWH+aS4t5TEMALT0LoZ0l9YMP8qmeks46Vg8BMI06ORcnC2CigeklZ -7sWPiHYvM+w1Rsm/X6hmmiPLvq4jl1KCUIEud8sCgYA4GhEUlhUTpkvIURTh4u/L -RDlcutzz3SOQbYVV7SqMZfB9BHKZ12R+iWAehT8qwCpmVeB+GJwkbtyKr2YKVzxU -yHHEGL0Z2s8dfEVjpDKpFXEOJHMbIDgiOok+pjVvmXY+l6dtOBRFuNmivTU88Qb8 -6rueFXGJsKEQyHFcPmWC8QKBgCY+odoyA9NUUTUWNUkKjWPgItVOwvgDdSoGfpqY -wRaT3yDqVHpBhMmHbLbi2VnSa3Bb9kOA79qnEVCRHw8+iocUd8T+fC9loQpl6ra+ -jOz404+VpdGhOAqFlHx2CAlGqsVlZOLRRnrw6t+CYDGnpix0cnC4/QVc4JbD20BP -4/hJAoGBAI7qa8SEcucrq28c8/mUmi+45AkCOZmmPtp31TtFoSlwkTBmAtp4+OSk -76mH5vb2kwJDWgzlmb6nPry8wPFfKQbG4NlBLbovQyc2lJtPGNOSrwboZSIcyClx -lcmE9AcCOuCBhqH18z0nE7nPQXy4IHjHBta7zEJCw+pGxCJh42ke ------END RSA PRIVATE KEY----- +-----BEGIN PRIVATE KEY----- +MIIEvwIBADANBgkqhkiG9w0BAQEFAASCBKkwggSlAgEAAoIBAQCZjOHeUnlauuxD +WgrRnh3hj5Fs+uh9vyddMX8rSWJIbWFw4QuYzYKY8CQa3MBb6qK1uUwoJ0W1w47I +RgA5VLvGxI+T1wX8E5vljVgfT3CAXHKRB88NrT8A1urQnWpzlq5sNerL6dqgBrjG +QBmFF7NxrvjGgerC2D8+srWfpQ6Jbl9by8c3JDu+T79PM+pW9ycUgdF1AJQBTz9K +zNQ7ZTlBQvJG8WhTMKioJgQsE60oEXD0C8M5yKBBb7DrqkeZInXqCw2y7DZLWzog +D+jgoAD5/9sk3d/gGNqDibzjjwMiJnH/IqBTkZsQ9OdZZPfx5v/p062hQBlM656P +2jMpJ1xxAgMBAAECggEAS3NBjWgDP4T4EUROaqACWNKeB+nmkdt68T0gGtoNVD+D +EN9UPnpFQPdHFngAgWnzF858UIKzq1Pzdg+HjqRHPK1bS67tvua3xP1GHuR/CGPk +28T1hefqPHRen7GqHDAfdwarYBWCGv4Sjz/yCkcSIrtyfMBb5fAya5GO02pckUSK +19sl7XhkPtHJVirRkjQL29R2TCpkNNpQMjkuYLk7mox+6pNTbxgbk0cnT3eGj1pV +mlPqpwzC5GevRziE/VE/WXFLChY+8KB4fDLRqWnyvabDvQ4coaXgzwbdScJyM5hX ++Dxdfni/P2m7xAZXUyfBsr0VUzqUkJfK3WWvvAGTDQKBgQDNi3RUEjVnU/MN4aDz +iZB2VYGfo/K69xTPNEbLQWs1F4ZMpHVtUVXzTfx/xG9ug989ijEm6ncL9OsnhThn +UldSz2ojSJUxLmhgCHZGYHT72v/9rEqfT9JisWpIj44KXufUHCcl3Cozj1ae3EUp +NVhN1HphB2LsCIJvLYfLIGdBNwKBgQC/PhHQMm/MQe4pOHAbdzDrRZWdG2KSRVxp +9mmJ/aT8LOp7BDjq+Dkct6a56JGqlOTeJirMTTmCKiOiTInuB9S+K7kWJJiYg9g4 +UCiuMU+40Px/1Z4/uxRj3DSdGLXG7S6kPeADx9f9BUNpAytGqOnSnfbDiDVvQVbp +0N0+nIXDlwKBgQC2uZOXrXxGOE4pd/ySpCeF2yvZ1HDTnxWjwlBxHt4Em74rYkR2 +A0mKezjOCL4bHCaYWcKqWuOsAHYQcxEaYQv6NSOg7ESdLSlivgMPO26j+yN5yvGn +wNlCHYBjsyLNu2MSoFh5AsmNfo69uQnOwXqX7h1BJsTdGg+CcJJ4lHzWbwKBgQCD +/CRzGbwKrh3eGPNWIUaDuTxudy3qYTBMeSGReJpa5+zUBa/6imFwLldEyvttTOE/ +Z/v1j/52lPqO0mAHBSSQMsDERXGDIMsi4j+RKLsqhCEfYKCcv1JtMNam7RzXM24T +MBjgwxWPrAg/+03ssDrffuGFRQYLyH5hVCK9SW0P9QKBgQDJ1ZSto+RWxv/uOKNr +7FYeQoKpMb2IvNvnGlnYHC8KS9qRq6wUE+FtuKcdLBQP4M9Cgq71VD/dsawrhEw7 +1rAYk3OqmHxBOU5Dcb152NxYHEf53pfEfWc0x4AEVe+Jzynj2EYixRKNWwODNTEx +LKJOYd0CuWywxg6d9G7A7XbgWQ== +-----END PRIVATE KEY----- diff --git a/services/nginz/integration-test/conf/nginz/integration-leaf.pem b/services/nginz/integration-test/conf/nginz/integration-leaf.pem index cb0b495b92a..635d332de70 100644 --- a/services/nginz/integration-test/conf/nginz/integration-leaf.pem +++ b/services/nginz/integration-test/conf/nginz/integration-leaf.pem @@ -1,21 +1,20 @@ -----BEGIN CERTIFICATE----- -MIIDcjCCAlqgAwIBAgIUf1Euc5flsS90XTspZ7RXONZm8DgwDQYJKoZIhvcNAQEL -BQAwGTEXMBUGA1UEAxMOY2EuZXhhbXBsZS5jb20wHhcNMjQwNDI5MTI0NjAwWhcN -MjUwNDI5MTI0NjAwWjAAMIIBIjANBgkqhkiG9w0BAQEFAAOCAQ8AMIIBCgKCAQEA -mSV2VmlVfsqBNCk/EoW9aN71BGRgVhF+zTojHf/DgPv94jH5/IjpNa5yfmT5M0in -vDwGJQOI3z3sz8kOdg7FvZtrhcyHACDl337gwRPy28hWELbjIjmBOE73ck5B0dYA -sqFnwxpDiepqfHlou+oL5osTerI93pN9IALjYpTZuhK+BPeZzlzNLk6VbVqQhd3a -aVOJg7VVWPZkCdTRwP10ijPJQVgG42uM3X9BXhYmZk0yN+4MMNKQ+P+jTL3PguqS -9DKC3ObN6OvfOsuZGZaFjVtHnwW4NtiRB1E2nbcK3wgE7r9LpgW4LSw86gQxhHcM -Qi1GxnWy1yUg9DJAcQkGwwIDAQABo4HKMIHHMA4GA1UdDwEB/wQEAwIFoDAdBgNV -HSUEFjAUBggrBgEFBQcDAQYIKwYBBQUHAwIwDAYDVR0TAQH/BAIwADAdBgNVHQ4E -FgQUv8i5VPBWRk+7SbQoK3bsYK4VwncwHwYDVR0jBBgwFoAUCDgy5Oc/kZZXLMLX -L8vR0i2LnLwwSAYDVR0RAQH/BD4wPIIZKi5pbnRlZ3JhdGlvbi5leGFtcGxlLmNv -bYIUaG9zdC5kb2NrZXIuaW50ZXJuYWyCCWxvY2FsaG9zdDANBgkqhkiG9w0BAQsF -AAOCAQEAamTOVMoIb6s+q2IT/zgR/UbkRFlTAsGo7mPIgfgC0D8FkJgLJwYA3uz1 -ZEQ0XRbnmsFFeTdPYya4TOz1E0ZsA4tgK0DOJgPTRfP+DOiplFMDPCrgHPkHQGOd -LDSzQv+GrlSuYUuFxLFXXYZwWzxg5Tv0UgcL+i1wkVBSkwsUvtUkKqqOAjG1cZpI -Mc4VtMAYh5NaBb7KfCo47srRMQfg1SKiGmG65LRUJHGHoVc5PNohz/sbfef/WC0W -haih/68v9qVF/8Xmvy+XKUk5t4mHwpxu1foPCBdMDAU1Udk39VZmYNBbycp+2dt6 -BOe3K9zXlCS8KnJOVLoe9nxsWOAsgA== +MIIDQTCCAimgAwIBAgIBADANBgkqhkiG9w0BAQsFADAZMRcwFQYDVQQDDA5jYS5l +eGFtcGxlLmNvbTAeFw0yNDA2MTcxMzE1MzFaFw0yNDA3MTcxMzE1MzFaMAAwggEi +MA0GCSqGSIb3DQEBAQUAA4IBDwAwggEKAoIBAQCZjOHeUnlauuxDWgrRnh3hj5Fs ++uh9vyddMX8rSWJIbWFw4QuYzYKY8CQa3MBb6qK1uUwoJ0W1w47IRgA5VLvGxI+T +1wX8E5vljVgfT3CAXHKRB88NrT8A1urQnWpzlq5sNerL6dqgBrjGQBmFF7NxrvjG +gerC2D8+srWfpQ6Jbl9by8c3JDu+T79PM+pW9ycUgdF1AJQBTz9KzNQ7ZTlBQvJG +8WhTMKioJgQsE60oEXD0C8M5yKBBb7DrqkeZInXqCw2y7DZLWzogD+jgoAD5/9sk +3d/gGNqDibzjjwMiJnH/IqBTkZsQ9OdZZPfx5v/p062hQBlM656P2jMpJ1xxAgMB +AAGjgawwgakwHQYDVR0lBBYwFAYIKwYBBQUHAwEGCCsGAQUFBwMCMEgGA1UdEQEB +/wQ+MDyCGSouaW50ZWdyYXRpb24uZXhhbXBsZS5jb22CFGhvc3QuZG9ja2VyLmlu +dGVybmFsgglsb2NhbGhvc3QwHQYDVR0OBBYEFPowAfmLPCmdCMdSxQjsR6UQSoyH +MB8GA1UdIwQYMBaAFHNgZ4nZQoNKnb0AnDkefTXxxYDqMA0GCSqGSIb3DQEBCwUA +A4IBAQCMJwbLzUsrkQkgdGKVi/Mb5XAAV0sfkwZch1Fx0vhJI072cZSow5A2ZUHa +LScFNTPmilPKEr6MS4xIKtRQaMHInbfxSsyNViKhpzkSOKoAiJjIJ2xPKFPnbTDI +uV74nxxyf9q/p3SLQfJFk7fxbvNeLqg5bYSrMeklHj4bpMJ9fybS8/mZVc8AkTFK +fsXSu9CW1B3GF+jP3E2GrFF3Zh9MgvWjMlSYg4ljPf5FoMCUq6GmQ17hQeJFvb5h +Jqk6TcgUrp082bcVlPW17XzFwVe3n6uzvWMtwI62EztVUj98+YkBiFL3i4+OQwAU +/noc22fq20OyJtCPJY4FIK7xUcgD -----END CERTIFICATE----- diff --git a/services/nginz/integration-test/conf/nginz/nginx.conf b/services/nginz/integration-test/conf/nginz/nginx.conf index d0036ea1b9c..41be5df60bf 100644 --- a/services/nginz/integration-test/conf/nginz/nginx.conf +++ b/services/nginz/integration-test/conf/nginz/nginx.conf @@ -108,7 +108,7 @@ http { server { include integration.conf; - # self-signed certificates generated using wire-server/hack/bin/selfsigned.sh + # self-signed certificates generated using wire-server/hack/bin/gen-certs.sh ssl_certificate integration-leaf.pem; ssl_certificate_key integration-leaf-key.pem; From 0ab0e861e9f8e58c129211ee758abef31952fc94 Mon Sep 17 00:00:00 2001 From: Mango The Fourth <40720523+MangoIV@users.noreply.github.com> Date: Wed, 19 Jun 2024 13:56:24 +0200 Subject: [PATCH 31/64] [WPB-8943] ghc 9.4 -> 9.6, nixpkgs bump (#4071) * [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 - reformat with new ormolu version --- .ormolu | 12 +- changelog.d/5-internal/WPB-8943 | 1 + deploy/dockerephemeral/docker-compose.yaml | 1 - deploy/dockerephemeral/federation-v0.yaml | 2 - integration/test/API/Brig.hs | 22 +- integration/test/API/BrigInternal.hs | 3 +- integration/test/API/Cargohold.hs | 44 +- integration/test/API/Common.hs | 6 +- integration/test/API/Galley.hs | 86 +- integration/test/API/GalleyInternal.hs | 3 +- integration/test/API/Gundeck.hs | 12 +- integration/test/API/GundeckInternal.hs | 5 +- integration/test/API/Nginz.hs | 10 +- integration/test/MLS/Util.hs | 8 +- integration/test/Notifications.hs | 54 +- integration/test/SetupHelpers.hs | 20 +- integration/test/Test/AccessUpdate.hs | 6 +- integration/test/Test/AssetDownload.hs | 10 +- integration/test/Test/AssetUpload.hs | 6 +- integration/test/Test/Bot.hs | 8 +- integration/test/Test/Brig.hs | 18 +- integration/test/Test/Cargohold/API.hs | 32 +- .../test/Test/Cargohold/API/Federation.hs | 22 +- integration/test/Test/Cargohold/API/Util.hs | 8 +- integration/test/Test/Cargohold/API/V3.hs | 16 +- integration/test/Test/Cargohold/Metrics.hs | 2 +- integration/test/Test/Client.hs | 4 +- integration/test/Test/Connection.hs | 30 +- integration/test/Test/Conversation.hs | 78 +- integration/test/Test/Demo.hs | 47 +- integration/test/Test/EJPD.hs | 10 +- integration/test/Test/Errors.hs | 10 +- integration/test/Test/ExternalPartner.hs | 8 +- integration/test/Test/FeatureFlags.hs | 244 ++--- integration/test/Test/FeatureFlags/Util.hs | 11 +- integration/test/Test/Federation.hs | 2 +- integration/test/Test/Federator.hs | 6 +- integration/test/Test/LegalHold.hs | 46 +- integration/test/Test/Login.hs | 12 +- integration/test/Test/MLS.hs | 66 +- integration/test/Test/MLS/KeyPackage.hs | 41 +- integration/test/Test/MLS/Keys.hs | 4 +- integration/test/Test/MLS/Message.hs | 8 +- integration/test/Test/MLS/Notifications.hs | 2 +- integration/test/Test/MLS/One2One.hs | 14 +- integration/test/Test/MLS/SubConversation.hs | 14 +- integration/test/Test/MLS/Unreachable.hs | 6 +- integration/test/Test/MessageTimer.hs | 4 +- integration/test/Test/Notifications.hs | 27 +- integration/test/Test/Presence.hs | 6 +- integration/test/Test/Provider.hs | 2 +- integration/test/Test/Roles.hs | 5 +- integration/test/Test/Search.hs | 10 +- integration/test/Test/Services.hs | 20 +- integration/test/Test/Spar.hs | 2 +- integration/test/Test/Swagger.hs | 12 +- integration/test/Test/TeamSettings.hs | 4 +- integration/test/Test/User.hs | 8 +- integration/test/Test/Version.hs | 8 +- integration/test/Testlib/App.hs | 6 +- integration/test/Testlib/Assertions.hs | 7 +- integration/test/Testlib/Cannon.hs | 36 +- integration/test/Testlib/Certs.hs | 20 +- integration/test/Testlib/HTTP.hs | 18 +- integration/test/Testlib/JSON.hs | 50 +- integration/test/Testlib/Mock.hs | 4 +- .../test/Testlib/MockIntegrationService.hs | 12 +- integration/test/Testlib/ModService.hs | 10 +- integration/test/Testlib/One2One.hs | 12 +- integration/test/Testlib/Ports.hs | 8 +- integration/test/Testlib/Prelude.hs | 20 +- integration/test/Testlib/RunServices.hs | 5 +- integration/test/Testlib/Types.hs | 9 +- libs/bilge/src/Bilge/Assert.hs | 14 +- libs/bilge/src/Bilge/IO.hs | 18 +- libs/bilge/src/Bilge/RPC.hs | 2 +- libs/bilge/src/Bilge/Request.hs | 4 +- libs/bilge/src/Bilge/Response.hs | 2 +- libs/bilge/src/Bilge/Retry.hs | 4 +- libs/bilge/src/Bilge/TestSession.hs | 4 +- libs/brig-types/src/Brig/Types/Instances.hs | 2 +- libs/brig-types/src/Brig/Types/Search.hs | 6 +- libs/brig-types/src/Brig/Types/User/Auth.hs | 6 +- libs/cassandra-util/src/Cassandra/Settings.hs | 4 +- .../deriving-swagger2/src/Deriving/Swagger.hs | 4 +- libs/dns-util/src/Wire/Network/DNS/Effect.hs | 4 +- .../src/Options/Applicative/Extended.hs | 2 +- libs/extended/src/Servant/API/Extended.hs | 4 +- .../src/Servant/API/Extended/Endpath.hs | 2 +- .../src/Galley/Types/Conversations/One2One.hs | 2 +- libs/galley-types/src/Galley/Types/Teams.hs | 8 +- .../gundeck-types/src/Gundeck/Types/Common.hs | 2 +- .../src/Gundeck/Types/Push/V2.hs | 53 +- libs/hscim/hscim.cabal | 16 +- libs/hscim/server/Main.hs | 3 +- .../src/Web/Scim/Capabilities/MetaSchema.hs | 4 +- libs/hscim/src/Web/Scim/Class/Group.hs | 2 +- libs/hscim/src/Web/Scim/Client.hs | 22 +- libs/hscim/src/Web/Scim/ContentType.hs | 4 +- libs/hscim/src/Web/Scim/Handler.hs | 5 +- libs/hscim/src/Web/Scim/Schema/Common.hs | 2 +- .../hscim/src/Web/Scim/Schema/ListResponse.hs | 4 +- libs/hscim/src/Web/Scim/Schema/PatchOp.hs | 3 +- libs/hscim/src/Web/Scim/Schema/User.hs | 9 +- libs/hscim/src/Web/Scim/Server.hs | 4 +- libs/hscim/src/Web/Scim/Server/Mock.hs | 3 +- libs/hscim/src/Web/Scim/Test/Acceptance.hs | 2 +- libs/hscim/src/Web/Scim/Test/Util.hs | 6 +- libs/hscim/test/Test/FilterSpec.hs | 10 +- libs/hscim/test/Test/Schema/PatchOpSpec.hs | 12 +- libs/hscim/test/Test/Schema/UserSpec.hs | 2 +- libs/hscim/test/Test/Schema/Util.hs | 2 +- .../src/HTTP2/Client/Manager/Internal.hs | 13 +- .../test/Test/HTTP2/Client/ManagerSpec.hs | 12 +- libs/imports/src/Imports.hs | 20 +- libs/libzauth/libzauth-c/Cargo.lock | 340 ++++--- libs/libzauth/libzauth-c/Cargo.nix | 838 +++++++++++++----- libs/libzauth/libzauth-c/crate-hashes.json | 127 ++- .../src/Data/Metrics/Middleware/Prometheus.hs | 2 +- libs/metrics-wai/src/Data/Metrics/Servant.hs | 10 +- libs/metrics-wai/src/Data/Metrics/WaiRoute.hs | 2 +- .../src/Wire/Sem/Concurrency.hs | 12 +- .../src/Wire/Sem/Concurrency/IO.hs | 4 +- libs/polysemy-wire-zoo/src/Wire/Sem/Delay.hs | 2 +- libs/polysemy-wire-zoo/src/Wire/Sem/Jwk.hs | 2 +- libs/polysemy-wire-zoo/src/Wire/Sem/Logger.hs | 14 +- .../src/Wire/Sem/Logger/TinyLog.hs | 8 +- .../src/Wire/Sem/Now/Input.hs | 2 +- .../src/Wire/Sem/Now/Spec.hs | 8 +- libs/polysemy-wire-zoo/src/Wire/Sem/Random.hs | 2 +- .../src/Wire/Sem/Random/IO.hs | 2 +- libs/ropes/src/Ropes/Twilio.hs | 2 +- libs/schema-profunctor/src/Data/Schema.hs | 78 +- libs/ssl-util/src/Ssl/Util.hs | 2 +- libs/tasty-cannon/src/Test/Tasty/Cannon.hs | 20 +- libs/types-common-journal/src/Data/Proto.hs | 2 +- .../src/Data/CommaSeparatedList.hs | 4 +- libs/types-common/src/Data/ETag.hs | 12 +- libs/types-common/src/Data/Id.hs | 4 +- libs/types-common/src/Data/List1.hs | 2 +- libs/types-common/src/Data/Misc.hs | 8 +- libs/types-common/src/Data/Nonce.hs | 2 +- libs/types-common/src/Data/Qualified.hs | 20 +- libs/types-common/src/Data/Range.hs | 57 +- libs/types-common/src/Data/SizedHashMap.hs | 6 +- libs/types-common/src/Data/Text/Ascii.hs | 20 +- libs/types-common/src/Data/UUID/Tagged.hs | 2 +- libs/types-common/src/Util/Options.hs | 2 +- libs/types-common/src/Wire/Arbitrary.hs | 6 +- libs/types-common/test/Test/Properties.hs | 2 +- .../src/Network/Wai/Utilities/Error.hs | 2 +- .../src/Network/Wai/Utilities/Response.hs | 2 +- .../src/Network/Wai/Utilities/Server.hs | 12 +- .../src/Network/Wai/Utilities/ZAuth.hs | 14 +- .../src/Wire/API/Federation/API.hs | 6 +- .../API/Federation/BackendNotifications.hs | 2 +- .../src/Wire/API/Federation/Client.hs | 17 +- .../src/Wire/API/Federation/Component.hs | 2 +- .../src/Wire/API/Federation/Domain.hs | 8 +- .../src/Wire/API/Federation/Endpoint.hs | 2 +- .../API/Federation/HasNotificationEndpoint.hs | 6 +- .../src/Wire/API/Federation/Version.hs | 4 +- .../Test/Wire/API/Federation/Golden/Runner.hs | 2 +- libs/wire-api/default.nix | 2 + libs/wire-api/src/Wire/API/Asset.hs | 6 +- libs/wire-api/src/Wire/API/Call/Config.hs | 2 +- libs/wire-api/src/Wire/API/Conversation.hs | 14 +- .../src/Wire/API/Conversation/Member.hs | 2 +- libs/wire-api/src/Wire/API/Deprecated.hs | 8 +- libs/wire-api/src/Wire/API/Error.hs | 22 +- libs/wire-api/src/Wire/API/Error/Empty.hs | 4 +- libs/wire-api/src/Wire/API/Error/Galley.hs | 16 +- libs/wire-api/src/Wire/API/Event/Team.hs | 6 +- libs/wire-api/src/Wire/API/MLS/CipherSuite.hs | 6 +- .../wire-api/src/Wire/API/MLS/CommitBundle.hs | 8 +- libs/wire-api/src/Wire/API/MLS/ECDSA.hs | 4 +- libs/wire-api/src/Wire/API/MLS/Epoch.hs | 2 +- libs/wire-api/src/Wire/API/MLS/Keys.hs | 4 +- .../src/Wire/API/MLS/Serialisation.hs | 18 +- libs/wire-api/src/Wire/API/MLS/Servant.hs | 4 +- .../src/Wire/API/MakesFederatedCall.hs | 68 +- libs/wire-api/src/Wire/API/Message.hs | 2 +- libs/wire-api/src/Wire/API/Message/Proto.hs | 26 +- libs/wire-api/src/Wire/API/OAuth.hs | 110 ++- libs/wire-api/src/Wire/API/Password.hs | 12 +- .../src/Wire/API/Provider/External.hs | 33 +- .../src/Wire/API/Provider/Service/Tag.hs | 2 +- libs/wire-api/src/Wire/API/Routes/API.hs | 6 +- libs/wire-api/src/Wire/API/Routes/Bearer.hs | 6 +- .../src/Wire/API/Routes/ClientAlgebra.hs | 4 +- libs/wire-api/src/Wire/API/Routes/Cookies.hs | 6 +- .../src/Wire/API/Routes/MultiTablePaging.hs | 14 +- .../Wire/API/Routes/MultiTablePaging/State.hs | 12 +- .../wire-api/src/Wire/API/Routes/MultiVerb.hs | 36 +- libs/wire-api/src/Wire/API/Routes/Named.hs | 10 +- libs/wire-api/src/Wire/API/Routes/Public.hs | 36 +- .../src/Wire/API/Routes/Public/Cargohold.hs | 4 +- .../API/Routes/Public/Galley/Messaging.hs | 2 +- .../src/Wire/API/Routes/Public/Proxy.hs | 2 +- .../src/Wire/API/Routes/Public/Spar.hs | 4 +- .../Wire/API/Routes/SpecialiseToVersion.hs | 4 +- libs/wire-api/src/Wire/API/Routes/Version.hs | 14 +- .../wire-api/src/Wire/API/Routes/Versioned.hs | 8 +- libs/wire-api/src/Wire/API/ServantProto.hs | 6 +- libs/wire-api/src/Wire/API/SwaggerServant.hs | 4 +- .../src/Wire/API/Team/Conversation.hs | 2 +- libs/wire-api/src/Wire/API/Team/Export.hs | 4 +- libs/wire-api/src/Wire/API/Team/Feature.hs | 14 +- .../src/Wire/API/Team/HardTruncationLimit.hs | 2 +- libs/wire-api/src/Wire/API/Team/LegalHold.hs | 3 +- .../src/Wire/API/Team/LegalHold/External.hs | 30 +- .../src/Wire/API/Team/LegalHold/Internal.hs | 15 +- libs/wire-api/src/Wire/API/Team/Member.hs | 16 +- libs/wire-api/src/Wire/API/Team/Role.hs | 2 +- libs/wire-api/src/Wire/API/User.hs | 2 +- libs/wire-api/src/Wire/API/User/Auth.hs | 9 +- libs/wire-api/src/Wire/API/User/Client.hs | 14 +- .../src/Wire/API/User/Client/Prekey.hs | 5 +- libs/wire-api/src/Wire/API/User/Identity.hs | 38 +- .../src/Wire/API/User/IdentityProvider.hs | 13 +- libs/wire-api/src/Wire/API/User/Orphans.hs | 4 +- libs/wire-api/src/Wire/API/User/Profile.hs | 2 +- libs/wire-api/src/Wire/API/User/RichInfo.hs | 2 +- libs/wire-api/src/Wire/API/User/Saml.hs | 6 +- libs/wire-api/src/Wire/API/User/Scim.hs | 15 +- libs/wire-api/src/Wire/API/User/Search.hs | 6 +- libs/wire-api/src/Wire/API/UserMap.hs | 4 +- libs/wire-api/src/Wire/API/VersionInfo.hs | 4 +- .../golden/Test/Wire/API/Golden/Runner.hs | 2 +- libs/wire-api/test/unit/Test/Wire/API/MLS.hs | 4 +- .../test/unit/Test/Wire/API/Roundtrip/MLS.hs | 2 +- libs/wire-api/wire-api.cabal | 1 + .../src/Wire/DeleteQueue/InMemory.hs | 2 +- .../src/Wire/FederationAPIAccess.hs | 2 +- libs/wire-subsystems/src/Wire/MiniBackend.hs | 16 +- libs/wire-subsystems/src/Wire/Rpc.hs | 2 +- .../src/Wire/UserStore/Cassandra.hs | 4 +- .../src/Wire/UserStore/Unique.hs | 2 +- .../wire-subsystems/src/Wire/UserSubsystem.hs | 6 +- .../src/Wire/UserSubsystem/Interpreter.hs | 13 +- .../NotificationSubsystem/InterpreterSpec.hs | 4 +- .../Wire/UserSubsystem/InterpreterSpec.hs | 2 +- libs/zauth/main/Main.hs | 2 +- libs/zauth/src/Data/ZAuth/Creation.hs | 8 +- libs/zauth/src/Data/ZAuth/Token.hs | 8 +- libs/zauth/src/Data/ZAuth/Validation.hs | 6 +- nix/haskell-pins.nix | 85 +- nix/manual-overrides.nix | 64 +- nix/overlay-docs.nix | 2 - nix/overlay.nix | 5 +- nix/pkgs/python-docs/sphinxcontrib-kroki.nix | 3 +- nix/sources.json | 30 +- nix/sources.nix | 114 +-- nix/wire-server.nix | 30 +- .../src/Wire/BackendNotificationPusher.hs | 4 +- .../src/Wire/BackgroundWorker/Env.hs | 2 +- services/brig/src/Brig/API/Auth.hs | 8 +- services/brig/src/Brig/API/Client.hs | 12 +- services/brig/src/Brig/API/Connection.hs | 6 +- .../brig/src/Brig/API/Connection/Remote.hs | 2 +- services/brig/src/Brig/API/Error.hs | 6 +- services/brig/src/Brig/API/Internal.hs | 34 +- services/brig/src/Brig/API/MLS/KeyPackages.hs | 2 +- services/brig/src/Brig/API/OAuth.hs | 22 +- services/brig/src/Brig/API/Public.hs | 22 +- services/brig/src/Brig/API/Public/Swagger.hs | 2 +- services/brig/src/Brig/API/User.hs | 28 +- services/brig/src/Brig/API/Util.hs | 4 +- services/brig/src/Brig/AWS.hs | 4 +- services/brig/src/Brig/AWS/SesNotification.hs | 6 +- services/brig/src/Brig/App.hs | 4 +- services/brig/src/Brig/Budget.hs | 8 +- services/brig/src/Brig/Calling/API.hs | 4 +- .../brig/src/Brig/CanonicalInterpreter.hs | 2 +- services/brig/src/Brig/Code.hs | 22 +- services/brig/src/Brig/Data/Activation.hs | 14 +- services/brig/src/Brig/Data/Client.hs | 34 +- services/brig/src/Brig/Data/Connection.hs | 2 +- services/brig/src/Brig/Data/LoginCode.hs | 4 +- services/brig/src/Brig/Data/MLS/KeyPackage.hs | 4 +- services/brig/src/Brig/Data/Nonce.hs | 8 +- services/brig/src/Brig/Data/Properties.hs | 12 +- services/brig/src/Brig/Data/User.hs | 64 +- services/brig/src/Brig/Data/UserKey.hs | 16 +- .../brig/src/Brig/DeleteQueue/Interpreter.hs | 2 +- .../BlacklistPhonePrefixStore/Cassandra.hs | 10 +- .../Brig/Effects/BlacklistStore/Cassandra.hs | 6 +- .../src/Brig/Effects/CodeStore/Cassandra.hs | 8 +- .../FederationConfigStore/Cassandra.hs | 20 +- services/brig/src/Brig/Effects/JwtTools.hs | 2 +- .../brig/src/Brig/Effects/PublicKeyBundle.hs | 2 +- services/brig/src/Brig/Effects/SFT.hs | 8 +- .../Effects/UserPendingActivationStore.hs | 2 +- .../UserPendingActivationStore/Cassandra.hs | 6 +- services/brig/src/Brig/IO/Intra.hs | 2 +- services/brig/src/Brig/IO/Logging.hs | 15 +- .../brig/src/Brig/Index/Migrations/Types.hs | 10 +- services/brig/src/Brig/Provider/API.hs | 82 +- services/brig/src/Brig/Provider/DB.hs | 58 +- services/brig/src/Brig/Provider/RPC.hs | 2 +- services/brig/src/Brig/Queue/Stomp.hs | 4 +- services/brig/src/Brig/Team/API.hs | 8 +- services/brig/src/Brig/Team/DB.hs | 12 +- services/brig/src/Brig/Team/Util.hs | 2 +- services/brig/src/Brig/User/API/Search.hs | 2 +- services/brig/src/Brig/User/Auth.hs | 15 +- services/brig/src/Brig/User/Auth/Cookie.hs | 6 +- services/brig/src/Brig/User/Auth/DB/Cookie.hs | 10 +- services/brig/src/Brig/User/Search/Index.hs | 22 +- .../brig/src/Brig/User/Search/SearchIndex.hs | 8 +- .../brig/src/Brig/User/Search/TeamSize.hs | 2 +- services/brig/src/Brig/ZAuth.hs | 36 +- services/brig/test/integration/API/Calling.hs | 12 +- .../brig/test/integration/API/Federation.hs | 2 +- .../brig/test/integration/API/MLS/Util.hs | 14 +- services/brig/test/integration/API/OAuth.hs | 8 +- .../brig/test/integration/API/Provider.hs | 58 +- .../test/integration/API/RichInfo/Util.hs | 14 +- services/brig/test/integration/API/Search.hs | 58 +- .../brig/test/integration/API/Search/Util.hs | 2 +- .../brig/test/integration/API/Settings.hs | 2 +- services/brig/test/integration/API/Team.hs | 12 +- .../brig/test/integration/API/Team/Util.hs | 18 +- .../test/integration/API/TeamUserSearch.hs | 16 +- .../brig/test/integration/API/User/Account.hs | 16 +- .../brig/test/integration/API/User/Auth.hs | 32 +- .../brig/test/integration/API/User/Client.hs | 10 +- .../integration/API/User/PasswordReset.hs | 2 +- .../test/integration/API/User/Property.hs | 2 +- .../test/integration/API/User/RichInfo.hs | 2 +- .../brig/test/integration/API/User/Util.hs | 48 +- .../integration/API/UserPendingActivation.hs | 21 +- .../test/integration/Federation/End2end.hs | 4 +- .../brig/test/integration/Federation/Util.hs | 2 +- services/brig/test/integration/SMTP.hs | 4 +- services/brig/test/integration/Util.hs | 125 +-- services/brig/test/integration/Util/AWS.hs | 2 +- services/brig/test/unit/Test/Brig/Calling.hs | 2 +- .../brig/test/unit/Test/Brig/Effects/Delay.hs | 2 +- services/cannon/src/Cannon/App.hs | 26 +- services/cannon/src/Cannon/Dict.hs | 10 +- services/cannon/src/Cannon/Types.hs | 2 +- services/cannon/src/Cannon/WS.hs | 2 +- .../cargohold/src/CargoHold/API/Public.hs | 16 +- services/cargohold/src/CargoHold/API/V3.hs | 2 +- services/cargohold/src/CargoHold/AWS.hs | 4 +- services/cargohold/src/CargoHold/App.hs | 2 +- .../cargohold/src/CargoHold/CloudFront.hs | 2 +- services/cargohold/src/CargoHold/Metrics.hs | 2 +- services/cargohold/src/CargoHold/Run.hs | 2 +- services/cargohold/src/CargoHold/S3.hs | 2 +- .../cargohold/test/integration/TestSetup.hs | 34 +- .../federator/src/Federator/ExternalServer.hs | 4 +- .../federator/src/Federator/InternalServer.hs | 4 +- .../federator/src/Federator/Interpreter.hs | 2 +- .../federator/src/Federator/MockServer.hs | 6 +- .../src/Federator/Monitor/Internal.hs | 2 +- services/federator/src/Federator/Service.hs | 2 +- .../integration/Test/Federator/IngressSpec.hs | 10 +- .../test/integration/Test/Federator/Util.hs | 22 +- .../unit/Test/Federator/ExternalServer.hs | 4 +- .../unit/Test/Federator/InternalServer.hs | 4 +- .../test/unit/Test/Federator/Validation.hs | 4 +- services/galley/default.nix | 1 - services/galley/galley.cabal | 1 - .../migrate-data/src/Galley/DataMigration.hs | 2 +- .../src/Galley/DataMigration/Types.hs | 4 +- .../src/V1_BackfillBillingTeamMembers.hs | 4 +- .../migrate-data/src/V3_BackfillTeamAdmins.hs | 4 +- services/galley/src/Galley/API/Create.hs | 10 +- services/galley/src/Galley/API/Error.hs | 2 +- services/galley/src/Galley/API/Federation.hs | 23 +- services/galley/src/Galley/API/Internal.hs | 11 +- services/galley/src/Galley/API/LegalHold.hs | 2 +- .../galley/src/Galley/API/LegalHold/Team.hs | 2 +- .../Galley/API/MLS/Commit/ExternalCommit.hs | 2 +- .../Galley/API/MLS/Commit/InternalCommit.hs | 6 +- .../galley/src/Galley/API/MLS/Conversation.hs | 2 +- services/galley/src/Galley/API/MLS/Enabled.hs | 2 +- .../galley/src/Galley/API/MLS/GroupInfo.hs | 6 +- services/galley/src/Galley/API/MLS/Keys.hs | 4 +- .../galley/src/Galley/API/MLS/Migration.hs | 4 +- services/galley/src/Galley/API/MLS/One2One.hs | 2 +- .../galley/src/Galley/API/MLS/Proposal.hs | 6 +- services/galley/src/Galley/API/MLS/Removal.hs | 2 +- .../src/Galley/API/MLS/SubConversation.hs | 32 +- services/galley/src/Galley/API/MLS/Util.hs | 2 +- services/galley/src/Galley/API/MLS/Welcome.hs | 4 +- services/galley/src/Galley/API/Message.hs | 4 +- .../src/Galley/API/Public/TeamNotification.hs | 2 +- services/galley/src/Galley/API/Push.hs | 8 +- services/galley/src/Galley/API/Query.hs | 10 +- services/galley/src/Galley/API/Teams.hs | 18 +- .../galley/src/Galley/API/Teams/Features.hs | 2 +- .../src/Galley/API/Teams/Features/Get.hs | 22 +- .../src/Galley/API/Teams/Notifications.hs | 2 +- services/galley/src/Galley/API/Update.hs | 1 - services/galley/src/Galley/API/Util.hs | 42 +- services/galley/src/Galley/App.hs | 2 +- services/galley/src/Galley/Aws.hs | 4 +- .../src/Galley/Cassandra/Conversation.hs | 22 +- .../Galley/Cassandra/Conversation/Members.hs | 2 +- .../src/Galley/Cassandra/CustomBackend.hs | 6 +- .../Cassandra/GetAllTeamFeatureConfigs.hs | 2 +- .../galley/src/Galley/Cassandra/LegalHold.hs | 20 +- .../src/Galley/Cassandra/SearchVisibility.hs | 6 +- .../galley/src/Galley/Cassandra/Services.hs | 6 +- .../src/Galley/Cassandra/SubConversation.hs | 6 +- .../src/Galley/Cassandra/TeamFeatures.hs | 10 +- services/galley/src/Galley/Cassandra/Util.hs | 2 +- services/galley/src/Galley/Data/Types.hs | 4 +- .../Effects/BackendNotificationQueueAccess.hs | 2 +- .../galley/src/Galley/Effects/BrigAccess.hs | 2 +- .../src/Galley/Effects/ConversationStore.hs | 2 +- .../src/Galley/Effects/ExternalAccess.hs | 4 +- .../src/Galley/Effects/FederatorAccess.hs | 4 +- .../src/Galley/Effects/FireAndForget.hs | 4 +- .../galley/src/Galley/Effects/MemberStore.hs | 2 +- .../galley/src/Galley/Effects/TeamStore.hs | 2 +- .../External/LegalHoldService/Internal.hs | 2 +- services/galley/src/Galley/Intra/Federator.hs | 3 +- services/galley/src/Galley/Intra/User.hs | 6 +- services/galley/src/Galley/Monad.hs | 1 - services/galley/src/Galley/Queue.hs | 10 +- services/galley/src/Galley/Types/UserList.hs | 4 +- services/galley/src/Galley/Validation.hs | 6 +- services/galley/test/integration/API.hs | 6 +- .../test/integration/API/Federation/Util.hs | 12 +- .../galley/test/integration/API/MLS/Mocks.hs | 8 +- .../galley/test/integration/API/MLS/Util.hs | 76 +- services/galley/test/integration/API/Roles.hs | 4 +- services/galley/test/integration/API/SQS.hs | 14 +- services/galley/test/integration/API/Teams.hs | 28 +- .../test/integration/API/Teams/LegalHold.hs | 22 +- .../API/Teams/LegalHold/DisabledByDefault.hs | 20 +- .../integration/API/Teams/LegalHold/Util.hs | 50 +- services/galley/test/integration/API/Util.hs | 226 ++--- .../test/integration/API/Util/TeamFeature.hs | 4 +- services/galley/test/integration/TestSetup.hs | 21 +- .../test/unit/Test/Galley/Intra/User.hs | 2 +- .../migrate-data/src/Gundeck/DataMigration.hs | 2 +- .../src/Gundeck/DataMigration/Types.hs | 4 +- .../src/V1_DeleteApnsVoipTokens.hs | 4 +- services/gundeck/src/Gundeck/Aws.hs | 8 +- services/gundeck/src/Gundeck/Aws/Arn.hs | 17 +- services/gundeck/src/Gundeck/Monad.hs | 15 +- services/gundeck/src/Gundeck/Notification.hs | 15 +- .../gundeck/src/Gundeck/Notification/Data.hs | 6 +- services/gundeck/src/Gundeck/Presence/Data.hs | 11 +- services/gundeck/src/Gundeck/Push.hs | 28 +- services/gundeck/src/Gundeck/Push/Data.hs | 8 +- .../src/Gundeck/Push/Native/Serialise.hs | 2 +- .../gundeck/src/Gundeck/Push/Websocket.hs | 16 +- services/gundeck/src/Gundeck/React.hs | 39 +- services/gundeck/src/Gundeck/Redis.hs | 2 +- .../src/Gundeck/Redis/HedisExtensions.hs | 2 +- services/gundeck/src/Gundeck/Run.hs | 2 +- .../src/Gundeck/ThreadBudget/Internal.hs | 28 +- services/gundeck/src/Gundeck/Util.hs | 2 +- .../gundeck/src/Gundeck/Util/DelayQueue.hs | 6 +- services/gundeck/src/Gundeck/Util/Redis.hs | 4 +- services/gundeck/test/integration/API.hs | 36 +- services/gundeck/test/unit/Aws/Arn.hs | 4 +- services/gundeck/test/unit/Json.hs | 2 +- services/gundeck/test/unit/MockGundeck.hs | 40 +- services/gundeck/test/unit/ThreadBudget.hs | 20 +- services/proxy/src/Proxy/API/Public.hs | 29 +- services/proxy/src/Proxy/Proxy.hs | 9 +- services/spar/default.nix | 2 + .../src/Spar/DataMigration/V2_UserV2.hs | 2 +- services/spar/spar.cabal | 1 + services/spar/src/Spar/API.hs | 25 +- services/spar/src/Spar/App.hs | 15 +- services/spar/src/Spar/Data.hs | 12 +- services/spar/src/Spar/Data/Instances.hs | 4 +- services/spar/src/Spar/Error.hs | 4 +- services/spar/src/Spar/Intra/Brig.hs | 12 +- services/spar/src/Spar/Intra/BrigApp.hs | 4 +- services/spar/src/Spar/Options.hs | 1 - services/spar/src/Spar/Scim/Auth.hs | 2 +- services/spar/src/Spar/Scim/User.hs | 32 +- services/spar/src/Spar/Sem/AReqIDStore/Mem.hs | 2 +- services/spar/src/Spar/Sem/AssIDStore/Mem.hs | 2 +- .../spar/src/Spar/Sem/DefaultSsoCode/Spec.hs | 20 +- .../src/Spar/Sem/IdPRawMetadataStore/Spec.hs | 14 +- services/spar/src/Spar/Sem/SAML2.hs | 2 +- services/spar/src/Spar/Sem/SAML2/Library.hs | 16 +- .../src/Spar/Sem/SAMLUserStore/Cassandra.hs | 16 +- .../src/Spar/Sem/ScimExternalIdStore/Spec.hs | 20 +- .../src/Spar/Sem/ScimTokenStore/Cassandra.hs | 16 +- services/spar/src/Spar/Sem/Utils.hs | 14 +- .../Spar/Sem/VerdictFormatStore/Cassandra.hs | 1 - .../src/Spar/Sem/VerdictFormatStore/Mem.hs | 2 +- .../spar/test-integration/Test/MetricsSpec.hs | 2 +- .../test-integration/Test/Spar/APISpec.hs | 26 +- .../test-integration/Test/Spar/AppSpec.hs | 2 +- .../test-integration/Test/Spar/DataSpec.hs | 1 - .../Test/Spar/Scim/UserSpec.hs | 54 +- services/spar/test-integration/Util/Core.hs | 92 +- services/spar/test-integration/Util/Email.hs | 14 +- .../spar/test-integration/Util/Invitation.hs | 6 +- services/spar/test-integration/Util/Scim.hs | 208 +++-- services/spar/test/Arbitrary.hs | 2 +- services/spar/test/Test/Spar/DataSpec.hs | 6 +- services/spar/test/Test/Spar/Scim/UserSpec.hs | 25 +- tools/db/assets/src/Assets/Lib.hs | 2 +- tools/db/find-undead/src/Work.hs | 6 +- .../db/inconsistencies/src/DanglingHandles.hs | 2 +- .../inconsistencies/src/DanglingUserKeys.hs | 2 +- .../db/inconsistencies/src/EmailLessUsers.hs | 2 +- .../db/inconsistencies/src/HandleLessUsers.hs | 2 +- tools/db/migrate-sso-feature-flag/src/Work.hs | 2 +- tools/db/move-team/src/Common.hs | 4 +- tools/db/move-team/src/Options.hs | 2 +- tools/db/move-team/src/Types.hs | 4 +- tools/db/move-team/src/Work.hs | 2 +- tools/db/phone-users/src/PhoneUsers/Lib.hs | 35 +- tools/db/phone-users/src/PhoneUsers/Types.hs | 6 +- .../db/repair-brig-clients-table/src/Work.hs | 2 +- tools/db/repair-handles/src/Options.hs | 2 +- tools/db/repair-handles/src/Work.hs | 2 +- tools/fedcalls/src/Main.hs | 2 +- tools/mlsstats/src/MlsStats/Run.hs | 8 +- tools/rex/Main.hs | 2 +- tools/stern/src/Stern/API.hs | 2 +- tools/stern/src/Stern/API/Routes.hs | 2 +- tools/stern/src/Stern/App.hs | 6 +- tools/stern/src/Stern/Intra.hs | 71 +- tools/stern/test/integration/Util.hs | 40 +- tools/test-stats/Main.hs | 2 +- 530 files changed, 4476 insertions(+), 3657 deletions(-) create mode 100644 changelog.d/5-internal/WPB-8943 diff --git a/.ormolu b/.ormolu index a427ec702a8..59d9336af2a 100644 --- a/.ormolu +++ b/.ormolu @@ -1,5 +1,15 @@ -infixr 10 .= +module Imports exports Prelude +infixl 9 .= +infixl 9 .: +infixr 4 ?~ +infixr 4 .~ +infixl 1 & infix 4 === infix 4 =/= infixr 3 !!! infixr 3 +infix 4 <$$$> +infixl 1 `bindResponse` diff --git a/changelog.d/5-internal/WPB-8943 b/changelog.d/5-internal/WPB-8943 new file mode 100644 index 00000000000..ca30b58b2ae --- /dev/null +++ b/changelog.d/5-internal/WPB-8943 @@ -0,0 +1 @@ +update nixpkgs and hence GHC version as well as some other tooling. diff --git a/deploy/dockerephemeral/docker-compose.yaml b/deploy/dockerephemeral/docker-compose.yaml index c5aa74fe889..38db77dd5a0 100644 --- a/deploy/dockerephemeral/docker-compose.yaml +++ b/deploy/dockerephemeral/docker-compose.yaml @@ -1,4 +1,3 @@ -version: '2' networks: redis: driver: bridge diff --git a/deploy/dockerephemeral/federation-v0.yaml b/deploy/dockerephemeral/federation-v0.yaml index 8ed1179b048..28e50750273 100644 --- a/deploy/dockerephemeral/federation-v0.yaml +++ b/deploy/dockerephemeral/federation-v0.yaml @@ -1,5 +1,3 @@ -version: '2.3' - networks: demo_wire: external: false diff --git a/integration/test/API/Brig.hs b/integration/test/API/Brig.hs index d304b3ed31f..362527c7a8f 100644 --- a/integration/test/API/Brig.hs +++ b/integration/test/API/Brig.hs @@ -181,7 +181,7 @@ instance Default UpdateClient where } updateClient :: - HasCallStack => + (HasCallStack) => ClientIdentity -> UpdateClient -> App Response @@ -368,7 +368,7 @@ getSelfWithVersion v user = baseRequest user Brig v "/self" >>= submit "GET" -- | https://staging-nginz-https.zinfra.io/v6/api/swagger-ui/#/default/get_self -- this is a low-level version of `getSelf` for testing some error conditions. -getSelf' :: HasCallStack => String -> String -> App Response +getSelf' :: (HasCallStack) => String -> String -> App Response getSelf' domain uid = getSelfWithVersion Versioned $ object ["domain" .= domain, "id" .= uid] data PutSelf = PutSelf @@ -462,45 +462,45 @@ postInvitation user inv = do submit "POST" $ req & addJSONObject ["email" .= email] -getApiVersions :: HasCallStack => App Response +getApiVersions :: (HasCallStack) => App Response getApiVersions = do req <- rawBaseRequest OwnDomain Brig Unversioned $ joinHttpPath ["api-version"] submit "GET" req -getSwaggerPublicTOC :: HasCallStack => App Response +getSwaggerPublicTOC :: (HasCallStack) => App Response getSwaggerPublicTOC = do req <- rawBaseRequest OwnDomain Brig Unversioned $ joinHttpPath ["api", "swagger-ui"] submit "GET" req -getSwaggerInternalTOC :: HasCallStack => App Response +getSwaggerInternalTOC :: (HasCallStack) => App Response getSwaggerInternalTOC = error "FUTUREWORK: this API end-point does not exist." -getSwaggerPublicAllUI :: HasCallStack => Int -> App Response +getSwaggerPublicAllUI :: (HasCallStack) => Int -> App Response getSwaggerPublicAllUI version = do req <- rawBaseRequest OwnDomain Brig (ExplicitVersion version) $ joinHttpPath ["api", "swagger-ui"] submit "GET" req -getSwaggerPublicAllJson :: HasCallStack => Int -> App Response +getSwaggerPublicAllJson :: (HasCallStack) => Int -> App Response getSwaggerPublicAllJson version = do req <- rawBaseRequest OwnDomain Brig (ExplicitVersion version) $ joinHttpPath ["api", "swagger.json"] submit "GET" req -getSwaggerInternalUI :: HasCallStack => String -> App Response +getSwaggerInternalUI :: (HasCallStack) => String -> App Response getSwaggerInternalUI service = do req <- rawBaseRequest OwnDomain Brig Unversioned $ joinHttpPath ["api-internal", "swagger-ui", service] submit "GET" req -getSwaggerInternalJson :: HasCallStack => String -> App Response +getSwaggerInternalJson :: (HasCallStack) => String -> App Response getSwaggerInternalJson service = do req <- rawBaseRequest OwnDomain Nginz Unversioned $ @@ -610,7 +610,7 @@ updateService dom providerId serviceId mAcceptHeader newName = do $ req updateServiceConn :: - MakesValue conn => + (MakesValue conn) => -- | providerId String -> -- | serviceId @@ -662,7 +662,7 @@ getCallsConfigV2 user = do req <- baseRequest user Brig Versioned $ joinHttpPath ["calls", "config", "v2"] submit "GET" req -addBot :: MakesValue user => user -> String -> String -> String -> App Response +addBot :: (MakesValue user) => user -> String -> String -> String -> App Response addBot user providerId serviceId convId = do req <- baseRequest user Brig Versioned $ joinHttpPath ["conversations", convId, "bots"] submit "POST" $ diff --git a/integration/test/API/BrigInternal.hs b/integration/test/API/BrigInternal.hs index e153f0e7e5b..5fbfd5cf2e5 100644 --- a/integration/test/API/BrigInternal.hs +++ b/integration/test/API/BrigInternal.hs @@ -242,7 +242,8 @@ getClientsFull :: (HasCallStack, MakesValue users, MakesValue uid) => uid -> use getClientsFull user users = do val <- make users baseRequest user Brig Unversioned do joinHttpPath ["i", "clients", "full"] - >>= submit "POST" . addJSONObject ["users" .= val] + >>= submit "POST" + . addJSONObject ["users" .= val] -- | https://staging-nginz-https.zinfra.io/api-internal/swagger-ui/brig/#/brig/post_i_ejpd_request getEJPDInfo :: (HasCallStack, MakesValue dom) => dom -> [String] -> String -> App Response diff --git a/integration/test/API/Cargohold.hs b/integration/test/API/Cargohold.hs index 8baa18c4148..e21e26fed81 100644 --- a/integration/test/API/Cargohold.hs +++ b/integration/test/API/Cargohold.hs @@ -19,19 +19,19 @@ getFederationAsset :: (HasCallStack, MakesValue asset) => asset -> App Response getFederationAsset ga = do req <- rawBaseRequestF OwnDomain cargohold "federation/get-asset" bdy <- make ga - submit "POST" $ - req - & addBody (HTTP.RequestBodyLBS $ encode bdy) "application/json" + submit "POST" + $ req + & addBody (HTTP.RequestBodyLBS $ encode bdy) "application/json" uploadAssetV3 :: (HasCallStack, MakesValue user, MakesValue assetRetention) => user -> Bool -> assetRetention -> MIME.MIMEType -> LByteString -> App Response uploadAssetV3 user isPublic retention mimeType bdy = do uid <- user & objId req <- baseRequest user Cargohold (ExplicitVersion 1) "/assets/v3" body <- buildUploadAssetRequestBody isPublic retention bdy mimeType - submit "POST" $ - req - & zUser uid - & addBody body multipartMixedMime + submit "POST" + $ req + & zUser uid + & addBody body multipartMixedMime uploadAsset :: (HasCallStack, MakesValue user) => user -> App Response uploadAsset = flip uploadFreshAsset "Hello World!" @@ -40,23 +40,23 @@ uploadProviderAsset :: (HasCallStack, MakesValue domain) => domain -> String -> uploadProviderAsset domain pid payload = do req <- rawBaseRequest domain Cargohold Versioned $ joinHttpPath ["provider", "assets"] bdy <- txtAsset payload - submit "POST" $ - req - & zProvider pid - & zType "provider" - & addBody bdy multipartMixedMime + submit "POST" + $ req + & zProvider pid + & zType "provider" + & addBody bdy multipartMixedMime uploadFreshAsset :: (HasCallStack, MakesValue user) => user -> String -> App Response uploadFreshAsset user payload = do uid <- user & objId req <- baseRequest user Cargohold Versioned "/assets" bdy <- txtAsset payload - submit "POST" $ - req - & zUser uid - & addBody bdy multipartMixedMime + submit "POST" + $ req + & zUser uid + & addBody bdy multipartMixedMime -txtAsset :: HasCallStack => String -> App HTTP.RequestBody +txtAsset :: (HasCallStack) => String -> App HTTP.RequestBody txtAsset payload = buildUploadAssetRequestBody True @@ -99,7 +99,7 @@ instance {-# OVERLAPS #-} IsAssetLocation String where locationPathFragment = pure -- Pick out a path from the value -instance MakesValue loc => IsAssetLocation loc where +instance (MakesValue loc) => IsAssetLocation loc where locationPathFragment v = qualifiedFrag `catch` (\(_e :: SomeException) -> unqualifiedFrag) where @@ -137,7 +137,7 @@ downloadAsset user assetDomain key zHostHeader trans = do domain <- objDomain assetDomain key' <- asString key req <- baseRequest user Cargohold Versioned $ "/assets/" ++ domain ++ "/" ++ key' - submit "GET" $ - req - & zHost zHostHeader - & trans + submit "GET" + $ req + & zHost zHostHeader + & trans diff --git a/integration/test/API/Common.hs b/integration/test/API/Common.hs index cdc4b11c2d4..c07816cc5b4 100644 --- a/integration/test/API/Common.hs +++ b/integration/test/API/Common.hs @@ -66,11 +66,11 @@ randomClientId = do mkArray :: [a] -> Array.Array Int a mkArray l = Array.listArray (0, length l - 1) l -recipient :: MakesValue u => u -> App Value +recipient :: (MakesValue u) => u -> App Value recipient u = do uid <- u %. "id" - pure $ - object + pure + $ object [ "user_id" .= uid, "route" .= "any", "clients" .= ([] :: [String]) diff --git a/integration/test/API/Galley.hs b/integration/test/API/Galley.hs index c744ad12258..d4c4b6e366e 100644 --- a/integration/test/API/Galley.hs +++ b/integration/test/API/Galley.hs @@ -59,9 +59,9 @@ allowGuests cc = instance MakesValue CreateConv where make cc = do quids <- for (cc.qualifiedUsers) objQidObject - pure $ - Aeson.object $ - ( [ "qualified_users" .= quids, + pure + $ Aeson.object + $ ( [ "qualified_users" .= quids, "conversation_role" .= cc.newUsersRole, "protocol" .= cc.protocol ] @@ -158,8 +158,8 @@ getSubConversation :: getSubConversation user conv sub = do (cnvDomain, cnvId) <- objQid conv req <- - baseRequest user Galley Versioned $ - joinHttpPath + baseRequest user Galley Versioned + $ joinHttpPath [ "conversations", cnvDomain, cnvId, @@ -179,8 +179,8 @@ deleteSubConversation user sub = do groupId <- sub %. "group_id" & asString epoch :: Int <- sub %. "epoch" & asIntegral req <- - baseRequest user Galley Versioned $ - joinHttpPath ["conversations", domain, convId, "subconversations", subId] + baseRequest user Galley Versioned + $ joinHttpPath ["conversations", domain, convId, "subconversations", subId] submit "DELETE" $ req & addJSONObject ["group_id" .= groupId, "epoch" .= epoch] leaveSubConversation :: @@ -192,8 +192,8 @@ leaveSubConversation user sub = do (conv, Just subId) <- objSubConv sub (domain, convId) <- objQid conv req <- - baseRequest user Galley Versioned $ - joinHttpPath ["conversations", domain, convId, "subconversations", subId, "self"] + baseRequest user Galley Versioned + $ joinHttpPath ["conversations", domain, convId, "subconversations", subId, "self"] submit "DELETE" req getSelfConversation :: (HasCallStack, MakesValue user) => user -> App Response @@ -206,34 +206,34 @@ data ListConversationIds = ListConversationIds {pagingState :: Maybe String, siz instance Default ListConversationIds where def = ListConversationIds Nothing Nothing -listConversationIds :: MakesValue user => user -> ListConversationIds -> App Response +listConversationIds :: (MakesValue user) => user -> ListConversationIds -> App Response listConversationIds user args = do req <- baseRequest user Galley Versioned "/conversations/list-ids" - submit "POST" $ - req - & addJSONObject - ( ["paging_state" .= s | s <- toList args.pagingState] - <> ["size" .= s | s <- toList args.size] - ) + submit "POST" + $ req + & addJSONObject + ( ["paging_state" .= s | s <- toList args.pagingState] + <> ["size" .= s | s <- toList args.size] + ) -listConversations :: MakesValue user => user -> [Value] -> App Response +listConversations :: (MakesValue user) => user -> [Value] -> App Response listConversations user cnvs = do req <- baseRequest user Galley Versioned "/conversations/list" - submit "POST" $ - req - & addJSONObject ["qualified_ids" .= cnvs] + submit "POST" + $ req + & addJSONObject ["qualified_ids" .= cnvs] getMLSPublicKeys :: (HasCallStack, MakesValue user) => user -> App Response getMLSPublicKeys user = do req <- baseRequest user Galley Versioned "/mls/public-keys" submit "GET" req -postMLSMessage :: HasCallStack => ClientIdentity -> ByteString -> App Response +postMLSMessage :: (HasCallStack) => ClientIdentity -> ByteString -> App Response postMLSMessage cid msg = do req <- baseRequest cid Galley Versioned "/mls/messages" submit "POST" (addMLS msg req) -postMLSCommitBundle :: HasCallStack => ClientIdentity -> ByteString -> App Response +postMLSCommitBundle :: (HasCallStack) => ClientIdentity -> ByteString -> App Response postMLSCommitBundle cid msg = do req <- baseRequest cid Galley Versioned "/mls/commit-bundles" submit "POST" (addMLS msg req) @@ -253,24 +253,24 @@ mkProteusRecipients :: (HasCallStack, MakesValue domain, MakesValue user, MakesV mkProteusRecipients dom userClients msg = do userDomain <- asString =<< objDomain dom userEntries <- mapM mkUserEntry userClients - pure $ - Proto.defMessage - & #domain .~ fromString userDomain - & #entries .~ userEntries + pure + $ Proto.defMessage + & #domain .~ fromString userDomain + & #entries .~ userEntries where mkUserEntry (user, clients) = do userId <- LBS.toStrict . UUID.toByteString . fromJust . UUID.fromString <$> objId user clientEntries <- mapM mkClientEntry clients - pure $ - Proto.defMessage - & #user . #uuid .~ userId - & #clients .~ clientEntries + pure + $ Proto.defMessage + & #user . #uuid .~ userId + & #clients .~ clientEntries mkClientEntry client = do clientId <- (^?! hex) <$> objId client - pure $ - Proto.defMessage - & #client . #client .~ clientId - & #text .~ fromString msg + pure + $ Proto.defMessage + & #client . #client .~ clientId + & #text .~ fromString msg getGroupInfo :: (HasCallStack, MakesValue user, MakesValue conv) => @@ -330,8 +330,8 @@ getMLSOne2OneConversation :: getMLSOne2OneConversation self other = do (domain, uid) <- objQid other req <- - baseRequest self Galley Versioned $ - joinHttpPath ["conversations", "one2one", domain, uid] + baseRequest self Galley Versioned + $ joinHttpPath ["conversations", "one2one", domain, uid] submit "GET" req getGroupClients :: @@ -375,12 +375,12 @@ addMembers usr qcnv opts = do Galley (maybe Versioned ExplicitVersion opts.version) (joinHttpPath path) - submit "POST" $ - req - & addJSONObject - ( ["qualified_users" .= qUsers] - <> ["conversation_role" .= r | r <- toList opts.role] - ) + submit "POST" + $ req + & addJSONObject + ( ["qualified_users" .= qUsers] + <> ["conversation_role" .= r | r <- toList opts.role] + ) removeMember :: (HasCallStack, MakesValue remover, MakesValue conv, MakesValue removed) => remover -> conv -> removed -> App Response removeMember remover qcnv removed = do @@ -681,7 +681,7 @@ putLegalholdStatus tid usr status = do baseRequest usr Galley Versioned (joinHttpPath ["teams", tidStr, "features", "legalhold"]) >>= submit "PUT" - . addJSONObject ["status" .= status, "ttl" .= "unlimited"] + . addJSONObject ["status" .= status, "ttl" .= "unlimited"] -- | https://staging-nginz-https.zinfra.io/v5/api/swagger-ui/#/default/get_feature_configs getFeatureConfigs :: (HasCallStack, MakesValue user) => user -> App Response diff --git a/integration/test/API/GalleyInternal.hs b/integration/test/API/GalleyInternal.hs index 59a0880411f..ef0f773d426 100644 --- a/integration/test/API/GalleyInternal.hs +++ b/integration/test/API/GalleyInternal.hs @@ -63,7 +63,8 @@ getFederationStatus user domains = req <- baseRequest user Galley Unversioned $ joinHttpPath ["i", "federation-status"] submit "GET" - $ req & addJSONObject ["domains" .= domainList] + $ req + & addJSONObject ["domains" .= domainList] -- | https://staging-nginz-https.zinfra.io/api-internal/swagger-ui/galley/#/galley/put_i_legalhold_whitelisted_teams__tid_ legalholdWhitelistTeam :: (HasCallStack, MakesValue uid, MakesValue tid) => tid -> uid -> App Response diff --git a/integration/test/API/Gundeck.hs b/integration/test/API/Gundeck.hs index d44603ca2aa..15af3905074 100644 --- a/integration/test/API/Gundeck.hs +++ b/integration/test/API/Gundeck.hs @@ -47,8 +47,8 @@ getNotification :: getNotification user opts nid = do n <- nid & asString req <- - baseRequest user Gundeck Versioned $ - joinHttpPath ["notifications", n] + baseRequest user Gundeck Versioned + $ joinHttpPath ["notifications", n] submit "GET" $ req & addQueryParams [("client", c) | c <- toList opts.client] getLastNotification :: @@ -126,8 +126,8 @@ postPushToken user token = do listPushTokens :: (MakesValue user) => user -> App Response listPushTokens user = do req <- - baseRequest user Gundeck Versioned $ - joinHttpPath ["/push/tokens"] + baseRequest user Gundeck Versioned + $ joinHttpPath ["/push/tokens"] submit "GET" req unregisterClient :: @@ -138,6 +138,6 @@ unregisterClient :: unregisterClient user client = do cid <- asString client req <- - baseRequest user Gundeck Unversioned $ - joinHttpPath ["/i/clients", cid] + baseRequest user Gundeck Unversioned + $ joinHttpPath ["/i/clients", cid] submit "DELETE" req diff --git a/integration/test/API/GundeckInternal.hs b/integration/test/API/GundeckInternal.hs index 907331a98ef..a120734c17f 100644 --- a/integration/test/API/GundeckInternal.hs +++ b/integration/test/API/GundeckInternal.hs @@ -22,8 +22,9 @@ getPresence :: getPresence u = do uid <- u %. "id" & asString req <- - baseRequest u Gundeck Unversioned $ - "/i/presences/" <> uid + baseRequest u Gundeck Unversioned + $ "/i/presences/" + <> uid submit "GET" req unregisterUser :: diff --git a/integration/test/API/Nginz.hs b/integration/test/API/Nginz.hs index d963b79fe8d..ac248fd544f 100644 --- a/integration/test/API/Nginz.hs +++ b/integration/test/API/Nginz.hs @@ -53,12 +53,12 @@ uploadProviderAsset :: (HasCallStack, MakesValue domain) => domain -> String -> uploadProviderAsset domain cookie payload = do req <- rawBaseRequest domain Nginz Versioned $ joinHttpPath ["provider", "assets"] bdy <- txtAsset payload - submit "POST" $ - req - & setCookie cookie - & addBody bdy multipartMixedMime + submit "POST" + $ req + & setCookie cookie + & addBody bdy multipartMixedMime -txtAsset :: HasCallStack => String -> App HTTP.RequestBody +txtAsset :: (HasCallStack) => String -> App HTTP.RequestBody txtAsset payload = buildUploadAssetRequestBody True diff --git a/integration/test/MLS/Util.hs b/integration/test/MLS/Util.hs index 2a59f980579..246520ca2f2 100644 --- a/integration/test/MLS/Util.hs +++ b/integration/test/MLS/Util.hs @@ -122,7 +122,7 @@ mlscli cid args mbstdin = do pure out -runCli :: HasCallStack => FilePath -> [String] -> Maybe ByteString -> App ByteString +runCli :: (HasCallStack) => FilePath -> [String] -> Maybe ByteString -> App ByteString runCli store args mStdin = spawn ( proc @@ -180,7 +180,7 @@ uploadNewKeyPackage cid = do pure ref -generateKeyPackage :: HasCallStack => ClientIdentity -> App (ByteString, String) +generateKeyPackage :: (HasCallStack) => ClientIdentity -> App (ByteString, String) generateKeyPackage cid = do suite <- (.ciphersuite) <$> getMLSState kp <- mlscli cid ["key-package", "create", "--ciphersuite", suite.code] Nothing @@ -757,7 +757,7 @@ createApplicationMessage cid messageContent = do setMLSCiphersuite :: Ciphersuite -> App () setMLSCiphersuite suite = modifyMLSState $ \mls -> mls {ciphersuite = suite} -withCiphersuite :: HasCallStack => Ciphersuite -> App a -> App a +withCiphersuite :: (HasCallStack) => Ciphersuite -> App a -> App a withCiphersuite suite action = do suite0 <- (.ciphersuite) <$> getMLSState setMLSCiphersuiteIO <- appToIOKleisli setMLSCiphersuite @@ -785,7 +785,7 @@ leaveCurrentConv cid = do { members = Set.difference mls.members (Set.singleton cid) } -getCurrentConv :: HasCallStack => ClientIdentity -> App Value +getCurrentConv :: (HasCallStack) => ClientIdentity -> App Value getCurrentConv cid = do mls <- getMLSState (conv, mSubId) <- objSubConv mls.convId diff --git a/integration/test/Notifications.hs b/integration/test/Notifications.hs index 3278a94c35e..13dd5a0fb35 100644 --- a/integration/test/Notifications.hs +++ b/integration/test/Notifications.hs @@ -27,8 +27,8 @@ assertNoNotifications u uc since0 p = do notifs <- getNotifications u def {client = Just ucid, since = since} `bindResponse` asList - . (%. "notifications") - . (.json) + . (%. "notifications") + . (.json) partitionM p notifs >>= \case ([], nonMatching) -> threadDelay 1_000 *> case nonMatching of @@ -36,8 +36,8 @@ assertNoNotifications u uc since0 p = do _ -> go Nothing (matching, _) -> do pj <- prettyJSON matching - assertFailure $ - unlines + assertFailure + $ unlines [ "Expected no matching events but got:", pj ] @@ -96,27 +96,27 @@ awaitNotification user client lastNotifId selector = do since0 <- mapM objId lastNotifId head <$> awaitNotifications user client since0 1 selector -isDeleteUserNotif :: MakesValue a => a -> App Bool +isDeleteUserNotif :: (MakesValue a) => a -> App Bool isDeleteUserNotif n = nPayload n %. "type" `isEqual` "user.delete" -isFeatureConfigUpdateNotif :: MakesValue a => a -> App Bool +isFeatureConfigUpdateNotif :: (MakesValue a) => a -> App Bool isFeatureConfigUpdateNotif n = nPayload n %. "type" `isEqual` "feature-config.update" -isNewMessageNotif :: MakesValue a => a -> App Bool +isNewMessageNotif :: (MakesValue a) => a -> App Bool isNewMessageNotif n = fieldEquals n "payload.0.type" "conversation.otr-message-add" -isNewMLSMessageNotif :: MakesValue a => a -> App Bool +isNewMLSMessageNotif :: (MakesValue a) => a -> App Bool isNewMLSMessageNotif n = fieldEquals n "payload.0.type" "conversation.mls-message-add" -isWelcomeNotif :: MakesValue a => a -> App Bool +isWelcomeNotif :: (MakesValue a) => a -> App Bool isWelcomeNotif n = fieldEquals n "payload.0.type" "conversation.mls-welcome" -isMemberJoinNotif :: MakesValue a => a -> App Bool +isMemberJoinNotif :: (MakesValue a) => a -> App Bool isMemberJoinNotif n = fieldEquals n "payload.0.type" "conversation.member-join" -isConvLeaveNotif :: MakesValue a => a -> App Bool +isConvLeaveNotif :: (MakesValue a) => a -> App Bool isConvLeaveNotif n = fieldEquals n "payload.0.type" "conversation.member-leave" isConvLeaveNotifWithLeaver :: (MakesValue user, MakesValue a) => user -> a -> App Bool @@ -151,46 +151,46 @@ isConvAccessUpdateNotif :: (HasCallStack, MakesValue n) => n -> App Bool isConvAccessUpdateNotif n = fieldEquals n "payload.0.type" "conversation.access-update" -isConvCreateNotif :: MakesValue a => a -> App Bool +isConvCreateNotif :: (MakesValue a) => a -> App Bool isConvCreateNotif n = fieldEquals n "payload.0.type" "conversation.create" -- | like 'isConvCreateNotif' but excludes self conversations -isConvCreateNotifNotSelf :: MakesValue a => a -> App Bool +isConvCreateNotifNotSelf :: (MakesValue a) => a -> App Bool isConvCreateNotifNotSelf n = fieldEquals n "payload.0.type" "conversation.create" &&~ do not <$> fieldEquals n "payload.0.data.access" ["private"] -isConvDeleteNotif :: MakesValue a => a -> App Bool +isConvDeleteNotif :: (MakesValue a) => a -> App Bool isConvDeleteNotif n = fieldEquals n "payload.0.type" "conversation.delete" -notifTypeIsEqual :: MakesValue a => String -> a -> App Bool +notifTypeIsEqual :: (MakesValue a) => String -> a -> App Bool notifTypeIsEqual typ n = nPayload n %. "type" `isEqual` typ -isTeamMemberLeaveNotif :: MakesValue a => a -> App Bool +isTeamMemberLeaveNotif :: (MakesValue a) => a -> App Bool isTeamMemberLeaveNotif = notifTypeIsEqual "team.member-leave" -isUserActivateNotif :: MakesValue a => a -> App Bool +isUserActivateNotif :: (MakesValue a) => a -> App Bool isUserActivateNotif = notifTypeIsEqual "user.activate" -isUserClientAddNotif :: MakesValue a => a -> App Bool +isUserClientAddNotif :: (MakesValue a) => a -> App Bool isUserClientAddNotif = notifTypeIsEqual "user.client-add" -isUserClientRemoveNotif :: MakesValue a => a -> App Bool +isUserClientRemoveNotif :: (MakesValue a) => a -> App Bool isUserClientRemoveNotif = notifTypeIsEqual "user.client-remove" -isUserLegalholdRequestNotif :: MakesValue a => a -> App Bool +isUserLegalholdRequestNotif :: (MakesValue a) => a -> App Bool isUserLegalholdRequestNotif = notifTypeIsEqual "user.legalhold-request" -isUserLegalholdEnabledNotif :: MakesValue a => a -> App Bool +isUserLegalholdEnabledNotif :: (MakesValue a) => a -> App Bool isUserLegalholdEnabledNotif = notifTypeIsEqual "user.legalhold-enable" -isUserLegalholdDisabledNotif :: MakesValue a => a -> App Bool +isUserLegalholdDisabledNotif :: (MakesValue a) => a -> App Bool isUserLegalholdDisabledNotif = notifTypeIsEqual "user.legalhold-disable" -isUserConnectionNotif :: MakesValue a => a -> App Bool +isUserConnectionNotif :: (MakesValue a) => a -> App Bool isUserConnectionNotif = notifTypeIsEqual "user.connection" -isConnectionNotif :: MakesValue a => String -> a -> App Bool +isConnectionNotif :: (MakesValue a) => String -> a -> App Bool isConnectionNotif status n = -- NB: -- (&&) <$> (print "hello" *> pure False) <*> fail "bla" === _|_ @@ -212,8 +212,8 @@ assertLeaveNotification :: kickedUser -> App () assertLeaveNotification fromUser conv user client leaver = - void $ - awaitNotification + void + $ awaitNotification user client noValue @@ -225,7 +225,7 @@ assertLeaveNotification fromUser conv user client leaver = ] ) -assertConvUserDeletedNotif :: MakesValue leaverId => WebSocket -> leaverId -> App () +assertConvUserDeletedNotif :: (MakesValue leaverId) => WebSocket -> leaverId -> App () assertConvUserDeletedNotif ws leaverId = do n <- awaitMatch isConvLeaveNotif ws nPayload n %. "data.qualified_user_ids.0" `shouldMatch` leaverId diff --git a/integration/test/SetupHelpers.hs b/integration/test/SetupHelpers.hs index cc25f9599cb..63e4c61b786 100644 --- a/integration/test/SetupHelpers.hs +++ b/integration/test/SetupHelpers.hs @@ -173,7 +173,7 @@ addUserToTeam u = do -- | Create a user on the given domain, such that the 1-1 conversation with -- 'other' resides on 'convDomain'. This connects the two users as a side-effect. -createMLSOne2OnePartner :: MakesValue user => Domain -> user -> Domain -> App Value +createMLSOne2OnePartner :: (MakesValue user) => Domain -> user -> Domain -> App Value createMLSOne2OnePartner domain other convDomain = loop where loop = do @@ -189,22 +189,22 @@ createMLSOne2OnePartner domain other convDomain = loop else loop -- Copied from `src/CargoHold/API/V3.hs` and inlined to avoid pulling in `types-common` -randomToken :: HasCallStack => App String +randomToken :: (HasCallStack) => App String randomToken = unpack . B64Url.encode <$> liftIO (getRandomBytes 16) data TokenLength = GCM | APNS -randomSnsToken :: HasCallStack => TokenLength -> App String +randomSnsToken :: (HasCallStack) => TokenLength -> App String randomSnsToken = \case GCM -> mkTok 16 APNS -> mkTok 32 where mkTok = fmap (Text.unpack . decodeUtf8 . Base16.encode) . randomBytes -randomId :: HasCallStack => App String +randomId :: (HasCallStack) => App String randomId = liftIO (show <$> nextRandom) -randomUUIDv1 :: HasCallStack => App String +randomUUIDv1 :: (HasCallStack) => App String randomUUIDv1 = liftIO (show . fromJust <$> nextUUID) randomUserId :: (HasCallStack, MakesValue domain) => domain -> App Value @@ -213,7 +213,7 @@ randomUserId domain = do uid <- randomId pure $ object ["id" .= uid, "domain" .= d] -withFederatingBackendsAllowDynamic :: HasCallStack => ((String, String, String) -> App a) -> App a +withFederatingBackendsAllowDynamic :: (HasCallStack) => ((String, String, String) -> App a) -> App a withFederatingBackendsAllowDynamic k = do let setFederationConfig = setField "optSettings.setFederationStrategy" "allowDynamic" @@ -228,7 +228,7 @@ withFederatingBackendsAllowDynamic k = do -- | Create two users on different domains such that the one-to-one -- conversation, once finalised, will be hosted on the backend given by the -- input domain. -createOne2OneConversation :: HasCallStack => Domain -> App (Value, Value, Value) +createOne2OneConversation :: (HasCallStack) => Domain -> App (Value, Value, Value) createOne2OneConversation owningDomain = do owningUser <- randomUser owningDomain def domainName <- owningUser %. "qualified_id.domain" @@ -263,7 +263,7 @@ toConvType = \case -- | Fetch the one-to-one conversation between the two users that is in one of -- two possible states. -getOne2OneConversation :: HasCallStack => Value -> Value -> One2OneConvState -> App Value +getOne2OneConversation :: (HasCallStack) => Value -> Value -> One2OneConvState -> App Value getOne2OneConversation user1 user2 cnvState = do l <- getAllConvs user1 let isWith users c = do @@ -326,14 +326,14 @@ setUpLHDevice tid alice bob lhPort = do approveLegalHoldDevice tid bob defPassword >>= assertStatus 200 -lhDeviceIdOf :: MakesValue user => user -> App String +lhDeviceIdOf :: (MakesValue user) => user -> App String lhDeviceIdOf bob = do bobId <- objId bob getClientsFull bob [bobId] `bindResponse` \resp -> do resp.json %. bobId & asList - >>= filterM \val -> (== "legalhold") <$> (val %. "type" & asString) + >>= filterM \val -> (== "legalhold") <$> (val %. "type" & asString) >>= assertOne >>= (%. "id") >>= asString diff --git a/integration/test/Test/AccessUpdate.hs b/integration/test/Test/AccessUpdate.hs index 1d9ad94ad23..ad2f12a978b 100644 --- a/integration/test/Test/AccessUpdate.hs +++ b/integration/test/Test/AccessUpdate.hs @@ -42,7 +42,7 @@ testBaz = pure () -- The test asserts that, among others, remote users are removed from a -- conversation when an access update occurs that disallows guests from -- accessing. -testAccessUpdateGuestRemoved :: HasCallStack => App () +testAccessUpdateGuestRemoved :: (HasCallStack) => App () testAccessUpdateGuestRemoved = do (alice, tid, [bob]) <- createTeam OwnDomain 2 charlie <- randomUser OwnDomain def @@ -73,7 +73,7 @@ testAccessUpdateGuestRemoved = do res.status `shouldMatchInt` 200 res.json %. "members.others.0.qualified_id" `shouldMatch` objQidObject bob -testAccessUpdateGuestRemovedUnreachableRemotes :: HasCallStack => App () +testAccessUpdateGuestRemovedUnreachableRemotes :: (HasCallStack) => App () testAccessUpdateGuestRemovedUnreachableRemotes = do resourcePool <- asks resourcePool (alice, tid, [bob]) <- createTeam OwnDomain 2 @@ -109,7 +109,7 @@ testAccessUpdateGuestRemovedUnreachableRemotes = do res.status `shouldMatchInt` 200 res.json %. "members.others.0.qualified_id" `shouldMatch` objQidObject bob -testAccessUpdateWithRemotes :: HasCallStack => App () +testAccessUpdateWithRemotes :: (HasCallStack) => App () testAccessUpdateWithRemotes = do [alice, bob, charlie] <- createUsers [OwnDomain, OtherDomain, OwnDomain] connectTwoUsers alice bob diff --git a/integration/test/Test/AssetDownload.hs b/integration/test/Test/AssetDownload.hs index 68b60c85453..97fc9c94ff5 100644 --- a/integration/test/Test/AssetDownload.hs +++ b/integration/test/Test/AssetDownload.hs @@ -5,7 +5,7 @@ import GHC.Stack import SetupHelpers import Testlib.Prelude -testDownloadAsset :: HasCallStack => App () +testDownloadAsset :: (HasCallStack) => App () testDownloadAsset = do user <- randomUser OwnDomain def @@ -19,7 +19,7 @@ testDownloadAsset = do ("Expect 'Hello World!' as text asset content. Got: " ++ show resp.body) (resp.body == fromString "Hello World!") -testDownloadAssetMultiIngressS3DownloadUrl :: HasCallStack => App () +testDownloadAssetMultiIngressS3DownloadUrl :: (HasCallStack) => App () testDownloadAssetMultiIngressS3DownloadUrl = do user <- randomUser OwnDomain def @@ -63,14 +63,14 @@ testDownloadAssetMultiIngressS3DownloadUrl = do modifyConfig = def { cargoholdCfg = - setField "aws.multiIngress" $ - object + setField "aws.multiIngress" + $ object [ "red.example.com" .= "http://s3-download.red.example.com", "green.example.com" .= "http://s3-download.green.example.com" ] } - doUploadAsset :: HasCallStack => Value -> App Value + doUploadAsset :: (HasCallStack) => Value -> App Value doUploadAsset user = bindResponse (uploadAsset user) $ \resp -> do resp.status `shouldMatchInt` 201 resp.json %. "key" diff --git a/integration/test/Test/AssetUpload.hs b/integration/test/Test/AssetUpload.hs index d55eadc83c1..c581fd03b2f 100644 --- a/integration/test/Test/AssetUpload.hs +++ b/integration/test/Test/AssetUpload.hs @@ -5,19 +5,19 @@ import API.Cargohold import SetupHelpers import Testlib.Prelude -testAssetUploadUnverifiedUser :: HasCallStack => App () +testAssetUploadUnverifiedUser :: (HasCallStack) => App () testAssetUploadUnverifiedUser = do user <- randomUser OwnDomain $ def {activate = False} bindResponse (uploadAsset user) $ \resp -> do resp.status `shouldMatchInt` 403 -testAssetUploadVerifiedUser :: HasCallStack => App () +testAssetUploadVerifiedUser :: (HasCallStack) => App () testAssetUploadVerifiedUser = do user <- randomUser OwnDomain def bindResponse (uploadAsset user) $ \resp -> do resp.status `shouldMatchInt` 201 -testAssetUploadUnknownUser :: HasCallStack => App () +testAssetUploadUnknownUser :: (HasCallStack) => App () testAssetUploadUnknownUser = do uid <- randomId domain <- make OwnDomain diff --git a/integration/test/Test/Bot.hs b/integration/test/Test/Bot.hs index ff399e98fc7..b635b9e0acd 100644 --- a/integration/test/Test/Bot.hs +++ b/integration/test/Test/Bot.hs @@ -103,8 +103,8 @@ withBotWithSettings settings k = do provider <- setupProvider alice def {newProviderEmail = email, newProviderPassword = Just defPassword} providerId <- provider %. "id" & asString service <- - newService OwnDomain providerId $ - def {newServiceUrl = "https://" <> host <> ":" <> show port, newServiceKey = cs settings.publicKey} + newService OwnDomain providerId + $ def {newServiceUrl = "https://" <> host <> ":" <> show port, newServiceKey = cs settings.publicKey} serviceId <- asString $ service %. "id" conv <- getJSON 201 =<< postConversation alice defProteus convId <- conv %. "id" & asString @@ -138,8 +138,8 @@ onBotCreate chan _headers _req k = do writeChan chan BotCreated lpk <- getLastPrekey k $ responseLBS status201 mempty do - Aeson.encode $ - object + Aeson.encode + $ object [ "prekeys" .= pks, "last_prekey" .= lpk ] diff --git a/integration/test/Test/Brig.hs b/integration/test/Test/Brig.hs index 0feb154388e..4839e36b286 100644 --- a/integration/test/Test/Brig.hs +++ b/integration/test/Test/Brig.hs @@ -15,17 +15,17 @@ import Testlib.Assertions import Testlib.Prelude import UnliftIO.Temporary -testCrudFederationRemotes :: HasCallStack => App () +testCrudFederationRemotes :: (HasCallStack) => App () testCrudFederationRemotes = do otherDomain <- asString OtherDomain withModifiedBackend def $ \ownDomain -> do - let parseFedConns :: HasCallStack => Response -> App [Value] + let parseFedConns :: (HasCallStack) => Response -> App [Value] parseFedConns resp = -- Pick out the list of federation domain configs getJSON 200 resp %. "remotes" & asList - -- Enforce that the values are objects and not something else - >>= traverse (fmap Object . asObject) + -- Enforce that the values are objects and not something else + >>= traverse (fmap Object . asObject) addTest :: (MakesValue fedConn, Ord fedConn2, ToJSON fedConn2, MakesValue fedConn2, HasCallStack) => fedConn -> [fedConn2] -> App () addTest fedConn want = do @@ -61,7 +61,7 @@ testCrudFederationRemotes = do -- update updateTest (BrigI.domain remote1) remote1' [cfgRemotesExpect, remote1'] -testCrudOAuthClient :: HasCallStack => App () +testCrudOAuthClient :: (HasCallStack) => App () testCrudOAuthClient = do user <- randomUser OwnDomain def let appName = "foobar" @@ -84,7 +84,7 @@ testCrudOAuthClient = do bindResponse (BrigI.getOAuthClient user clientId) $ \resp -> do resp.status `shouldMatchInt` 404 -testCrudFederationRemoteTeams :: HasCallStack => App () +testCrudFederationRemoteTeams :: (HasCallStack) => App () testCrudFederationRemoteTeams = do (_, tid, _) <- createTeam OwnDomain 1 (_, tid2, _) <- createTeam OwnDomain 1 @@ -129,7 +129,7 @@ testCrudFederationRemoteTeams = do remoteTeams <- forM l (\e -> e %. "team_id" & asString) when (any (\t -> t `notElem` remoteTeams) tids) $ assertFailure "Expected response to contain all of the teams" -testSFTCredentials :: HasCallStack => App () +testSFTCredentials :: (HasCallStack) => App () testSFTCredentials = do let ttl = (60 :: Int) withSystemTempFile "sft-secret" $ \secretFile secretHandle -> do @@ -164,7 +164,7 @@ testSFTCredentials = do when (take 2 (parts !! 4) /= "r=") $ assertFailure "missing random data identifier" for_ parts $ \part -> when (length part < 3) $ assertFailure ("value missing for " <> part) -testSFTNoCredentials :: HasCallStack => App () +testSFTNoCredentials :: (HasCallStack) => App () testSFTNoCredentials = withModifiedBackend ( def { brigCfg = @@ -184,7 +184,7 @@ testSFTNoCredentials = withModifiedBackend usrM <- lookupField s "username" when (isJust usrM) $ assertFailure "should not generate username" -testSFTFederation :: HasCallStack => App () +testSFTFederation :: (HasCallStack) => App () testSFTFederation = do withModifiedBackend ( def diff --git a/integration/test/Test/Cargohold/API.hs b/integration/test/Test/Cargohold/API.hs index 25f3c4956d9..c6984bf57ee 100644 --- a/integration/test/Test/Cargohold/API.hs +++ b/integration/test/Test/Cargohold/API.hs @@ -42,14 +42,14 @@ import UnliftIO.Concurrent -------------------------------------------------------------------------------- -- Simple (single-step) uploads -testSimpleRoundtrip :: HasCallStack => App () +testSimpleRoundtrip :: (HasCallStack) => App () testSimpleRoundtrip = do let def' = ["public" .= False] rets = ["eternal", "persistent", "volatile", "eternal-infrequent_access", "expiring"] sets' = fmap object $ def' : fmap (\r -> "retention" .= r : def') rets mapM_ simpleRoundtrip sets' where - simpleRoundtrip :: HasCallStack => Value -> App () + simpleRoundtrip :: (HasCallStack) => Value -> App () simpleRoundtrip sets = do uid <- randomUser OwnDomain def userId1 <- uid %. "id" & asString @@ -75,8 +75,8 @@ testSimpleRoundtrip = do Just r -> do r' <- asString r -- These retention policies never expire, so an expiration date isn't sent back - unless (r' == "eternal" || r' == "persistent" || r' == "eternal-infrequent_access") $ - assertBool "invalid expiration" (Just utc < expires') + unless (r' == "eternal" || r' == "persistent" || r' == "eternal-infrequent_access") + $ assertBool "invalid expiration" (Just utc < expires') _ -> pure () -- Lookup with token and download via redirect. r2 <- downloadAsset' uid loc tok @@ -98,7 +98,7 @@ testSimpleRoundtrip = do utc' = parseTimeOrError False defaultTimeLocale rfc822DateFormat date' :: UTCTime assertBool "bad date" (utc' >= utc) -testDownloadWithAcceptHeader :: HasCallStack => App () +testDownloadWithAcceptHeader :: (HasCallStack) => App () testDownloadWithAcceptHeader = do assetId <- randomId uid <- randomUser OwnDomain def @@ -117,7 +117,7 @@ queryItem k v r = get' :: HTTP.Request -> (HTTP.Request -> HTTP.Request) -> App Response get' r f = submit "GET" $ f r -testSimpleTokens :: HasCallStack => App () +testSimpleTokens :: (HasCallStack) => App () testSimpleTokens = do uid <- randomUser OwnDomain def uid2 <- randomUser OwnDomain def @@ -134,7 +134,8 @@ testSimpleTokens = do (key, tok) <- (,) <$> asString (r1.json %. "key") - <*> r1.json %. "token" + <*> r1.json + %. "token" -- No access without token from other user (opaque 404) downloadAsset' uid2 loc () >>= \r -> r.status `shouldMatchInt` 404 -- No access with empty token query parameter from other user (opaque 404) @@ -199,7 +200,7 @@ defAssetSettings = object defAssetSettings' -- S3 closes idle connections after ~5 seconds, before the http-client 'Manager' -- does. If such a closed connection is reused for an upload, no problems should -- occur (i.e. the closed connection should be detected before sending any data). -testSimpleS3ClosedConnectionReuse :: HasCallStack => App () +testSimpleS3ClosedConnectionReuse :: (HasCallStack) => App () testSimpleS3ClosedConnectionReuse = go >> wait >> go where wait = liftIO $ putStrLn "Waiting for S3 idle timeout ..." >> threadDelay 7000000 @@ -209,7 +210,7 @@ testSimpleS3ClosedConnectionReuse = go >> wait >> go let part2 = (MIME.Text $ cs "plain", cs $ replicate 100000 'c') uploadSimple uid sets part2 >>= \r -> r.status `shouldMatchInt` 201 -testDownloadURLOverride :: HasCallStack => App () +testDownloadURLOverride :: (HasCallStack) => App () testDownloadURLOverride = do -- This is a .example domain, it shouldn't resolve. But it is also not -- supposed to be used by cargohold to make connections. @@ -227,7 +228,8 @@ testDownloadURLOverride = do let loc = decodeHeaderOrFail (mk $ cs "Location") uploadRes :: String (_key, tok, _expires) <- (,,) - <$> uploadRes.json %. "key" + <$> uploadRes.json + %. "key" <*> (uploadRes.json %. "token" & asString) <*> lookupField uploadRes.json "expires" -- Lookup with token and get download URL. Should return the @@ -249,7 +251,7 @@ testDownloadURLOverride = do -- -- The body is taken directly from a request made by the web app -- (just replaced the content with a shorter one and updated the MD5 header). -testUploadCompatibility :: HasCallStack => App () +testUploadCompatibility :: (HasCallStack) => App () testUploadCompatibility = do uid <- randomUser OwnDomain def -- Initial upload @@ -287,7 +289,7 @@ testUploadCompatibility = do -------------------------------------------------------------------------------- -- Federation behaviour -testRemoteDownloadWrongDomain :: HasCallStack => App () +testRemoteDownloadWrongDomain :: (HasCallStack) => App () testRemoteDownloadWrongDomain = do assetId <- randomId uid <- randomUser OwnDomain def @@ -300,7 +302,7 @@ testRemoteDownloadWrongDomain = do res <- downloadAsset' uid qkey () res.status `shouldMatchInt` 422 -testRemoteDownloadNoAsset :: HasCallStack => App () +testRemoteDownloadNoAsset :: (HasCallStack) => App () testRemoteDownloadNoAsset = do assetId <- randomId uid <- randomUser OwnDomain def @@ -314,10 +316,10 @@ testRemoteDownloadNoAsset = do res <- downloadAsset' uid qkey () res.status `shouldMatchInt` 404 -testRemoteDownloadShort :: HasCallStack => App () +testRemoteDownloadShort :: (HasCallStack) => App () testRemoteDownloadShort = remoteDownload "asset content" -testRemoteDownloadLong :: HasCallStack => App () +testRemoteDownloadLong :: (HasCallStack) => App () testRemoteDownloadLong = remoteDownload $ concat $ replicate 20000 $ "hello world\n" remoteDownload :: (HasCallStack, ConvertibleStrings a L8.ByteString, ConvertibleStrings a String) => a -> App () diff --git a/integration/test/Test/Cargohold/API/Federation.hs b/integration/test/Test/Cargohold/API/Federation.hs index 2b0a1da8266..8cb6f4ac26f 100644 --- a/integration/test/Test/Cargohold/API/Federation.hs +++ b/integration/test/Test/Cargohold/API/Federation.hs @@ -27,13 +27,13 @@ import SetupHelpers import Test.Cargohold.API.Util import Testlib.Prelude -testGetAssetAvailablePublic :: HasCallStack => App () +testGetAssetAvailablePublic :: (HasCallStack) => App () testGetAssetAvailablePublic = getAssetAvailable True -testGetAssetAvailablePrivate :: HasCallStack => App () +testGetAssetAvailablePrivate :: (HasCallStack) => App () testGetAssetAvailablePrivate = getAssetAvailable False -getAssetAvailable :: HasCallStack => Bool -> App () +getAssetAvailable :: (HasCallStack) => Bool -> App () getAssetAvailable isPublicAsset = do -- Initial upload let bdy = (applicationOctetStream, cs "Hello World") @@ -53,7 +53,7 @@ getAssetAvailable isPublicAsset = do res <- downloadAsset' uid2 r1.jsonBody tok res.status `shouldMatchInt` 200 -testGetAssetNotAvailable :: HasCallStack => App () +testGetAssetNotAvailable :: (HasCallStack) => App () testGetAssetNotAvailable = do uid <- randomUser OwnDomain def userId <- uid %. "id" & asString @@ -68,7 +68,7 @@ testGetAssetNotAvailable = do r.status `shouldMatchInt` 404 r.jsonBody %. "message" `shouldMatch` "Asset not found" -testGetAssetWrongToken :: HasCallStack => App () +testGetAssetWrongToken :: (HasCallStack) => App () testGetAssetWrongToken = do -- Initial upload let bdy = (applicationOctetStream, cs "Hello World") @@ -95,7 +95,7 @@ testGetAssetWrongToken = do r2.status `shouldMatchInt` 404 r2.jsonBody %. "message" `shouldMatch` "Asset not found" -testLargeAsset :: HasCallStack => App () +testLargeAsset :: (HasCallStack) => App () testLargeAsset = do -- Initial upload let settings = object ["public" .= False, "retention" .= "volatile"] @@ -122,7 +122,7 @@ testLargeAsset = do r2 <- downloadAsset' uid2 ga ga r2.status `shouldMatchInt` 200 -testStreamAsset :: HasCallStack => App () +testStreamAsset :: (HasCallStack) => App () testStreamAsset = do -- Initial upload uid <- randomUser OwnDomain def @@ -140,11 +140,11 @@ testStreamAsset = do r2.status `shouldMatchInt` 200 cs @_ @String r2.body `shouldMatch` (snd bdy :: String) where - bdy :: ConvertibleStrings String a => (MIME.MIMEType, a) + bdy :: (ConvertibleStrings String a) => (MIME.MIMEType, a) bdy = (applicationOctetStream, cs "Hello World") settings = object ["public" .= False, "retention" .= "volatile"] -testStreamAssetNotAvailable :: HasCallStack => App () +testStreamAssetNotAvailable :: (HasCallStack) => App () testStreamAssetNotAvailable = do uid <- randomUser OwnDomain def uid2 <- randomUser OtherDomain def @@ -158,7 +158,7 @@ testStreamAssetNotAvailable = do r.status `shouldMatchInt` 404 r.jsonBody %. "message" `shouldMatch` "Asset not found" -testStreamAssetWrongToken :: HasCallStack => App () +testStreamAssetWrongToken :: (HasCallStack) => App () testStreamAssetWrongToken = do -- Initial upload uid <- randomUser OwnDomain def @@ -176,6 +176,6 @@ testStreamAssetWrongToken = do r2.status `shouldMatchInt` 404 r2.jsonBody %. "message" `shouldMatch` "Asset not found" where - bdy :: ConvertibleStrings String a => (MIME.MIMEType, a) + bdy :: (ConvertibleStrings String a) => (MIME.MIMEType, a) bdy = (applicationOctetStream, cs "Hello World") settings = object ["public" .= False, "retention" .= "volatile"] diff --git a/integration/test/Test/Cargohold/API/Util.hs b/integration/test/Test/Cargohold/API/Util.hs index 16564ea6930..8ffb512da7b 100644 --- a/integration/test/Test/Cargohold/API/Util.hs +++ b/integration/test/Test/Cargohold/API/Util.hs @@ -143,10 +143,10 @@ downloadAssetWithQualifiedAssetKey r user key tok = do dom <- key %. "domain" & asString keyId <- key %. "id" & asString req <- baseRequest user Cargohold (ExplicitVersion 2) $ "assets/" <> dom <> "/" <> keyId - submit "GET" $ - req - & tokenParam tok - & r + submit "GET" + $ req + & tokenParam tok + & r postToken :: (MakesValue user, HasCallStack) => user -> String -> App Response postToken user key = do diff --git a/integration/test/Test/Cargohold/API/V3.hs b/integration/test/Test/Cargohold/API/V3.hs index 04e8797daea..55bc4933f00 100644 --- a/integration/test/Test/Cargohold/API/V3.hs +++ b/integration/test/Test/Cargohold/API/V3.hs @@ -37,14 +37,14 @@ import Testlib.Prelude -------------------------------------------------------------------------------- -- Simple (single-step) uploads -testSimpleRoundtrip :: HasCallStack => App () +testSimpleRoundtrip :: (HasCallStack) => App () testSimpleRoundtrip = do let defSettings = ["public" .= False] rets = ["eternal", "persistent", "volatile", "eternal-infrequent_access", "expiring"] allSets = fmap object $ (defSettings :) $ (\r -> ["retention" .= r]) <$> rets mapM_ simpleRoundtrip allSets where - simpleRoundtrip :: HasCallStack => Value -> App () + simpleRoundtrip :: (HasCallStack) => Value -> App () simpleRoundtrip sets = do uid <- randomUser OwnDomain def uid2 <- randomUser OwnDomain def @@ -55,7 +55,8 @@ testSimpleRoundtrip = do -- use v3 path instead of the one returned in the header (key, tok, expires) <- (,,) - <$> r1.json %. "key" + <$> r1.json + %. "key" <*> (r1.json %. "token" >>= asString) <*> (lookupField r1.json "expires" >>= maybe (pure Nothing) (fmap pure . asString)) -- Check mandatory Date header @@ -74,8 +75,8 @@ testSimpleRoundtrip = do Just r -> do r' <- asString r -- These retention policies never expire, so an expiration date isn't sent back - unless (r' == "eternal" || r' == "persistent" || r' == "eternal-infrequent_access") $ - assertBool "invalid expiration" (Just utc < expires') + unless (r' == "eternal" || r' == "persistent" || r' == "eternal-infrequent_access") + $ assertBool "invalid expiration" (Just utc < expires') _ -> pure () -- Lookup with token and download via redirect. r2 <- downloadAsset' uid r1.jsonBody tok @@ -86,8 +87,9 @@ testSimpleRoundtrip = do req <- liftIO $ parseRequest locReq r3 <- submit "GET" req r3.status `shouldMatchInt` 200 - assertBool "content-type should always be application/octet-stream" $ - getHeader (mk $ cs "content-type") r3 == Just (encodeUtf8 $ showMIMEType applicationOctetStream) + assertBool "content-type should always be application/octet-stream" + $ getHeader (mk $ cs "content-type") r3 + == Just (encodeUtf8 $ showMIMEType applicationOctetStream) assertBool "Token mismatch" $ getHeader (mk $ cs "x-amz-meta-token") r3 == pure (cs tok) uid' <- uid %. "id" >>= asString assertBool "User mismatch" $ getHeader (mk $ cs "x-amz-meta-user") r3 == pure (cs uid') diff --git a/integration/test/Test/Cargohold/Metrics.hs b/integration/test/Test/Cargohold/Metrics.hs index c88d6cff920..aec91ee8c17 100644 --- a/integration/test/Test/Cargohold/Metrics.hs +++ b/integration/test/Test/Cargohold/Metrics.hs @@ -20,7 +20,7 @@ module Test.Cargohold.Metrics where import Data.String.Conversions import Testlib.Prelude -testPrometheusMetrics :: HasCallStack => App () +testPrometheusMetrics :: (HasCallStack) => App () testPrometheusMetrics = do req <- baseRequest OwnDomain Cargohold Unversioned "i/metrics" resp <- submit "GET" req diff --git a/integration/test/Test/Client.hs b/integration/test/Test/Client.hs index b512c08d08c..d00e8174710 100644 --- a/integration/test/Test/Client.hs +++ b/integration/test/Test/Client.hs @@ -17,7 +17,7 @@ import SetupHelpers import Testlib.Prelude import Testlib.ResourcePool -testClientLastActive :: HasCallStack => App () +testClientLastActive :: (HasCallStack) => App () testClientLastActive = do alice <- randomUser OwnDomain def c0 <- addClient alice def >>= getJSON 201 @@ -41,7 +41,7 @@ testClientLastActive = do <$> parseTimeM False defaultTimeLocale "%Y-%m-%dT%H:%M:%SZ" tm1 assertBool "last_active is earlier than expected" $ ts1 >= now -testListClientsIfBackendIsOffline :: HasCallStack => App () +testListClientsIfBackendIsOffline :: (HasCallStack) => App () testListClientsIfBackendIsOffline = do resourcePool <- asks (.resourcePool) ownDomain <- asString OwnDomain diff --git a/integration/test/Test/Connection.hs b/integration/test/Test/Connection.hs index f982df677d4..d12feb41f01 100644 --- a/integration/test/Test/Connection.hs +++ b/integration/test/Test/Connection.hs @@ -24,7 +24,7 @@ import SetupHelpers import Testlib.Prelude import UnliftIO.Async (forConcurrently_) -testConnectWithRemoteUser :: HasCallStack => Domain -> App () +testConnectWithRemoteUser :: (HasCallStack) => Domain -> App () testConnectWithRemoteUser owningDomain = do (alice, bob, one2oneId) <- createOne2OneConversation owningDomain aliceId <- alice %. "qualified_id" @@ -40,7 +40,7 @@ testConnectWithRemoteUser owningDomain = do qIds <- for others (%. "qualified_id") qIds `shouldMatchSet` [aliceId] -testRemoteUserGetsDeleted :: HasCallStack => App () +testRemoteUserGetsDeleted :: (HasCallStack) => App () testRemoteUserGetsDeleted = do alice <- randomUser OwnDomain def @@ -94,7 +94,7 @@ testRemoteUserGetsDeleted = do getConnection alice charlie `waitForResponse` \resp -> resp.status `shouldMatchInt` 404 -testInternalGetConStatusesAll :: HasCallStack => App () +testInternalGetConStatusesAll :: (HasCallStack) => App () testInternalGetConStatusesAll = startDynamicBackends [mempty] \[dynBackend] -> do let mkFiveUsers dom = replicateM 5 do @@ -149,7 +149,7 @@ assertConnectionStatus userFrom userTo connStatus = resp.status `shouldMatchInt` 200 resp.json %. "status" `shouldMatch` connStatus -testConnectFromIgnored :: HasCallStack => App () +testConnectFromIgnored :: (HasCallStack) => App () testConnectFromIgnored = do [alice, bob] <- forM [OwnDomain, OtherDomain] $ flip randomUser def void $ postConnection bob alice >>= getBody 201 @@ -168,7 +168,7 @@ testConnectFromIgnored = do resp.status `shouldMatchInt` 200 resp.json %. "status" `shouldMatch` "accepted" -testSentFromIgnored :: HasCallStack => App () +testSentFromIgnored :: (HasCallStack) => App () testSentFromIgnored = do [alice, bob] <- forM [OwnDomain, OtherDomain] $ flip randomUser def -- set up an initial "ignored" state @@ -185,7 +185,7 @@ testSentFromIgnored = do void $ putConnection alice bob "accepted" >>= getBody 200 assertConnectionStatus alice bob "sent" -testConnectFromBlocked :: HasCallStack => App () +testConnectFromBlocked :: (HasCallStack) => App () testConnectFromBlocked = do (alice, bob, one2oneId) <- createOne2OneConversation OwnDomain bobId <- bob %. "qualified_id" @@ -211,7 +211,7 @@ testConnectFromBlocked = do qIds <- for others (%. "qualified_id") qIds `shouldMatchSet` [bobId] -testSentFromBlocked :: HasCallStack => App () +testSentFromBlocked :: (HasCallStack) => App () testSentFromBlocked = do [alice, bob] <- forM [OwnDomain, OtherDomain] $ flip randomUser def -- set up an initial "blocked" state @@ -228,7 +228,7 @@ testSentFromBlocked = do void $ putConnection alice bob "accepted" >>= getBody 200 assertConnectionStatus alice bob "sent" -testCancel :: HasCallStack => App () +testCancel :: (HasCallStack) => App () testCancel = do [alice, bob] <- forM [OwnDomain, OtherDomain] $ flip randomUser def @@ -238,7 +238,7 @@ testCancel = do void $ putConnection alice bob "cancelled" >>= getBody 200 assertConnectionStatus alice bob "cancelled" -testConnectionLimits :: HasCallStack => App () +testConnectionLimits :: (HasCallStack) => App () testConnectionLimits = do let connectionLimit = 16 @@ -308,7 +308,7 @@ testConnectionLimits = do postConnection alice charlie4 `bindResponse` \resp -> resp.status `shouldMatchInt` 201 -testNonFederatingRemoteTeam :: HasCallStack => App () +testNonFederatingRemoteTeam :: (HasCallStack) => App () testNonFederatingRemoteTeam = withFederatingBackendsAllowDynamic $ \(domainA, domainB, _) -> do sequence_ @@ -324,7 +324,7 @@ testNonFederatingRemoteTeam = where defSearchPolicy = "full_search" -testNonMutualFederationConnectionAttempt :: HasCallStack => App () +testNonMutualFederationConnectionAttempt :: (HasCallStack) => App () testNonMutualFederationConnectionAttempt = withFederatingBackendsAllowDynamic $ \(domainA, domainB, _) -> do sequence_ @@ -348,7 +348,7 @@ testNonMutualFederationConnectionAttempt = where defSearchPolicy = "full_search" -testFederationAllowAllConnectWithRemote :: HasCallStack => App () +testFederationAllowAllConnectWithRemote :: (HasCallStack) => App () testFederationAllowAllConnectWithRemote = withFederatingBackendsAllowDynamic $ \(domainA, domainB, _) -> do sequence_ @@ -359,7 +359,7 @@ testFederationAllowAllConnectWithRemote = where defSearchPolicy = "full_search" -testFederationAllowDynamicConnectWithRemote :: HasCallStack => App () +testFederationAllowDynamicConnectWithRemote :: (HasCallStack) => App () testFederationAllowDynamicConnectWithRemote = withFederatingBackendsAllowDynamic $ \(domainA, domainB, _) -> do sequence_ @@ -383,7 +383,7 @@ testFederationAllowDynamicConnectWithRemote = where defSearchPolicy = "full_search" -testFederationAllowMixedConnectWithRemote :: HasCallStack => App () +testFederationAllowMixedConnectWithRemote :: (HasCallStack) => App () testFederationAllowMixedConnectWithRemote = withFederatingBackendsAllowDynamic $ \(domainA, domainB, _) -> do sequence_ @@ -403,7 +403,7 @@ testFederationAllowMixedConnectWithRemote = where defSearchPolicy = "full_search" -testPendingConnectionUserDeleted :: HasCallStack => Domain -> App () +testPendingConnectionUserDeleted :: (HasCallStack) => Domain -> App () testPendingConnectionUserDeleted bobsDomain = do alice <- randomUser OwnDomain def bob <- randomUser bobsDomain def diff --git a/integration/test/Test/Conversation.hs b/integration/test/Test/Conversation.hs index 9426f1a41c1..f44eb9eea2f 100644 --- a/integration/test/Test/Conversation.hs +++ b/integration/test/Test/Conversation.hs @@ -36,7 +36,7 @@ import Testlib.One2One (generateRemoteAndConvIdWithDomain) import Testlib.Prelude import Testlib.ResourcePool -testDynamicBackendsFullyConnectedWhenAllowAll :: HasCallStack => App () +testDynamicBackendsFullyConnectedWhenAllowAll :: (HasCallStack) => App () testDynamicBackendsFullyConnectedWhenAllowAll = do -- The default setting is 'allowAll' startDynamicBackends [def, def, def] $ \dynDomains -> do @@ -56,7 +56,7 @@ testDynamicBackendsFullyConnectedWhenAllowAll = do resp.status `shouldMatchInt` 200 resp.json %. "status" `shouldMatch` "fully-connected" -testDynamicBackendsNotFederating :: HasCallStack => App () +testDynamicBackendsNotFederating :: (HasCallStack) => App () testDynamicBackendsNotFederating = do let overrides = def @@ -72,7 +72,7 @@ testDynamicBackendsNotFederating = do resp.status `shouldMatchInt` 533 resp.json %. "unreachable_backends" `shouldMatchSet` [domainB, domainC] -testDynamicBackendsFullyConnectedWhenAllowDynamic :: HasCallStack => App () +testDynamicBackendsFullyConnectedWhenAllowDynamic :: (HasCallStack) => App () testDynamicBackendsFullyConnectedWhenAllowDynamic = do withFederatingBackendsAllowDynamic $ \(domainA, domainB, domainC) -> do -- Allowing 'full_search' or any type of search is how we enable federation @@ -96,7 +96,7 @@ testDynamicBackendsFullyConnectedWhenAllowDynamic = do retryT $ assertConnected uidB domainA domainC retryT $ assertConnected uidC domainA domainB -testDynamicBackendsNotFullyConnected :: HasCallStack => App () +testDynamicBackendsNotFullyConnected :: (HasCallStack) => App () testDynamicBackendsNotFullyConnected = do withFederatingBackendsAllowDynamic $ \(domainA, domainB, domainC) -> do -- A is connected to B and C, but B and C are not connected to each other @@ -113,7 +113,7 @@ testDynamicBackendsNotFullyConnected = do resp.json %. "status" `shouldMatch` "non-fully-connected" resp.json %. "not_connected" `shouldMatchSet` [domainB, domainC] -testFederationStatus :: HasCallStack => App () +testFederationStatus :: (HasCallStack) => App () testFederationStatus = do uid <- randomUser OwnDomain def {BrigI.team = True} federatingRemoteDomain <- asString OtherDomain @@ -136,7 +136,7 @@ testFederationStatus = do resp.status `shouldMatchInt` 200 resp.json %. "status" `shouldMatch` "fully-connected" -testCreateConversationFullyConnected :: HasCallStack => App () +testCreateConversationFullyConnected :: (HasCallStack) => App () testCreateConversationFullyConnected = do startDynamicBackends [def, def, def] $ \[domainA, domainB, domainC] -> do [u1, u2, u3] <- createUsers [domainA, domainB, domainC] @@ -145,7 +145,7 @@ testCreateConversationFullyConnected = do bindResponse (postConversation u1 (defProteus {qualifiedUsers = [u2, u3]})) $ \resp -> do resp.status `shouldMatchInt` 201 -testCreateConversationNonFullyConnected :: HasCallStack => App () +testCreateConversationNonFullyConnected :: (HasCallStack) => App () testCreateConversationNonFullyConnected = do withFederatingBackendsAllowDynamic $ \(domainA, domainB, domainC) -> do -- A is connected to B and C, but B and C are not connected to each other @@ -165,7 +165,7 @@ testCreateConversationNonFullyConnected = do resp.status `shouldMatchInt` 409 resp.json %. "non_federating_backends" `shouldMatchSet` [domainB, domainC] -testAddMembersFullyConnectedProteus :: HasCallStack => App () +testAddMembersFullyConnectedProteus :: (HasCallStack) => App () testAddMembersFullyConnectedProteus = do startDynamicBackends [def, def, def] $ \[domainA, domainB, domainC] -> do [u1, u2, u3] <- createUsers [domainA, domainB, domainC] @@ -181,7 +181,7 @@ testAddMembersFullyConnectedProteus = do addedUsers <- forM users (%. "qualified_id") addedUsers `shouldMatchSet` members -testAddMembersNonFullyConnectedProteus :: HasCallStack => App () +testAddMembersNonFullyConnectedProteus :: (HasCallStack) => App () testAddMembersNonFullyConnectedProteus = do withFederatingBackendsAllowDynamic $ \(domainA, domainB, domainC) -> do void $ BrigI.createFedConn domainA (BrigI.FedConn domainB "full_search" Nothing) @@ -205,7 +205,7 @@ testAddMembersNonFullyConnectedProteus = do resp.status `shouldMatchInt` 409 resp.json %. "non_federating_backends" `shouldMatchSet` [domainB, domainC] -testAddMember :: HasCallStack => App () +testAddMember :: (HasCallStack) => App () testAddMember = do alice <- randomUser OwnDomain def aliceId <- alice %. "qualified_id" @@ -242,7 +242,7 @@ testAddMember = do mem %. "qualified_id" `shouldMatch` aliceId mem %. "conversation_role" `shouldMatch` "wire_admin" -testAddMemberV1 :: HasCallStack => Domain -> App () +testAddMemberV1 :: (HasCallStack) => Domain -> App () testAddMemberV1 domain = do [alice, bob] <- createAndConnectUsers [OwnDomain, domain] conv <- postConversation alice defProteus >>= getJSON 201 @@ -261,7 +261,7 @@ testAddMemberV1 domain = do users <- resp.json %. "data.users" >>= asList traverse (%. "qualified_id") users `shouldMatchSet` [bobId] -testConvWithUnreachableRemoteUsers :: HasCallStack => App () +testConvWithUnreachableRemoteUsers :: (HasCallStack) => App () testConvWithUnreachableRemoteUsers = do ([alice, alex, bob, charlie, dylan], domains) <- startDynamicBackends [def, def] $ \domains -> do @@ -280,7 +280,7 @@ testConvWithUnreachableRemoteUsers = do regConvs <- filterM (\c -> (==) <$> (c %. "type" & asInt) <*> pure 0) convs regConvs `shouldMatch` ([] :: [Value]) -testAddUserWithUnreachableRemoteUsers :: HasCallStack => App () +testAddUserWithUnreachableRemoteUsers :: (HasCallStack) => App () testAddUserWithUnreachableRemoteUsers = do resourcePool <- asks resourcePool own <- make OwnDomain & asString @@ -312,7 +312,7 @@ testAddUserWithUnreachableRemoteUsers = do resp.status `shouldMatchInt` 533 resp.jsonBody %. "unreachable_backends" `shouldMatchSet` [cDom.berDomain] -testAddUnreachableUserFromFederatingBackend :: HasCallStack => App () +testAddUnreachableUserFromFederatingBackend :: (HasCallStack) => App () testAddUnreachableUserFromFederatingBackend = do resourcePool <- asks resourcePool runCodensity (acquireResources 1 resourcePool) $ \[cDom] -> do @@ -335,7 +335,7 @@ testAddUnreachableUserFromFederatingBackend = do resp.status `shouldMatchInt` 533 resp.jsonBody %. "unreachable_backends" `shouldMatchSet` [cDom.berDomain] -testAddUnreachable :: HasCallStack => App () +testAddUnreachable :: (HasCallStack) => App () testAddUnreachable = do ([alex, charlie], [charlieDomain, dylanDomain], conv) <- startDynamicBackends [def, def] $ \domains -> do @@ -373,7 +373,7 @@ testGetOneOnOneConvInStatusSentFromRemote = do resp <- getConversation d1User d2ConvId resp.status `shouldMatchInt` 200 -testAddingUserNonFullyConnectedFederation :: HasCallStack => App () +testAddingUserNonFullyConnectedFederation :: (HasCallStack) => App () testAddingUserNonFullyConnectedFederation = do let overrides = def @@ -404,7 +404,7 @@ testAddingUserNonFullyConnectedFederation = do resp.status `shouldMatchInt` 409 resp.json %. "non_federating_backends" `shouldMatchSet` [other, dynBackend] -testMultiIngressGuestLinks :: HasCallStack => App () +testMultiIngressGuestLinks :: (HasCallStack) => App () testMultiIngressGuestLinks = do do configuredURI <- readServiceConfig Galley & (%. "settings.conversationCodeURI") & asText @@ -470,7 +470,7 @@ testMultiIngressGuestLinks = do res <- getJSON 403 resp res %. "label" `shouldMatch` "access-denied" -testAddUserWhenOtherBackendOffline :: HasCallStack => App () +testAddUserWhenOtherBackendOffline :: (HasCallStack) => App () testAddUserWhenOtherBackendOffline = do ([alice, alex], conv) <- startDynamicBackends [def] $ \domains -> do @@ -484,7 +484,7 @@ testAddUserWhenOtherBackendOffline = do bindResponse (addMembers alice conv def {users = [alex]}) $ \resp -> do resp.status `shouldMatchInt` 200 -testSynchroniseUserRemovalNotification :: HasCallStack => App () +testSynchroniseUserRemovalNotification :: (HasCallStack) => App () testSynchroniseUserRemovalNotification = do resourcePool <- asks resourcePool [alice, bob] <- createAndConnectUsers [OwnDomain, OtherDomain] @@ -511,7 +511,7 @@ testSynchroniseUserRemovalNotification = do leaveNotif <- awaitNotification charlie client noValue isConvLeaveNotif leaveNotif %. "payload.0.qualified_conversation" `shouldMatch` objQidObject conv -testConvRenaming :: HasCallStack => App () +testConvRenaming :: (HasCallStack) => App () testConvRenaming = do [alice, bob] <- createAndConnectUsers [OwnDomain, OtherDomain] conv <- @@ -525,7 +525,7 @@ testConvRenaming = do nameNotif %. "payload.0.data.name" `shouldMatch` newConvName nameNotif %. "payload.0.qualified_conversation" `shouldMatch` objQidObject conv -testReceiptModeWithRemotesOk :: HasCallStack => App () +testReceiptModeWithRemotesOk :: (HasCallStack) => App () testReceiptModeWithRemotesOk = do [alice, bob] <- createAndConnectUsers [OwnDomain, OtherDomain] conv <- @@ -539,7 +539,7 @@ testReceiptModeWithRemotesOk = do notif %. "payload.0.qualified_from" `shouldMatch` objQidObject alice notif %. "payload.0.data.receipt_mode" `shouldMatchInt` 43 -testReceiptModeWithRemotesUnreachable :: HasCallStack => App () +testReceiptModeWithRemotesUnreachable :: (HasCallStack) => App () testReceiptModeWithRemotesUnreachable = do ownDomain <- asString OwnDomain alice <- randomUser ownDomain def @@ -555,7 +555,7 @@ testReceiptModeWithRemotesUnreachable = do notif %. "payload.0.qualified_from" `shouldMatch` objQidObject alice notif %. "payload.0.data.receipt_mode" `shouldMatchInt` 43 -testDeleteLocalMember :: HasCallStack => App () +testDeleteLocalMember :: (HasCallStack) => App () testDeleteLocalMember = do [alice, alex, bob] <- createUsers [OwnDomain, OwnDomain, OtherDomain] connectTwoUsers alice alex @@ -574,7 +574,7 @@ testDeleteLocalMember = do r.status `shouldMatchInt` 204 r.jsonBody `shouldMatch` (Nothing @Aeson.Value) -testDeleteRemoteMember :: HasCallStack => App () +testDeleteRemoteMember :: (HasCallStack) => App () testDeleteRemoteMember = do [alice, alex, bob] <- createUsers [OwnDomain, OwnDomain, OtherDomain] connectTwoUsers alice alex @@ -593,7 +593,7 @@ testDeleteRemoteMember = do r.status `shouldMatchInt` 204 r.jsonBody `shouldMatch` (Nothing @Aeson.Value) -testDeleteRemoteMemberRemoteUnreachable :: HasCallStack => App () +testDeleteRemoteMemberRemoteUnreachable :: (HasCallStack) => App () testDeleteRemoteMemberRemoteUnreachable = do [alice, bob, bart] <- createUsers [OwnDomain, OtherDomain, OtherDomain] conv <- startDynamicBackends [mempty] $ \[dynBackend] -> do @@ -617,7 +617,7 @@ testDeleteRemoteMemberRemoteUnreachable = do r.status `shouldMatchInt` 204 r.jsonBody `shouldMatch` (Nothing @Aeson.Value) -testDeleteTeamConversationWithRemoteMembers :: HasCallStack => App () +testDeleteTeamConversationWithRemoteMembers :: (HasCallStack) => App () testDeleteTeamConversationWithRemoteMembers = do (alice, team, _) <- createTeam OwnDomain 1 conv <- postConversation alice (defProteus {team = Just team}) >>= getJSON 201 @@ -633,7 +633,7 @@ testDeleteTeamConversationWithRemoteMembers = do notif %. "payload.0.qualified_conversation" `shouldMatch` objQidObject conv notif %. "payload.0.qualified_from" `shouldMatch` objQidObject alice -testDeleteTeamConversationWithUnreachableRemoteMembers :: HasCallStack => App () +testDeleteTeamConversationWithUnreachableRemoteMembers :: (HasCallStack) => App () testDeleteTeamConversationWithUnreachableRemoteMembers = do resourcePool <- asks resourcePool (alice, team, _) <- createTeam OwnDomain 1 @@ -660,7 +660,7 @@ testDeleteTeamConversationWithUnreachableRemoteMembers = do notif <- awaitNotification bob bobClient noValue isConvDeleteNotif assertNotification notif -testDeleteTeamMemberLimitedEventFanout :: HasCallStack => App () +testDeleteTeamMemberLimitedEventFanout :: (HasCallStack) => App () testDeleteTeamMemberLimitedEventFanout = do -- Alex will get removed from the team (alice, team, [alex, alison]) <- createTeam OwnDomain 3 @@ -683,8 +683,8 @@ testDeleteTeamMemberLimitedEventFanout = do -- from the team assertSuccess =<< setTeamFeatureStatus OwnDomain team "limitedEventFanout" "enabled" - withWebSockets [alice, amy, bob, alison, ana] $ - \[wsAlice, wsAmy, wsBob, wsAlison, wsAna] -> do + withWebSockets [alice, amy, bob, alison, ana] + $ \[wsAlice, wsAmy, wsBob, wsAlison, wsAna] -> do void $ deleteTeamMember team alice alex >>= getBody 202 memsAfter <- getMembers team aliceId @@ -719,7 +719,7 @@ testDeleteTeamMemberLimitedEventFanout = do -- is disabled by default. The counterpart test -- 'testDeleteTeamMemberLimitedEventFanout' enables the flag and tests the -- limited fanout. -testDeleteTeamMemberFullEventFanout :: HasCallStack => App () +testDeleteTeamMemberFullEventFanout :: (HasCallStack) => App () testDeleteTeamMemberFullEventFanout = do (alice, team, [alex, alison]) <- createTeam OwnDomain 3 [amy, bob] <- for [OwnDomain, OtherDomain] $ flip randomUser def @@ -749,7 +749,7 @@ testDeleteTeamMemberFullEventFanout = do memIds `shouldMatchSet` [aliceId, alisonId, amyId] assertConvUserDeletedNotif wsBob alexId -testLeaveConversationSuccess :: HasCallStack => App () +testLeaveConversationSuccess :: (HasCallStack) => App () testLeaveConversationSuccess = do [alice, bob, chad, dee] <- createUsers [OwnDomain, OwnDomain, OtherDomain, OtherDomain] [aClient, bClient] <- forM [alice, bob] $ \user -> @@ -771,7 +771,7 @@ testLeaveConversationSuccess = do assertLeaveNotification chad conv bob bClient chad assertLeaveNotification chad conv eve eClient chad -testOnUserDeletedConversations :: HasCallStack => App () +testOnUserDeletedConversations :: (HasCallStack) => App () testOnUserDeletedConversations = do startDynamicBackends [def] $ \[dynDomain] -> do [ownDomain, otherDomain] <- forM [OwnDomain, OtherDomain] asString @@ -803,7 +803,7 @@ testOnUserDeletedConversations = do expectedIds <- for [alex, bart, chad] (%. "qualified_id") memIds `shouldMatchSet` expectedIds -testUpdateConversationByRemoteAdmin :: HasCallStack => App () +testUpdateConversationByRemoteAdmin :: (HasCallStack) => App () testUpdateConversationByRemoteAdmin = do [alice, bob, charlie] <- createUsers [OwnDomain, OtherDomain, OtherDomain] connectTwoUsers alice bob @@ -816,14 +816,14 @@ testUpdateConversationByRemoteAdmin = do void $ updateReceiptMode bob conv (41 :: Int) >>= getBody 200 for_ wss $ \ws -> awaitMatch isReceiptModeUpdateNotif ws -testGuestCreatesConversation :: HasCallStack => App () +testGuestCreatesConversation :: (HasCallStack) => App () testGuestCreatesConversation = do alice <- randomUser OwnDomain def {BrigI.activate = False} bindResponse (postConversation alice defProteus) $ \resp -> do resp.status `shouldMatchInt` 403 resp.json %. "label" `shouldMatch` "operation-denied" -testGuestLinksSuccess :: HasCallStack => App () +testGuestLinksSuccess :: (HasCallStack) => App () testGuestLinksSuccess = do (user, _, tm : _) <- createTeam OwnDomain 2 conv <- postConversation user (allowGuests defProteus) >>= getJSON 201 @@ -836,7 +836,7 @@ testGuestLinksSuccess = do resp.status `shouldMatchInt` 200 resp.json %. "id" `shouldMatch` objId conv -testGuestLinksExpired :: HasCallStack => App () +testGuestLinksExpired :: (HasCallStack) => App () testGuestLinksExpired = do withModifiedBackend def {galleyCfg = setField "settings.guestLinkTTLSeconds" (1 :: Int)} @@ -851,7 +851,7 @@ testGuestLinksExpired = do bindResponse (getJoinCodeConv tm k v) $ \resp -> do resp.status `shouldMatchInt` 404 -testConversationWithFedV0 :: HasCallStack => App () +testConversationWithFedV0 :: (HasCallStack) => App () testConversationWithFedV0 = do alice <- randomUser OwnDomain def bob <- randomUser FedV0Domain def @@ -865,7 +865,7 @@ testConversationWithFedV0 = do void $ changeConversationName alice conv "foobar" >>= getJSON 200 void $ awaitMatch isConvNameChangeNotif ws -testConversationWithoutFederation :: HasCallStack => App () +testConversationWithoutFederation :: (HasCallStack) => App () testConversationWithoutFederation = withModifiedBackend (def {galleyCfg = removeField "federator" >=> removeField "rabbitmq"}) $ \domain -> do diff --git a/integration/test/Test/Demo.hs b/integration/test/Test/Demo.hs index 8b255f1c0d2..85f67354f3c 100644 --- a/integration/test/Test/Demo.hs +++ b/integration/test/Test/Demo.hs @@ -7,13 +7,12 @@ 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" @@ -21,7 +20,7 @@ testDeleteUnknownClient = 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 diff --git a/integration/test/Test/EJPD.hs b/integration/test/Test/EJPD.hs index 60fc67b1413..db28ccec61b 100644 --- a/integration/test/Test/EJPD.hs +++ b/integration/test/Test/EJPD.hs @@ -23,7 +23,7 @@ import Testlib.JSON import Testlib.Prelude -- | Create some teams & users, and return their expected ejpd response values. -setupEJPD :: HasCallStack => App (A.Value, A.Value, A.Value, A.Value, A.Value) +setupEJPD :: (HasCallStack) => App (A.Value, A.Value, A.Value, A.Value, A.Value) setupEJPD = do (owner1, tid1, [usr1, usr2]) <- createTeam OwnDomain 3 @@ -128,7 +128,7 @@ setupEJPD = where -- Return value is a 'EJPDResponseItem'. mkUsr :: - HasCallStack => + (HasCallStack) => A.Value {- user -} -> Maybe String {- handle (in case usr is not up to date, we pass this separately) -} -> [String {- push tokens -}] -> @@ -182,11 +182,11 @@ setupEJPD = . (key (fromString "TeamContacts") .~ A.Null) . (key (fromString "Conversations") .~ A.Null) -testEJPDRequest :: HasCallStack => App () +testEJPDRequest :: (HasCallStack) => App () testEJPDRequest = do (usr1, usr2, usr3, usr4, usr5) <- setupEJPD - let check :: HasCallStack => [A.Value] -> App () + let check :: (HasCallStack) => [A.Value] -> App () check want = do let handle = cs . (^?! (key (fromString "Handle") . _String)) have <- BI.getEJPDInfo OwnDomain (handle <$> want) "include_contacts" @@ -214,7 +214,7 @@ testEJPDRequest = do check [usr3] check [usr4, usr5] -testEJPDRequestRemote :: HasCallStack => App () +testEJPDRequestRemote :: (HasCallStack) => App () testEJPDRequestRemote = do usrRemote <- randomUser OtherDomain def {BI.email = Nothing, BI.name = Just "usrRemote"} handleRemote <- liftIO $ UUID.nextRandom <&> UUID.toString diff --git a/integration/test/Test/Errors.hs b/integration/test/Test/Errors.hs index 795c862dedd..4093cf3dc85 100644 --- a/integration/test/Test/Errors.hs +++ b/integration/test/Test/Errors.hs @@ -12,7 +12,7 @@ import Testlib.Mock import Testlib.Prelude import Testlib.ResourcePool -testNestedError :: HasCallStack => App () +testNestedError :: (HasCallStack) => App () testNestedError = do let innerError = object @@ -39,10 +39,10 @@ testNestedError = do { port = Just (fromIntegral res.berFederatorExternal), tls = False } - void $ - startMockServer mockConfig $ - codensityApp $ - \_req -> pure $ Wai.responseLBS HTTP.status400 mempty $ Aeson.encode innerError + void + $ startMockServer mockConfig + $ codensityApp + $ \_req -> pure $ Wai.responseLBS HTTP.status400 mempty $ Aeson.encode innerError -- get remote user lift $ do diff --git a/integration/test/Test/ExternalPartner.hs b/integration/test/Test/ExternalPartner.hs index a35522140b2..ae6381f4187 100644 --- a/integration/test/Test/ExternalPartner.hs +++ b/integration/test/Test/ExternalPartner.hs @@ -25,7 +25,7 @@ import MLS.Util import SetupHelpers import Testlib.Prelude -testExternalPartnerPermissions :: HasCallStack => App () +testExternalPartnerPermissions :: (HasCallStack) => App () testExternalPartnerPermissions = do (owner, tid, u1 : u2 : u3 : _) <- createTeam OwnDomain 4 @@ -55,7 +55,7 @@ testExternalPartnerPermissions = do bindResponse (addMembers partner conv def {users = [u3]}) $ \resp -> do resp.status `shouldMatchInt` 403 -testExternalPartnerPermissionsMls :: HasCallStack => App () +testExternalPartnerPermissionsMls :: (HasCallStack) => App () testExternalPartnerPermissionsMls = do -- external partners should not be able to create (MLS) conversations (owner, tid, _) <- createTeam OwnDomain 2 @@ -64,13 +64,13 @@ testExternalPartnerPermissionsMls = do bindResponse (postConversation bobExtClient defMLS) $ \resp -> do resp.status `shouldMatchInt` 403 -testExternalPartnerPermissionMlsOne2One :: HasCallStack => App () +testExternalPartnerPermissionMlsOne2One :: (HasCallStack) => App () testExternalPartnerPermissionMlsOne2One = do (owner, tid, alice : _) <- createTeam OwnDomain 2 bobExternal <- createTeamMemberWithRole owner tid "partner" void $ getMLSOne2OneConversation alice bobExternal >>= getJSON 200 -testExternalPartnerPermissionsConvName :: HasCallStack => App () +testExternalPartnerPermissionsConvName :: (HasCallStack) => App () testExternalPartnerPermissionsConvName = do (owner, tid, u1 : _) <- createTeam OwnDomain 2 diff --git a/integration/test/Test/FeatureFlags.hs b/integration/test/Test/FeatureFlags.hs index 32a22526da7..e0943931f9e 100644 --- a/integration/test/Test/FeatureFlags.hs +++ b/integration/test/Test/FeatureFlags.hs @@ -33,7 +33,7 @@ import Test.FeatureFlags.Util import Testlib.Prelude import Testlib.ResourcePool (acquireResources) -testLimitedEventFanout :: HasCallStack => App () +testLimitedEventFanout :: (HasCallStack) => App () testLimitedEventFanout = do let featureName = "limitedEventFanout" (_alice, team, _) <- createTeam OwnDomain 1 @@ -46,7 +46,7 @@ testLimitedEventFanout = do resp.status `shouldMatchInt` 200 resp.json %. "status" `shouldMatch` "enabled" -testLegalholdDisabledByDefault :: HasCallStack => App () +testLegalholdDisabledByDefault :: (HasCallStack) => App () testLegalholdDisabledByDefault = do let put uid tid st = Internal.setTeamFeatureConfig uid tid "legalhold" (object ["status" .= st]) >>= assertSuccess let patch uid tid st = Internal.setTeamFeatureStatus uid tid "legalhold" st >>= assertSuccess @@ -66,7 +66,7 @@ testLegalholdDisabledByDefault = do checkFeature "legalhold" owner tid disabled -- always disabled -testLegalholdDisabledPermanently :: HasCallStack => App () +testLegalholdDisabledPermanently :: (HasCallStack) => App () testLegalholdDisabledPermanently = do let cfgLhDisabledPermanently = def @@ -100,7 +100,7 @@ testLegalholdDisabledPermanently = do checkFeature "legalhold" owner tid disabled -- enabled if team is allow listed, disabled in any other case -testLegalholdWhitelistTeamsAndImplicitConsent :: HasCallStack => App () +testLegalholdWhitelistTeamsAndImplicitConsent :: (HasCallStack) => App () testLegalholdWhitelistTeamsAndImplicitConsent = do let cfgLhWhitelistTeamsAndImplicitConsent = def @@ -138,7 +138,7 @@ testLegalholdWhitelistTeamsAndImplicitConsent = do runCodensity (startDynamicBackend testBackend cfgLhWhitelistTeamsAndImplicitConsent) $ \_ -> do checkFeature "legalhold" owner tid enabled -testExposeInvitationURLsToTeamAdminConfig :: HasCallStack => App () +testExposeInvitationURLsToTeamAdminConfig :: (HasCallStack) => App () testExposeInvitationURLsToTeamAdminConfig = do let cfgExposeInvitationURLsTeamAllowlist tids = def @@ -178,7 +178,7 @@ testExposeInvitationURLsToTeamAdminConfig = do -- Interesting case: The team had the feature enabled but is not in allow list void testNoAllowlistEntry -testMlsE2EConfigCrlProxyRequired :: HasCallStack => App () +testMlsE2EConfigCrlProxyRequired :: (HasCallStack) => App () testMlsE2EConfigCrlProxyRequired = do (owner, tid, _) <- createTeam OwnDomain 1 let configWithoutCrlProxy = @@ -210,7 +210,7 @@ testMlsE2EConfigCrlProxyRequired = do expectedResponse <- configWithCrlProxy & setField "lockStatus" "unlocked" & setField "ttl" "unlimited" checkFeature "mlsE2EId" owner tid expectedResponse -testMlsE2EConfigCrlProxyNotRequiredInV5 :: HasCallStack => App () +testMlsE2EConfigCrlProxyNotRequiredInV5 :: (HasCallStack) => App () testMlsE2EConfigCrlProxyNotRequiredInV5 = do (owner, tid, _) <- createTeam OwnDomain 1 let configWithoutCrlProxy = @@ -231,7 +231,7 @@ testMlsE2EConfigCrlProxyNotRequiredInV5 = do expectedResponse <- configWithoutCrlProxy & setField "lockStatus" "unlocked" & setField "ttl" "unlimited" checkFeature "mlsE2EId" owner tid expectedResponse -testSSODisabledByDefault :: HasCallStack => App () +testSSODisabledByDefault :: (HasCallStack) => App () testSSODisabledByDefault = do let put uid tid = Internal.setTeamFeatureConfig uid tid "sso" (object ["status" .= "enabled"]) >>= assertSuccess let patch uid tid = Internal.setTeamFeatureStatus uid tid "sso" "enabled" >>= assertSuccess @@ -248,7 +248,7 @@ testSSODisabledByDefault = do enableFeature owner tid checkFeature "sso" owner tid enabled -testSSOEnabledByDefault :: HasCallStack => App () +testSSOEnabledByDefault :: (HasCallStack) => App () testSSOEnabledByDefault = do withModifiedBackend def {galleyCfg = setField "settings.featureFlags.sso" "enabled-by-default"} @@ -260,7 +260,7 @@ testSSOEnabledByDefault = do -- check that the feature cannot be disabled assertLabel 403 "not-implemented" =<< Internal.setTeamFeatureConfig owner tid "sso" (object ["status" .= "disabled"]) -testSearchVisibilityDisabledByDefault :: HasCallStack => App () +testSearchVisibilityDisabledByDefault :: (HasCallStack) => App () testSearchVisibilityDisabledByDefault = do withModifiedBackend def {galleyCfg = setField "settings.featureFlags.teamSearchVisibility" "disabled-by-default"} $ \domain -> do (owner, tid, m : _) <- createTeam domain 2 @@ -273,7 +273,7 @@ testSearchVisibilityDisabledByDefault = do assertSuccess =<< Internal.setTeamFeatureStatus owner tid "searchVisibility" "disabled" checkFeature "searchVisibility" owner tid disabled -testSearchVisibilityEnabledByDefault :: HasCallStack => App () +testSearchVisibilityEnabledByDefault :: (HasCallStack) => App () testSearchVisibilityEnabledByDefault = do withModifiedBackend def {galleyCfg = setField "settings.featureFlags.teamSearchVisibility" "enabled-by-default"} $ \domain -> do (owner, tid, m : _) <- createTeam domain 2 @@ -286,22 +286,22 @@ testSearchVisibilityEnabledByDefault = do assertSuccess =<< Internal.setTeamFeatureStatus owner tid "searchVisibility" "enabled" checkFeature "searchVisibility" owner tid enabled -testSearchVisibilityInbound :: HasCallStack => App () +testSearchVisibilityInbound :: (HasCallStack) => App () testSearchVisibilityInbound = _testSimpleFlag "searchVisibilityInbound" Public.setTeamFeatureConfig False -testDigitalSignaturesInternal :: HasCallStack => App () +testDigitalSignaturesInternal :: (HasCallStack) => App () testDigitalSignaturesInternal = _testSimpleFlag "digitalSignatures" Internal.setTeamFeatureConfig False -testValidateSAMLEmailsInternal :: HasCallStack => App () +testValidateSAMLEmailsInternal :: (HasCallStack) => App () testValidateSAMLEmailsInternal = _testSimpleFlag "validateSAMLemails" Internal.setTeamFeatureConfig True -testConferenceCallingInternal :: HasCallStack => App () +testConferenceCallingInternal :: (HasCallStack) => App () testConferenceCallingInternal = _testSimpleFlag "conferenceCalling" Internal.setTeamFeatureConfig True -testSearchVisibilityInboundInternal :: HasCallStack => App () +testSearchVisibilityInboundInternal :: (HasCallStack) => App () testSearchVisibilityInboundInternal = _testSimpleFlag "searchVisibilityInbound" Internal.setTeamFeatureConfig False -_testSimpleFlag :: HasCallStack => String -> (Value -> String -> String -> Value -> App Response) -> Bool -> App () +_testSimpleFlag :: (HasCallStack) => String -> (Value -> String -> String -> Value -> App Response) -> Bool -> App () _testSimpleFlag featureName setFeatureConfig featureEnabledByDefault = do let defaultStatus = if featureEnabledByDefault then "enabled" else "disabled" let defaultValue = if featureEnabledByDefault then enabled else disabled @@ -328,32 +328,32 @@ _testSimpleFlag featureName setFeatureConfig featureEnabledByDefault = do notif %. "payload.0.data" `shouldMatch` defaultValue checkFeature featureName m tid defaultValue -testConversationGuestLinks :: HasCallStack => App () +testConversationGuestLinks :: (HasCallStack) => App () testConversationGuestLinks = _testSimpleFlagWithLockStatus "conversationGuestLinks" Public.setTeamFeatureConfig True True -testFileSharing :: HasCallStack => App () +testFileSharing :: (HasCallStack) => App () testFileSharing = _testSimpleFlagWithLockStatus "fileSharing" Public.setTeamFeatureConfig True True -testSndFactorPasswordChallenge :: HasCallStack => App () +testSndFactorPasswordChallenge :: (HasCallStack) => App () testSndFactorPasswordChallenge = _testSimpleFlagWithLockStatus "sndFactorPasswordChallenge" Public.setTeamFeatureConfig False False -testOutlookCalIntegration :: HasCallStack => App () +testOutlookCalIntegration :: (HasCallStack) => App () testOutlookCalIntegration = _testSimpleFlagWithLockStatus "outlookCalIntegration" Public.setTeamFeatureConfig False False -testConversationGuestLinksInternal :: HasCallStack => App () +testConversationGuestLinksInternal :: (HasCallStack) => App () testConversationGuestLinksInternal = _testSimpleFlagWithLockStatus "conversationGuestLinks" Internal.setTeamFeatureConfig True True -testFileSharingInternal :: HasCallStack => App () +testFileSharingInternal :: (HasCallStack) => App () testFileSharingInternal = _testSimpleFlagWithLockStatus "fileSharing" Internal.setTeamFeatureConfig True True -testSndFactorPasswordChallengeInternal :: HasCallStack => App () +testSndFactorPasswordChallengeInternal :: (HasCallStack) => App () testSndFactorPasswordChallengeInternal = _testSimpleFlagWithLockStatus "sndFactorPasswordChallenge" Internal.setTeamFeatureConfig False False -testOutlookCalIntegrationInternal :: HasCallStack => App () +testOutlookCalIntegrationInternal :: (HasCallStack) => App () testOutlookCalIntegrationInternal = _testSimpleFlagWithLockStatus "outlookCalIntegration" Internal.setTeamFeatureConfig False False _testSimpleFlagWithLockStatus :: - HasCallStack => + (HasCallStack) => String -> (Value -> String -> String -> Value -> App Response) -> Bool -> @@ -406,13 +406,13 @@ _testSimpleFlagWithLockStatus featureName setFeatureConfig featureEnabledByDefau -- feature status should be the previously set status again checkFeature featureName m tid =<< setField "lockStatus" "unlocked" otherValue -testClassifiedDomainsEnabled :: HasCallStack => App () +testClassifiedDomainsEnabled :: (HasCallStack) => App () testClassifiedDomainsEnabled = do (_, tid, m : _) <- createTeam OwnDomain 2 expected <- enabled & setField "config.domains" ["example.com"] checkFeature "classifiedDomains" m tid expected -testClassifiedDomainsDisabled :: HasCallStack => App () +testClassifiedDomainsDisabled :: (HasCallStack) => App () testClassifiedDomainsDisabled = do withModifiedBackend def {galleyCfg = setField "settings.featureFlags.classifiedDomains" (object ["status" .= "disabled", "config" .= object ["domains" .= ["example.com"]]])} $ \domain -> do (_, tid, m : _) <- createTeam domain 2 @@ -421,65 +421,65 @@ testClassifiedDomainsDisabled = do -- | Call 'GET /teams/:tid/features' and 'GET /feature-configs', and check if all -- features are there. -testAllFeatures :: HasCallStack => App () +testAllFeatures :: (HasCallStack) => App () testAllFeatures = do (_, tid, m : _) <- createTeam OwnDomain 2 let expected = - object $ - [ "legalhold" .= disabled, - "sso" .= disabled, - "searchVisibility" .= disabled, - "validateSAMLemails" .= enabled, - "digitalSignatures" .= disabled, - "appLock" .= object ["lockStatus" .= "unlocked", "status" .= "enabled", "ttl" .= "unlimited", "config" .= object ["enforceAppLock" .= False, "inactivityTimeoutSecs" .= A.Number 60]], - "fileSharing" .= enabled, - "classifiedDomains" .= object ["lockStatus" .= "unlocked", "status" .= "enabled", "ttl" .= "unlimited", "config" .= object ["domains" .= ["example.com"]]], - "conferenceCalling" .= enabled, - "selfDeletingMessages" .= object ["lockStatus" .= "unlocked", "status" .= "enabled", "ttl" .= "unlimited", "config" .= object ["enforcedTimeoutSeconds" .= A.Number 0]], - "conversationGuestLinks" .= enabled, - "sndFactorPasswordChallenge" .= disabledLocked, - "mls" - .= object - [ "lockStatus" .= "unlocked", - "status" .= "disabled", - "ttl" .= "unlimited", - "config" - .= object - [ "protocolToggleUsers" .= ([] :: [String]), - "defaultProtocol" .= "proteus", - "supportedProtocols" .= ["proteus", "mls"], - "allowedCipherSuites" .= ([1] :: [Int]), - "defaultCipherSuite" .= A.Number 1 - ] - ], - "searchVisibilityInbound" .= disabled, - "exposeInvitationURLsToTeamAdmin" .= disabledLocked, - "outlookCalIntegration" .= disabledLocked, - "mlsE2EId" - .= object - [ "lockStatus" .= "unlocked", - "status" .= "disabled", - "ttl" .= "unlimited", - "config" - .= object - [ "verificationExpiration" .= A.Number 86400, - "useProxyOnMobile" .= False - ] - ], - "mlsMigration" - .= object - [ "lockStatus" .= "locked", - "status" .= "enabled", - "ttl" .= "unlimited", - "config" - .= object - [ "startTime" .= "2029-05-16T10:11:12.123Z", - "finaliseRegardlessAfter" .= "2029-10-17T00:00:00Z" - ] - ], - "enforceFileDownloadLocation" .= object ["lockStatus" .= "locked", "status" .= "disabled", "ttl" .= "unlimited", "config" .= object []], - "limitedEventFanout" .= disabled - ] + object + $ [ "legalhold" .= disabled, + "sso" .= disabled, + "searchVisibility" .= disabled, + "validateSAMLemails" .= enabled, + "digitalSignatures" .= disabled, + "appLock" .= object ["lockStatus" .= "unlocked", "status" .= "enabled", "ttl" .= "unlimited", "config" .= object ["enforceAppLock" .= False, "inactivityTimeoutSecs" .= A.Number 60]], + "fileSharing" .= enabled, + "classifiedDomains" .= object ["lockStatus" .= "unlocked", "status" .= "enabled", "ttl" .= "unlimited", "config" .= object ["domains" .= ["example.com"]]], + "conferenceCalling" .= enabled, + "selfDeletingMessages" .= object ["lockStatus" .= "unlocked", "status" .= "enabled", "ttl" .= "unlimited", "config" .= object ["enforcedTimeoutSeconds" .= A.Number 0]], + "conversationGuestLinks" .= enabled, + "sndFactorPasswordChallenge" .= disabledLocked, + "mls" + .= object + [ "lockStatus" .= "unlocked", + "status" .= "disabled", + "ttl" .= "unlimited", + "config" + .= object + [ "protocolToggleUsers" .= ([] :: [String]), + "defaultProtocol" .= "proteus", + "supportedProtocols" .= ["proteus", "mls"], + "allowedCipherSuites" .= ([1] :: [Int]), + "defaultCipherSuite" .= A.Number 1 + ] + ], + "searchVisibilityInbound" .= disabled, + "exposeInvitationURLsToTeamAdmin" .= disabledLocked, + "outlookCalIntegration" .= disabledLocked, + "mlsE2EId" + .= object + [ "lockStatus" .= "unlocked", + "status" .= "disabled", + "ttl" .= "unlimited", + "config" + .= object + [ "verificationExpiration" .= A.Number 86400, + "useProxyOnMobile" .= False + ] + ], + "mlsMigration" + .= object + [ "lockStatus" .= "locked", + "status" .= "enabled", + "ttl" .= "unlimited", + "config" + .= object + [ "startTime" .= "2029-05-16T10:11:12.123Z", + "finaliseRegardlessAfter" .= "2029-10-17T00:00:00Z" + ] + ], + "enforceFileDownloadLocation" .= object ["lockStatus" .= "locked", "status" .= "disabled", "ttl" .= "unlimited", "config" .= object []], + "limitedEventFanout" .= disabled + ] bindResponse (Public.getTeamFeatures m tid) $ \resp -> do resp.status `shouldMatchInt` 200 expected `shouldMatch` resp.json @@ -503,7 +503,7 @@ testAllFeatures = do resp.status `shouldMatchInt` 200 expected `shouldMatch` resp.json -testFeatureConfigConsistency :: HasCallStack => App () +testFeatureConfigConsistency :: (HasCallStack) => App () testFeatureConfigConsistency = do (_, tid, m : _) <- createTeam OwnDomain 2 @@ -511,8 +511,8 @@ testFeatureConfigConsistency = do allTeamFeaturesRes <- Public.getTeamFeatures m tid >>= parseObjectKeys - unless (allTeamFeaturesRes `Set.isSubsetOf` allFeaturesRes) $ - assertFailure (show allTeamFeaturesRes <> " is not a subset of " <> show allFeaturesRes) + unless (allTeamFeaturesRes `Set.isSubsetOf` allFeaturesRes) + $ assertFailure (show allTeamFeaturesRes <> " is not a subset of " <> show allFeaturesRes) where parseObjectKeys :: Response -> App (Set.Set String) parseObjectKeys res = do @@ -521,7 +521,7 @@ testFeatureConfigConsistency = do (A.Object hm) -> pure (Set.fromList . map (show . A.toText) . KM.keys $ hm) x -> assertFailure ("JSON was not an object, but " <> show x) -testSelfDeletingMessages :: HasCallStack => App () +testSelfDeletingMessages :: (HasCallStack) => App () testSelfDeletingMessages = _testLockStatusWithConfig "selfDeletingMessages" @@ -531,7 +531,7 @@ testSelfDeletingMessages = (object ["status" .= "enabled", "config" .= object ["enforcedTimeoutSeconds" .= A.Number 30]]) (object ["status" .= "enabled", "config" .= object ["enforcedTimeoutSeconds" .= ""]]) -testSelfDeletingMessagesInternal :: HasCallStack => App () +testSelfDeletingMessagesInternal :: (HasCallStack) => App () testSelfDeletingMessagesInternal = _testLockStatusWithConfig "selfDeletingMessages" @@ -541,7 +541,7 @@ testSelfDeletingMessagesInternal = (object ["status" .= "enabled", "config" .= object ["enforcedTimeoutSeconds" .= A.Number 30]]) (object ["status" .= "enabled", "config" .= object ["enforcedTimeoutSeconds" .= ""]]) -testMls :: HasCallStack => App () +testMls :: (HasCallStack) => App () testMls = do user <- randomUser OwnDomain def uid <- asString $ user %. "id" @@ -553,7 +553,7 @@ testMls = do mlsConfig2 mlsInvalidConfig -testMlsInternal :: HasCallStack => App () +testMlsInternal :: (HasCallStack) => App () testMlsInternal = do user <- randomUser OwnDomain def uid <- asString $ user %. "id" @@ -623,7 +623,7 @@ mlsInvalidConfig = ] ] -testEnforceDownloadLocation :: HasCallStack => App () +testEnforceDownloadLocation :: (HasCallStack) => App () testEnforceDownloadLocation = _testLockStatusWithConfig "enforceFileDownloadLocation" @@ -633,7 +633,7 @@ testEnforceDownloadLocation = (object ["status" .= "disabled", "config" .= object []]) (object ["status" .= "enabled", "config" .= object ["enforcedDownloadLocation" .= object []]]) -testEnforceDownloadLocationInternal :: HasCallStack => App () +testEnforceDownloadLocationInternal :: (HasCallStack) => App () testEnforceDownloadLocationInternal = _testLockStatusWithConfig "enforceFileDownloadLocation" @@ -643,7 +643,7 @@ testEnforceDownloadLocationInternal = (object ["status" .= "disabled", "config" .= object []]) (object ["status" .= "enabled", "config" .= object ["enforcedDownloadLocation" .= object []]]) -testMlsMigration :: HasCallStack => App () +testMlsMigration :: (HasCallStack) => App () testMlsMigration = do -- first we have to enable mls (owner, tid, m : _) <- createTeam OwnDomain 2 @@ -657,7 +657,7 @@ testMlsMigration = do mlsMigrationConfig2 mlsMigrationInvalidConfig -testMlsMigrationInternal :: HasCallStack => App () +testMlsMigrationInternal :: (HasCallStack) => App () testMlsMigrationInternal = do -- first we have to enable mls (owner, tid, m : _) <- createTeam OwnDomain 2 @@ -763,7 +763,7 @@ mlsE2EIdConfig = do ] ] -testMLSE2EId :: HasCallStack => App () +testMLSE2EId :: (HasCallStack) => App () testMLSE2EId = do (defCfg, cfg1, cfg2, invalidCfg) <- mlsE2EIdConfig _testLockStatusWithConfig @@ -774,7 +774,7 @@ testMLSE2EId = do cfg2 invalidCfg -testMLSE2EIdInternal :: HasCallStack => App () +testMLSE2EIdInternal :: (HasCallStack) => App () testMLSE2EIdInternal = do (defCfg, cfg1, cfg2, invalidCfg) <- mlsE2EIdConfig -- the internal API is not as strict as the public one, so we need to tweak the invalid config some more @@ -788,7 +788,7 @@ testMLSE2EIdInternal = do invalidCfg' _testLockStatusWithConfig :: - HasCallStack => + (HasCallStack) => String -> (Value -> String -> String -> Value -> App Response) -> -- | the default feature config (should include the lock status and ttl, as it is returned by the API) @@ -805,7 +805,7 @@ _testLockStatusWithConfig featureName setTeamFeatureConfig defaultFeatureConfig _testLockStatusWithConfigWithTeam (owner, tid, m) featureName setTeamFeatureConfig defaultFeatureConfig config1 config2 invalidConfig _testLockStatusWithConfigWithTeam :: - HasCallStack => + (HasCallStack) => -- | (owner, tid, member) (Value, String, Value) -> String -> @@ -866,7 +866,7 @@ _testLockStatusWithConfigWithTeam (owner, tid, m) featureName setTeamFeatureConf checkFeature featureName m tid =<< (config2 & setField "lockStatus" "unlocked" & setField "ttl" "unlimited") -testFeatureNoConfigMultiSearchVisibilityInbound :: HasCallStack => App () +testFeatureNoConfigMultiSearchVisibilityInbound :: (HasCallStack) => App () testFeatureNoConfigMultiSearchVisibilityInbound = do (_owner1, team1, _) <- createTeam OwnDomain 0 (_owner2, team2, _) <- createTeam OwnDomain 0 @@ -879,22 +879,22 @@ testFeatureNoConfigMultiSearchVisibilityInbound = do length statuses `shouldMatchInt` 2 statuses `shouldMatchSet` [object ["team" .= team1, "status" .= "disabled"], object ["team" .= team2, "status" .= "enabled"]] -testConferenceCallingTTLIncreaseToUnlimited :: HasCallStack => App () +testConferenceCallingTTLIncreaseToUnlimited :: (HasCallStack) => App () testConferenceCallingTTLIncreaseToUnlimited = _testSimpleFlagTTLOverride "conferenceCalling" True (Just 2) Nothing -testConferenceCallingTTLIncrease :: HasCallStack => App () +testConferenceCallingTTLIncrease :: (HasCallStack) => App () testConferenceCallingTTLIncrease = _testSimpleFlagTTLOverride "conferenceCalling" True (Just 2) (Just 4) -testConferenceCallingTTLReduceFromUnlimited :: HasCallStack => App () +testConferenceCallingTTLReduceFromUnlimited :: (HasCallStack) => App () testConferenceCallingTTLReduceFromUnlimited = _testSimpleFlagTTLOverride "conferenceCalling" True Nothing (Just 2) -testConferenceCallingTTLReduce :: HasCallStack => App () +testConferenceCallingTTLReduce :: (HasCallStack) => App () testConferenceCallingTTLReduce = _testSimpleFlagTTLOverride "conferenceCalling" True (Just 5) (Just 2) -testConferenceCallingTTLUnlimitedToUnlimited :: HasCallStack => App () +testConferenceCallingTTLUnlimitedToUnlimited :: (HasCallStack) => App () testConferenceCallingTTLUnlimitedToUnlimited = _testSimpleFlagTTLOverride "conferenceCalling" True Nothing Nothing -_testSimpleFlagTTLOverride :: HasCallStack => String -> Bool -> Maybe Int -> Maybe Int -> App () +_testSimpleFlagTTLOverride :: (HasCallStack) => String -> Bool -> Maybe Int -> Maybe Int -> App () _testSimpleFlagTTLOverride featureName enabledByDefault mTtl mTtlAfter = do let ttl = maybe (A.String . cs $ "unlimited") (A.Number . fromIntegral) mTtl let ttlAfter = maybe (A.String . cs $ "unlimited") (A.Number . fromIntegral) mTtlAfter @@ -940,37 +940,37 @@ _testSimpleFlagTTLOverride featureName enabledByDefault mTtl mTtlAfter = do -------------------------------------------------------------------------------- -- Simple flags with implicit lock status -testPatchSearchVisibility :: HasCallStack => App () +testPatchSearchVisibility :: (HasCallStack) => App () testPatchSearchVisibility = _testPatch "searchVisibility" False disabled enabled -testPatchValidateSAMLEmails :: HasCallStack => App () +testPatchValidateSAMLEmails :: (HasCallStack) => App () testPatchValidateSAMLEmails = _testPatch "validateSAMLemails" False enabled disabled -testPatchDigitalSignatures :: HasCallStack => App () +testPatchDigitalSignatures :: (HasCallStack) => App () testPatchDigitalSignatures = _testPatch "digitalSignatures" False disabled enabled -testPatchConferenceCalling :: HasCallStack => App () +testPatchConferenceCalling :: (HasCallStack) => App () testPatchConferenceCalling = _testPatch "conferenceCalling" False enabled disabled -------------------------------------------------------------------------------- -- Simple flags with explicit lock status -testPatchFileSharing :: HasCallStack => App () +testPatchFileSharing :: (HasCallStack) => App () testPatchFileSharing = _testPatch "fileSharing" True enabled disabled -testPatchGuestLinks :: HasCallStack => App () +testPatchGuestLinks :: (HasCallStack) => App () testPatchGuestLinks = _testPatch "conversationGuestLinks" True enabled disabled -testPatchSndFactorPasswordChallenge :: HasCallStack => App () +testPatchSndFactorPasswordChallenge :: (HasCallStack) => App () testPatchSndFactorPasswordChallenge = _testPatch "sndFactorPasswordChallenge" True disabledLocked enabled -testPatchOutlookCalIntegration :: HasCallStack => App () +testPatchOutlookCalIntegration :: (HasCallStack) => App () testPatchOutlookCalIntegration = _testPatch "outlookCalIntegration" True disabledLocked enabled -------------------------------------------------------------------------------- -- Flags with config & implicit lock status -testPatchAppLock :: HasCallStack => App () +testPatchAppLock :: (HasCallStack) => App () testPatchAppLock = do let defCfg = object @@ -988,7 +988,7 @@ testPatchAppLock = do -------------------------------------------------------------------------------- -- Flags with config & explicit lock status -testPatchSelfDeletingMessages :: HasCallStack => App () +testPatchSelfDeletingMessages :: (HasCallStack) => App () testPatchSelfDeletingMessages = do let defCfg = object @@ -1003,7 +1003,7 @@ testPatchSelfDeletingMessages = do _testPatch "selfDeletingMessages" True defCfg (object ["lockStatus" .= "unlocked", "config" .= object ["enforcedTimeoutSeconds" .= A.Number 30]]) _testPatch "selfDeletingMessages" True defCfg (object ["config" .= object ["enforcedTimeoutSeconds" .= A.Number 60]]) -testPatchEnforceFileDownloadLocation :: HasCallStack => App () +testPatchEnforceFileDownloadLocation :: (HasCallStack) => App () testPatchEnforceFileDownloadLocation = do let defCfg = object @@ -1018,7 +1018,7 @@ testPatchEnforceFileDownloadLocation = do _testPatch "enforceFileDownloadLocation" True defCfg (object ["lockStatus" .= "locked", "config" .= object []]) _testPatch "enforceFileDownloadLocation" True defCfg (object ["config" .= object ["enforcedDownloadLocation" .= "/tmp"]]) -testPatchE2EId :: HasCallStack => App () +testPatchE2EId :: (HasCallStack) => App () testPatchE2EId = do let defCfg = object @@ -1062,7 +1062,7 @@ testPatchE2EId = do ] ) -testPatchMLS :: HasCallStack => App () +testPatchMLS :: (HasCallStack) => App () testPatchMLS = do dom <- asString OwnDomain (_, tid, _) <- createTeam dom 0 @@ -1125,7 +1125,7 @@ testPatchMLS = do ] ) where - mlsMigrationSetup :: HasCallStack => String -> String -> App () + mlsMigrationSetup :: (HasCallStack) => String -> String -> App () mlsMigrationSetup dom tid = assertSuccess =<< Internal.patchTeamFeature @@ -1134,7 +1134,7 @@ testPatchMLS = do "mlsMigration" (object ["status" .= "disabled", "lockStatus" .= "unlocked"]) -_testPatch :: HasCallStack => String -> Bool -> Value -> Value -> App () +_testPatch :: (HasCallStack) => String -> Bool -> Value -> Value -> App () _testPatch featureName hasExplicitLockStatus defaultFeatureConfig patch = do dom <- asString OwnDomain _testPatchWithSetup @@ -1146,7 +1146,7 @@ _testPatch featureName hasExplicitLockStatus defaultFeatureConfig patch = do patch _testPatchWithSetup :: - HasCallStack => + (HasCallStack) => (String -> String -> App ()) -> String -> String -> diff --git a/integration/test/Test/FeatureFlags/Util.hs b/integration/test/Test/FeatureFlags/Util.hs index c03959919dd..92426fd5f4f 100644 --- a/integration/test/Test/FeatureFlags/Util.hs +++ b/integration/test/Test/FeatureFlags/Util.hs @@ -76,11 +76,14 @@ checkFeatureLenientTtl = checkFeatureWith shouldMatchLenientTtl checkTtl (A.Number actualTtl) (A.Number expectedTtl) = do assertBool ("expected the actual TTL to be greater than 0 and equal to or no more than 2 seconds less than " <> show expectedTtl <> ", but it was " <> show actualTtl) - ( actualTtl > 0 - && actualTtl <= expectedTtl - && abs (actualTtl - expectedTtl) <= 2 + ( actualTtl + > 0 + && actualTtl + <= expectedTtl + && abs (actualTtl - expectedTtl) + <= 2 ) checkTtl _ _ = assertFailure "unexpected ttl value(s)" -assertForbidden :: HasCallStack => Response -> App () +assertForbidden :: (HasCallStack) => Response -> App () assertForbidden = assertLabel 403 "no-team-member" diff --git a/integration/test/Test/Federation.hs b/integration/test/Test/Federation.hs index 6ac43c3d3c8..ff1f2ae2304 100644 --- a/integration/test/Test/Federation.hs +++ b/integration/test/Test/Federation.hs @@ -17,7 +17,7 @@ import SetupHelpers import Testlib.Prelude import Testlib.ResourcePool -testNotificationsForOfflineBackends :: HasCallStack => App () +testNotificationsForOfflineBackends :: (HasCallStack) => App () testNotificationsForOfflineBackends = do resourcePool <- asks (.resourcePool) -- `delUser` will eventually get deleted. diff --git a/integration/test/Test/Federator.hs b/integration/test/Test/Federator.hs index cabf7a1a522..ff097578bb5 100644 --- a/integration/test/Test/Federator.hs +++ b/integration/test/Test/Federator.hs @@ -18,8 +18,8 @@ runFederatorMetrics getService = do second <- bindResponse (getMetrics OwnDomain getService) handleRes assertBool "Two metric requests should never match" $ first.body /= second.body assertBool "Second metric response should never be 0 length (the first might be)" $ BS.length second.body /= 0 - assertBool "The seconds metric response should have text indicating that it is returning metrics" $ - BS.isInfixOf expectedString second.body + assertBool "The seconds metric response should have text indicating that it is returning metrics" + $ BS.isInfixOf expectedString second.body where expectedString = "# TYPE http_request_duration_seconds histogram" @@ -31,7 +31,7 @@ testFederatorMetricsInternal = runFederatorMetrics federatorInternal testFederatorMetricsExternal :: App () testFederatorMetricsExternal = runFederatorMetrics federatorExternal -testFederatorNumRequestsMetrics :: HasCallStack => App () +testFederatorNumRequestsMetrics :: (HasCallStack) => App () testFederatorNumRequestsMetrics = do u1 <- randomUser OwnDomain def u2 <- randomUser OtherDomain def diff --git a/integration/test/Test/LegalHold.hs b/integration/test/Test/LegalHold.hs index e049335a419..86373c28cb0 100644 --- a/integration/test/Test/LegalHold.hs +++ b/integration/test/Test/LegalHold.hs @@ -95,17 +95,18 @@ testLHPreventAddingNonConsentingUsers = do addMembers alice conv def {users = [georgeQId]} >>= assertLabel 403 "missing-legalhold-consent" where - checkConvHasOtherMembers :: HasCallStack => Value -> Value -> [Value] -> App () + checkConvHasOtherMembers :: (HasCallStack) => Value -> Value -> [Value] -> App () checkConvHasOtherMembers conv u us = bindResponse (getConversation u conv) $ \resp -> do resp.status `shouldMatchInt` 200 mems <- - resp.json %. "members.others" & asList >>= traverse \m -> do - m %. "qualified_id" + resp.json %. "members.others" + & asList >>= traverse \m -> do + m %. "qualified_id" mems `shouldMatchSet` forM us (\m -> m %. "qualified_id") testLHMessageExchange :: - HasCallStack => + (HasCallStack) => TaggedBool "clients1New" -> TaggedBool "clients2New" -> App () @@ -136,7 +137,7 @@ testLHMessageExchange (TaggedBool clients1New) (TaggedBool clients2New) = do val <- getJSON 200 res asList val - assertMessageSendingWorks :: HasCallStack => App () + assertMessageSendingWorks :: (HasCallStack) => App () assertMessageSendingWorks = do clients1 <- getClients mem1 clients2 <- getClients mem2 @@ -224,7 +225,7 @@ testLHClaimKeys approvedOrPending testmode = do objId `mapM` cls getCls lmem - let assertResp :: HasCallStack => Response -> App () + let assertResp :: (HasCallStack) => Response -> App () assertResp resp = case (testmode, llhdevs) of (TCKConsentMissing, (_ : _)) -> do resp.status `shouldMatchInt` 403 @@ -323,7 +324,7 @@ testLHRequestDevice = do -- | pops a channel until it finds an event that returns a 'Just' -- upon running the matcher function -checkChan :: HasCallStack => Chan t -> (t -> App (Maybe a)) -> App a +checkChan :: (HasCallStack) => Chan t -> (t -> App (Maybe a)) -> App a checkChan chan match = do tSecs <- asks ((* 1_000_000) . timeOutSeconds) @@ -332,7 +333,7 @@ checkChan chan match = do go -- | like 'checkChan' but throws away the request and decodes the body -checkChanVal :: HasCallStack => Chan (t, LazyByteString) -> (Value -> MaybeT App a) -> App a +checkChanVal :: (HasCallStack) => Chan (t, LazyByteString) -> (Value -> MaybeT App a) -> App a checkChanVal chan match = checkChan chan \(_, bs) -> runMaybeT do MaybeT (pure (decode bs)) >>= match @@ -366,10 +367,12 @@ testLHApproveDevice = do let uidsAndTidMatch val = do actualTid <- lookupFieldM val "team_id" - >>= lift . asString + >>= lift + . asString actualUid <- lookupFieldM val "user_id" - >>= lift . asString + >>= lift + . asString bobUid <- lift $ objId bob -- we pass the check on equality @@ -390,7 +393,8 @@ testLHApproveDevice = do let matchAuthToken val = lookupFieldM val "refresh_token" - >>= lift . asString + >>= lift + . asString checkChanVal chan matchAuthToken >>= renewToken bob @@ -503,8 +507,10 @@ testLHDisableForUser = do checkChan chan \(req, _) -> runMaybeT do unless do - BS8.unpack req.requestMethod == "POST" - && req.pathInfo == (T.pack <$> ["legalhold", "remove"]) + BS8.unpack req.requestMethod + == "POST" + && req.pathInfo + == (T.pack <$> ["legalhold", "remove"]) mzero void $ local (setTimeoutTo 90) do @@ -516,7 +522,7 @@ testLHDisableForUser = do BrigI.getClientsFull bob [bobId] `bindResponse` \resp -> do resp.json %. bobId & asList - >>= filterM \val -> (== "legalhold") <$> (val %. "type" & asString) + >>= filterM \val -> (== "legalhold") <$> (val %. "type" & asString) shouldBeEmpty lhClients @@ -556,8 +562,9 @@ testLHGetMembersIncludesStatus = do getTeamMembers alice tid `bindResponse` \resp -> do resp.status `shouldMatchInt` 200 [bobMember] <- - resp.json %. "members" & asList >>= filterM \u -> do - (==) <$> asString (u %. "user") <*> objId bob + resp.json %. "members" + & asList >>= filterM \u -> do + (==) <$> asString (u %. "user") <*> objId bob bobMember %. "legalhold_status" `shouldMatch` status statusShouldBe "no_consent" @@ -815,7 +822,8 @@ testLHHappyFlow = do resp.status `shouldMatchInt` 200 resp.json %. "status" `shouldMatch` "enabled" _ <- - resp.json `lookupField` "client.id" + resp.json + `lookupField` "client.id" >>= assertJust "client id is present" resp.json %. "last_prekey" `shouldMatch` lpk @@ -825,7 +833,7 @@ testLHGetStatus = do (charlie, _tidCharlie, [debora]) <- createTeam OwnDomain 2 emil <- randomUser OwnDomain def - let check :: HasCallStack => (MakesValue getter, MakesValue target) => getter -> target -> String -> App () + let check :: (HasCallStack) => (MakesValue getter, MakesValue target) => getter -> target -> String -> App () check getter target status = do profile <- getUser getter target >>= getJSON 200 pStatus <- profile %. "legalhold_status" & asString @@ -865,7 +873,7 @@ testLHCannotCreateGroupWithUsersInConflict = do postConversation bob defProteus {qualifiedUsers = [debora, alice], newUsersRole = "wire_member", team = Just tidAlice} >>= assertLabel 403 "missing-legalhold-consent" -testNoConsentCannotBeInvited :: HasCallStack => App () +testNoConsentCannotBeInvited :: (HasCallStack) => App () testNoConsentCannotBeInvited = do -- team that is legalhold whitelisted (legalholder, tidLH, userLHNotActivated : _) <- createTeam OwnDomain 2 diff --git a/integration/test/Test/Login.hs b/integration/test/Test/Login.hs index c5ca8b2d513..096f441a50f 100644 --- a/integration/test/Test/Login.hs +++ b/integration/test/Test/Login.hs @@ -12,7 +12,7 @@ import SetupHelpers import Testlib.Prelude import Text.Printf (printf) -testLoginVerify6DigitEmailCodeSuccess :: HasCallStack => App () +testLoginVerify6DigitEmailCodeSuccess :: (HasCallStack) => App () testLoginVerify6DigitEmailCodeSuccess = do (owner, team, []) <- createTeam OwnDomain 0 email <- owner %. "email" @@ -25,7 +25,7 @@ testLoginVerify6DigitEmailCodeSuccess = do -- -- Test that login fails with wrong second factor email verification code -testLoginVerify6DigitWrongCodeFails :: HasCallStack => App () +testLoginVerify6DigitWrongCodeFails :: (HasCallStack) => App () testLoginVerify6DigitWrongCodeFails = do (owner, team, []) <- createTeam OwnDomain 0 email <- owner %. "email" @@ -40,7 +40,7 @@ testLoginVerify6DigitWrongCodeFails = do -- -- Test that login without verification code fails if SndFactorPasswordChallenge feature is enabled in team -testLoginVerify6DigitMissingCodeFails :: HasCallStack => App () +testLoginVerify6DigitMissingCodeFails :: (HasCallStack) => App () testLoginVerify6DigitMissingCodeFails = do (owner, team, []) <- createTeam OwnDomain 0 email <- owner %. "email" @@ -52,7 +52,7 @@ testLoginVerify6DigitMissingCodeFails = do -- -- Test that login fails with expired second factor email verification code -testLoginVerify6DigitExpiredCodeFails :: HasCallStack => App () +testLoginVerify6DigitExpiredCodeFails :: (HasCallStack) => App () testLoginVerify6DigitExpiredCodeFails = do withModifiedBackend (def {brigCfg = setField "optSettings.setVerificationTimeout" (Aeson.Number 2)}) @@ -73,7 +73,7 @@ testLoginVerify6DigitExpiredCodeFails = do resp.status `shouldMatchInt` 403 resp.json %. "label" `shouldMatch` "code-authentication-failed" -testLoginVerify6DigitResendCodeSuccessAndRateLimiting :: HasCallStack => App () +testLoginVerify6DigitResendCodeSuccessAndRateLimiting :: (HasCallStack) => App () testLoginVerify6DigitResendCodeSuccessAndRateLimiting = do (owner, team, []) <- createTeam OwnDomain 0 email <- owner %. "email" @@ -95,7 +95,7 @@ testLoginVerify6DigitResendCodeSuccessAndRateLimiting = do bindResponse (loginWith2ndFactor owner email defPassword mostRecentCode) \resp -> do resp.status `shouldMatchInt` 200 -testLoginVerify6DigitLimitRetries :: HasCallStack => App () +testLoginVerify6DigitLimitRetries :: (HasCallStack) => App () testLoginVerify6DigitLimitRetries = do (owner, team, []) <- createTeam OwnDomain 0 email <- owner %. "email" diff --git a/integration/test/Test/MLS.hs b/integration/test/Test/MLS.hs index b6df53ab4bb..c3a9d707ba5 100644 --- a/integration/test/Test/MLS.hs +++ b/integration/test/Test/MLS.hs @@ -16,7 +16,7 @@ import SetupHelpers import Test.Version import Testlib.Prelude -testSendMessageNoReturnToSender :: HasCallStack => App () +testSendMessageNoReturnToSender :: (HasCallStack) => App () testSendMessageNoReturnToSender = do [alice, bob] <- createAndConnectUsers [OwnDomain, OwnDomain] [alice1, alice2, bob1, bob2] <- traverse (createMLSClient def) [alice, alice, bob, bob] @@ -33,8 +33,8 @@ testSendMessageNoReturnToSender = do for_ wss $ \ws -> do n <- awaitMatch (\n -> nPayload n %. "type" `isEqual` "conversation.mls-message-add") ws nPayload n %. "data" `shouldMatch` T.decodeUtf8 (Base64.encode mp.message) - expectFailure (const $ pure ()) $ - awaitMatch + expectFailure (const $ pure ()) + $ awaitMatch ( \n -> liftM2 (&&) @@ -43,7 +43,7 @@ testSendMessageNoReturnToSender = do ) wsSender -testStaleApplicationMessage :: HasCallStack => Domain -> App () +testStaleApplicationMessage :: (HasCallStack) => Domain -> App () testStaleApplicationMessage otherDomain = do [alice, bob, charlie, dave, eve] <- createAndConnectUsers [OwnDomain, otherDomain, OwnDomain, OwnDomain, OwnDomain] @@ -70,7 +70,7 @@ testStaleApplicationMessage otherDomain = do -- bob's application messages are now rejected void $ postMLSMessage bob1 msg2.message >>= getJSON 409 -testMixedProtocolUpgrade :: HasCallStack => Domain -> App () +testMixedProtocolUpgrade :: (HasCallStack) => Domain -> App () testMixedProtocolUpgrade secondDomain = do (alice, tid, _) <- createTeam OwnDomain 1 [bob, charlie] <- replicateM 2 (randomUser secondDomain def) @@ -113,7 +113,7 @@ testMixedProtocolUpgrade secondDomain = do bindResponse (putConversationProtocol bob qcnv "invalid") $ \resp -> do resp.status `shouldMatchInt` 400 -testMixedProtocolNonTeam :: HasCallStack => Domain -> App () +testMixedProtocolNonTeam :: (HasCallStack) => Domain -> App () testMixedProtocolNonTeam secondDomain = do [alice, bob] <- createAndConnectUsers [OwnDomain, secondDomain] qcnv <- @@ -123,7 +123,7 @@ testMixedProtocolNonTeam secondDomain = do bindResponse (putConversationProtocol bob qcnv "mixed") $ \resp -> do resp.status `shouldMatchInt` 403 -testMixedProtocolAddUsers :: HasCallStack => Domain -> Ciphersuite -> App () +testMixedProtocolAddUsers :: (HasCallStack) => Domain -> Ciphersuite -> App () testMixedProtocolAddUsers secondDomain suite = do setMLSCiphersuite suite (alice, tid, _) <- createTeam OwnDomain 1 @@ -160,7 +160,7 @@ testMixedProtocolAddUsers secondDomain suite = do (suiteCode, _) <- assertOne $ T.hexadecimal (T.pack suite.code) resp.json %. "cipher_suite" `shouldMatchInt` suiteCode -testMixedProtocolUserLeaves :: HasCallStack => Domain -> App () +testMixedProtocolUserLeaves :: (HasCallStack) => Domain -> App () testMixedProtocolUserLeaves secondDomain = do (alice, tid, _) <- createTeam OwnDomain 1 bob <- randomUser secondDomain def @@ -196,7 +196,7 @@ testMixedProtocolUserLeaves secondDomain = do msg %. "message.content.body.Proposal.Remove.removed" `shouldMatchInt` leafIndexBob msg %. "message.content.sender.External" `shouldMatchInt` 0 -testMixedProtocolAddPartialClients :: HasCallStack => Domain -> App () +testMixedProtocolAddPartialClients :: (HasCallStack) => Domain -> App () testMixedProtocolAddPartialClients secondDomain = do (alice, tid, _) <- createTeam OwnDomain 1 bob <- randomUser secondDomain def @@ -235,7 +235,7 @@ testMixedProtocolAddPartialClients secondDomain = do mp <- createAddCommitWithKeyPackages bob1 [kp2] void $ postMLSCommitBundle mp.sender (mkBundle mp) >>= getJSON 201 -testMixedProtocolRemovePartialClients :: HasCallStack => Domain -> App () +testMixedProtocolRemovePartialClients :: (HasCallStack) => Domain -> App () testMixedProtocolRemovePartialClients secondDomain = do (alice, tid, _) <- createTeam OwnDomain 1 bob <- randomUser secondDomain def @@ -261,7 +261,7 @@ testMixedProtocolRemovePartialClients secondDomain = do void $ postMLSCommitBundle mp.sender (mkBundle mp) >>= getJSON 201 -testMixedProtocolAppMessagesAreDenied :: HasCallStack => Domain -> App () +testMixedProtocolAppMessagesAreDenied :: (HasCallStack) => Domain -> App () testMixedProtocolAppMessagesAreDenied secondDomain = do (alice, tid, _) <- createTeam OwnDomain 1 bob <- randomUser secondDomain def @@ -290,7 +290,7 @@ testMixedProtocolAppMessagesAreDenied secondDomain = do resp.status `shouldMatchInt` 422 resp.json %. "label" `shouldMatch` "mls-unsupported-message" -testMLSProtocolUpgrade :: HasCallStack => Domain -> App () +testMLSProtocolUpgrade :: (HasCallStack) => Domain -> App () testMLSProtocolUpgrade secondDomain = do (alice, bob, conv) <- simpleMixedConversationSetup secondDomain charlie <- randomUser OwnDomain def @@ -332,7 +332,7 @@ testMLSProtocolUpgrade secondDomain = do resp.status `shouldMatchInt` 200 resp.json %. "protocol" `shouldMatch` "mls" -testAddUserSimple :: HasCallStack => Ciphersuite -> CredentialType -> App () +testAddUserSimple :: (HasCallStack) => Ciphersuite -> CredentialType -> App () testAddUserSimple suite ctype = do setMLSCiphersuite suite [alice, bob] <- createAndConnectUsers [OwnDomain, OwnDomain] @@ -366,12 +366,12 @@ testAddUserSimple suite ctype = do -- check that bob can now see the conversation convs <- getAllConvs bob convIds <- traverse (%. "qualified_id") convs - void $ - assertBool + void + $ assertBool "Users added to an MLS group should find it when listing conversations" (qcnv `elem` convIds) -testRemoteAddUser :: HasCallStack => App () +testRemoteAddUser :: (HasCallStack) => App () testRemoteAddUser = do [alice, bob, charlie] <- createAndConnectUsers [OwnDomain, OtherDomain, OwnDomain] [alice1, bob1, charlie1] <- traverse (createMLSClient def) [alice, bob, charlie] @@ -388,7 +388,7 @@ testRemoteAddUser = do resp.status `shouldMatchInt` 500 resp.json %. "label" `shouldMatch` "federation-not-implemented" -testRemoteRemoveClient :: HasCallStack => Ciphersuite -> App () +testRemoteRemoveClient :: (HasCallStack) => Ciphersuite -> App () testRemoteRemoveClient suite = do setMLSCiphersuite suite [alice, bob] <- createAndConnectUsers [OwnDomain, OtherDomain] @@ -409,7 +409,7 @@ testRemoteRemoveClient suite = do msg %. "message.content.body.Proposal.Remove.removed" `shouldMatchInt` leafIndexBob msg %. "message.content.sender.External" `shouldMatchInt` 0 -testCreateSubConv :: HasCallStack => Ciphersuite -> App () +testCreateSubConv :: (HasCallStack) => Ciphersuite -> App () testCreateSubConv suite = do setMLSCiphersuite suite [alice, bob] <- createAndConnectUsers [OwnDomain, OwnDomain] @@ -448,7 +448,7 @@ testSelfConversation v = withVersion5 v $ do void $ createExternalCommit newClient Nothing >>= sendAndConsumeCommitBundle -- | FUTUREWORK: Don't allow partial adds, not even in the first commit -testFirstCommitAllowsPartialAdds :: HasCallStack => App () +testFirstCommitAllowsPartialAdds :: (HasCallStack) => App () testFirstCommitAllowsPartialAdds = do alice <- randomUser OwnDomain def @@ -466,7 +466,7 @@ testFirstCommitAllowsPartialAdds = do resp.status `shouldMatchInt` 409 resp.json %. "label" `shouldMatch` "mls-client-mismatch" -testAddUserPartial :: HasCallStack => App () +testAddUserPartial :: (HasCallStack) => App () testAddUserPartial = do [alice, bob, charlie] <- createAndConnectUsers (replicate 3 OwnDomain) @@ -494,7 +494,7 @@ testAddUserPartial = do err %. "label" `shouldMatch` "mls-client-mismatch" -- | admin removes user from a conversation but doesn't list all clients -testRemoveClientsIncomplete :: HasCallStack => App () +testRemoveClientsIncomplete :: (HasCallStack) => App () testRemoveClientsIncomplete = do [alice, bob] <- createAndConnectUsers [OwnDomain, OwnDomain] @@ -507,7 +507,7 @@ testRemoveClientsIncomplete = do err <- postMLSCommitBundle mp.sender (mkBundle mp) >>= getJSON 409 err %. "label" `shouldMatch` "mls-client-mismatch" -testAdminRemovesUserFromConv :: HasCallStack => Ciphersuite -> App () +testAdminRemovesUserFromConv :: (HasCallStack) => Ciphersuite -> App () testAdminRemovesUserFromConv suite = do setMLSCiphersuite suite [alice, bob] <- createAndConnectUsers [OwnDomain, OwnDomain] @@ -539,7 +539,7 @@ testAdminRemovesUserFromConv suite = do "bob is not longer part of conversation after the commit" (qcnv `notElem` convIds) -testLocalWelcome :: HasCallStack => App () +testLocalWelcome :: (HasCallStack) => App () testLocalWelcome = do users@[alice, bob] <- createAndConnectUsers [OwnDomain, OwnDomain] @@ -569,7 +569,7 @@ testLocalWelcome = do addedUser <- (event %. "data.users") >>= asList >>= assertOne objQid addedUser `shouldMatch` objQid bob -testStaleCommit :: HasCallStack => App () +testStaleCommit :: (HasCallStack) => App () testStaleCommit = do (alice : users) <- createAndConnectUsers (replicate 5 OwnDomain) let (users1, users2) = splitAt 2 users @@ -591,7 +591,7 @@ testStaleCommit = do resp.status `shouldMatchInt` 409 resp.json %. "label" `shouldMatch` "mls-stale-message" -testPropInvalidEpoch :: HasCallStack => App () +testPropInvalidEpoch :: (HasCallStack) => App () testPropInvalidEpoch = do users@[_alice, bob, charlie, dee] <- createAndConnectUsers (replicate 4 OwnDomain) [alice1, bob1, charlie1, dee1] <- traverse (createMLSClient def) users @@ -633,7 +633,7 @@ testPropInvalidEpoch = do --- | This test submits a ReInit proposal, which is currently ignored by the -- backend, in order to check that unsupported proposal types are accepted. -testPropUnsupported :: HasCallStack => App () +testPropUnsupported :: (HasCallStack) => App () testPropUnsupported = do users@[_alice, bob] <- createAndConnectUsers (replicate 2 OwnDomain) [alice1, bob1] <- traverse (createMLSClient def) users @@ -646,7 +646,7 @@ testPropUnsupported = do -- we cannot consume this message, because the membership tag is fake void $ postMLSMessage mp.sender mp.message >>= getJSON 201 -testAddUserBareProposalCommit :: HasCallStack => App () +testAddUserBareProposalCommit :: (HasCallStack) => App () testAddUserBareProposalCommit = do [alice, bob] <- createAndConnectUsers (replicate 2 OwnDomain) [alice1, bob1] <- traverse (createMLSClient def) [alice, bob] @@ -663,12 +663,12 @@ testAddUserBareProposalCommit = do -- check that bob can now see the conversation convs <- getAllConvs bob convIds <- traverse (%. "qualified_id") convs - void $ - assertBool + void + $ assertBool "Users added to an MLS group should find it when listing conversations" (qcnv `elem` convIds) -testPropExistingConv :: HasCallStack => App () +testPropExistingConv :: (HasCallStack) => App () testPropExistingConv = do [alice, bob] <- createAndConnectUsers (replicate 2 OwnDomain) [alice1, bob1] <- traverse (createMLSClient def) [alice, bob] @@ -678,7 +678,7 @@ testPropExistingConv = do res <- createAddProposals alice1 [bob] >>= traverse sendAndConsumeMessage >>= assertOne shouldBeEmpty (res %. "events") -testCommitNotReferencingAllProposals :: HasCallStack => App () +testCommitNotReferencingAllProposals :: (HasCallStack) => App () testCommitNotReferencingAllProposals = do users@[_alice, bob, charlie] <- createAndConnectUsers (replicate 3 OwnDomain) @@ -702,7 +702,7 @@ testCommitNotReferencingAllProposals = do resp.status `shouldMatchInt` 400 resp.json %. "label" `shouldMatch` "mls-commit-missing-references" -testUnsupportedCiphersuite :: HasCallStack => App () +testUnsupportedCiphersuite :: (HasCallStack) => App () testUnsupportedCiphersuite = do setMLSCiphersuite (Ciphersuite "0x0003") alice <- randomUser OwnDomain def @@ -715,7 +715,7 @@ testUnsupportedCiphersuite = do resp.status `shouldMatchInt` 400 resp.json %. "label" `shouldMatch` "mls-protocol-error" -testBackendRemoveProposal :: HasCallStack => Ciphersuite -> Domain -> App () +testBackendRemoveProposal :: (HasCallStack) => Ciphersuite -> Domain -> App () testBackendRemoveProposal suite domain = do setMLSCiphersuite suite [alice, bob] <- createAndConnectUsers [OwnDomain, domain] diff --git a/integration/test/Test/MLS/KeyPackage.hs b/integration/test/Test/MLS/KeyPackage.hs index cf6b721db88..507d7ff7eb3 100644 --- a/integration/test/Test/MLS/KeyPackage.hs +++ b/integration/test/Test/MLS/KeyPackage.hs @@ -119,9 +119,9 @@ testKeyPackageSelfClaim = do resp.json %. "key_packages" & asList - -- the keypackage claimed by client 1 should be issued by - -- client 2 - >>= \[v] -> v %. "client" `shouldMatch` alice2.client + -- the keypackage claimed by client 1 should be issued by + -- client 2 + >>= \[v] -> v %. "client" `shouldMatch` alice2.client -- - the keypackages of client 1 (claimer) should still be there -- - two of the keypackages of client 2 (claimee) should be stil @@ -179,7 +179,7 @@ testKeyPackageRemoteClaim = do resp.json %. "count" `shouldMatchInt` 0 resp.status `shouldMatchInt` 200 -testKeyPackageCount :: HasCallStack => Ciphersuite -> App () +testKeyPackageCount :: (HasCallStack) => Ciphersuite -> App () testKeyPackageCount cs = do setMLSCiphersuite cs alice <- randomUser OwnDomain def @@ -197,7 +197,7 @@ testKeyPackageCount cs = do resp.status `shouldMatchInt` 200 resp.json %. "count" `shouldMatchInt` count -testUnsupportedCiphersuite :: HasCallStack => App () +testUnsupportedCiphersuite :: (HasCallStack) => App () testUnsupportedCiphersuite = do let suite = Ciphersuite "0x0003" setMLSCiphersuite suite @@ -208,7 +208,7 @@ testUnsupportedCiphersuite = do resp.status `shouldMatchInt` 400 resp.json %. "label" `shouldMatch` "mls-protocol-error" -testReplaceKeyPackages :: HasCallStack => App () +testReplaceKeyPackages :: (HasCallStack) => App () testReplaceKeyPackages = do alice <- randomUser OwnDomain def [alice1, alice2] <- replicateM 2 $ createMLSClient def alice @@ -220,15 +220,15 @@ testReplaceKeyPackages = do resp.json %. "count" `shouldMatchInt` n -- setup: upload a batch of key packages for each ciphersuite - void $ - replicateM 4 (fmap fst (generateKeyPackage alice1)) - >>= uploadKeyPackages alice1 - >>= getBody 201 + void + $ replicateM 4 (fmap fst (generateKeyPackage alice1)) + >>= uploadKeyPackages alice1 + >>= getBody 201 setMLSCiphersuite suite - void $ - replicateM 5 (fmap fst (generateKeyPackage alice1)) - >>= uploadKeyPackages alice1 - >>= getBody 201 + void + $ replicateM 5 (fmap fst (generateKeyPackage alice1)) + >>= uploadKeyPackages alice1 + >>= getBody 201 checkCount def 4 checkCount suite 5 @@ -245,8 +245,9 @@ testReplaceKeyPackages = do -- claim all key packages one by one claimed <- - replicateM 3 $ - bindResponse (claimKeyPackages suite alice2 alice) $ \resp -> do + replicateM 3 + $ bindResponse (claimKeyPackages suite alice2 alice) + $ \resp -> do resp.status `shouldMatchInt` 200 ks <- resp.json %. "key_packages" & asList k <- assertOne ks @@ -259,10 +260,10 @@ testReplaceKeyPackages = do do -- replenish key packages for the second ciphersuite - void $ - replicateM 5 (fmap fst (generateKeyPackage alice1)) - >>= uploadKeyPackages alice1 - >>= getBody 201 + void + $ replicateM 5 (fmap fst (generateKeyPackage alice1)) + >>= uploadKeyPackages alice1 + >>= getBody 201 checkCount def 4 checkCount suite 5 diff --git a/integration/test/Test/MLS/Keys.hs b/integration/test/Test/MLS/Keys.hs index 64bba22e119..d5ac4867c60 100644 --- a/integration/test/Test/MLS/Keys.hs +++ b/integration/test/Test/MLS/Keys.hs @@ -6,7 +6,7 @@ import qualified Data.ByteString.Char8 as B8 import SetupHelpers import Testlib.Prelude -testPublicKeys :: HasCallStack => App () +testPublicKeys :: (HasCallStack) => App () testPublicKeys = do u <- randomUserId OwnDomain keys <- getMLSPublicKeys u >>= getJSON 200 @@ -48,7 +48,7 @@ testPublicKeys = do pubkeyY <- assertOne . toList . B64U.decodeUnpadded $ B8.pack pubkeyYS B8.length pubkeyY `shouldMatchInt` 66 -testPublicKeysMLSNotEnabled :: HasCallStack => App () +testPublicKeysMLSNotEnabled :: (HasCallStack) => App () testPublicKeysMLSNotEnabled = withModifiedBackend def { galleyCfg = removeField "settings.mlsPrivateKeyPaths" diff --git a/integration/test/Test/MLS/Message.hs b/integration/test/Test/MLS/Message.hs index 3a7c2efc213..e15635f4987 100644 --- a/integration/test/Test/MLS/Message.hs +++ b/integration/test/Test/MLS/Message.hs @@ -27,7 +27,7 @@ import SetupHelpers import Testlib.Prelude -- | Test happy case of federated MLS message sending in both directions. -testApplicationMessage :: HasCallStack => App () +testApplicationMessage :: (HasCallStack) => App () testApplicationMessage = do -- local alice and alex, remote bob [alice, alex, bob, betty] <- @@ -55,7 +55,7 @@ testApplicationMessage = do void $ createApplicationMessage bob1 "hey" >>= sendAndConsumeMessage traverse_ (awaitMatch isNewMLSMessageNotif) wss -testAppMessageSomeReachable :: HasCallStack => App () +testAppMessageSomeReachable :: (HasCallStack) => App () testAppMessageSomeReachable = do alice1 <- startDynamicBackends [mempty] $ \[thirdDomain] -> do ownDomain <- make OwnDomain & asString @@ -75,7 +75,7 @@ testAppMessageSomeReachable = do mp <- createApplicationMessage alice1 "hi, bob!" void $ postMLSMessage mp.sender mp.message >>= getJSON 201 -testMessageNotifications :: HasCallStack => Domain -> App () +testMessageNotifications :: (HasCallStack) => Domain -> App () testMessageNotifications bobDomain = do [alice, bob] <- createAndConnectUsers [OwnDomain, bobDomain] @@ -105,7 +105,7 @@ testMessageNotifications bobDomain = do get def `shouldMatchInt` (numNotifs + 1) get def {client = Just bobClient} `shouldMatchInt` (numNotifsClient + 1) -testMultipleMessages :: HasCallStack => App () +testMultipleMessages :: (HasCallStack) => App () testMultipleMessages = do [alice, bob] <- createAndConnectUsers [OwnDomain, OtherDomain] [alice1, bob1] <- traverse (createMLSClient def) [alice, bob] diff --git a/integration/test/Test/MLS/Notifications.hs b/integration/test/Test/MLS/Notifications.hs index ad0595a48c6..61a0b60d53f 100644 --- a/integration/test/Test/MLS/Notifications.hs +++ b/integration/test/Test/MLS/Notifications.hs @@ -6,7 +6,7 @@ import Notifications import SetupHelpers import Testlib.Prelude -testWelcomeNotification :: HasCallStack => App () +testWelcomeNotification :: (HasCallStack) => App () testWelcomeNotification = do [alice, bob] <- createAndConnectUsers [OwnDomain, OtherDomain] [alice1, alice2, bob1, bob2] <- traverse (createMLSClient def) [alice, alice, bob, bob] diff --git a/integration/test/Test/MLS/One2One.hs b/integration/test/Test/MLS/One2One.hs index c8b5e4deedb..338cae3a7e4 100644 --- a/integration/test/Test/MLS/One2One.hs +++ b/integration/test/Test/MLS/One2One.hs @@ -30,7 +30,7 @@ import SetupHelpers import Test.Version import Testlib.Prelude -testGetMLSOne2One :: HasCallStack => Version5 -> Domain -> App () +testGetMLSOne2One :: (HasCallStack) => Version5 -> Domain -> App () testGetMLSOne2One v otherDomain = withVersion5 v $ do [alice, bob] <- createAndConnectUsers [OwnDomain, otherDomain] @@ -59,7 +59,7 @@ testGetMLSOne2One v otherDomain = withVersion5 v $ do conv2 %. "qualified_id" `shouldMatch` convId assertConvData conv2 -testMLSOne2OneOtherMember :: HasCallStack => One2OneScenario -> App () +testMLSOne2OneOtherMember :: (HasCallStack) => One2OneScenario -> App () testMLSOne2OneOtherMember scenario = do alice <- randomUser OwnDomain def let otherDomain = one2OneScenarioUserDomain scenario @@ -92,14 +92,14 @@ testMLSOne2OneOtherMember scenario = do getMLSOne2OneConversation self other `bindResponse` assertOthers other getConversation self conv `bindResponse` assertOthers other -testGetMLSOne2OneUnconnected :: HasCallStack => Domain -> App () +testGetMLSOne2OneUnconnected :: (HasCallStack) => Domain -> App () testGetMLSOne2OneUnconnected otherDomain = do [alice, bob] <- for [OwnDomain, otherDomain] $ \domain -> randomUser domain def bindResponse (getMLSOne2OneConversation alice bob) $ \resp -> resp.status `shouldMatchInt` 403 -testMLSOne2OneBlocked :: HasCallStack => Domain -> App () +testMLSOne2OneBlocked :: (HasCallStack) => Domain -> App () testMLSOne2OneBlocked otherDomain = do [alice, bob] <- for [OwnDomain, otherDomain] $ flip randomUser def void $ postConnection bob alice >>= getBody 201 @@ -108,7 +108,7 @@ testMLSOne2OneBlocked otherDomain = do void $ getMLSOne2OneConversation bob alice >>= getJSON 403 -- | Alice and Bob are initially connected, but then Alice blocks Bob. -testMLSOne2OneBlockedAfterConnected :: HasCallStack => One2OneScenario -> App () +testMLSOne2OneBlockedAfterConnected :: (HasCallStack) => One2OneScenario -> App () testMLSOne2OneBlockedAfterConnected scenario = do alice <- randomUser OwnDomain def let otherDomain = one2OneScenarioUserDomain scenario @@ -147,7 +147,7 @@ testMLSOne2OneBlockedAfterConnected scenario = do -- | Alice and Bob are initially connected, then Alice blocks Bob, and finally -- Alice unblocks Bob. -testMLSOne2OneUnblocked :: HasCallStack => One2OneScenario -> App () +testMLSOne2OneUnblocked :: (HasCallStack) => One2OneScenario -> App () testMLSOne2OneUnblocked scenario = do alice <- randomUser OwnDomain def let otherDomain = one2OneScenarioUserDomain scenario @@ -230,7 +230,7 @@ one2OneScenarioConvDomain One2OneScenarioLocal = OwnDomain one2OneScenarioConvDomain One2OneScenarioLocalConv = OwnDomain one2OneScenarioConvDomain One2OneScenarioRemoteConv = OtherDomain -testMLSOne2One :: HasCallStack => Ciphersuite -> One2OneScenario -> App () +testMLSOne2One :: (HasCallStack) => Ciphersuite -> One2OneScenario -> App () testMLSOne2One suite scenario = do setMLSCiphersuite suite alice <- randomUser OwnDomain def diff --git a/integration/test/Test/MLS/SubConversation.hs b/integration/test/Test/MLS/SubConversation.hs index d73095030da..c6228461bd0 100644 --- a/integration/test/Test/MLS/SubConversation.hs +++ b/integration/test/Test/MLS/SubConversation.hs @@ -26,11 +26,11 @@ testJoinSubConv = do assertBool "Epoch timestamp should not be null" (tm /= Null) -- now alice joins with her own client - void $ - createExternalCommit alice1 Nothing - >>= sendAndConsumeCommitBundle + void + $ createExternalCommit alice1 Nothing + >>= sendAndConsumeCommitBundle -testDeleteParentOfSubConv :: HasCallStack => Domain -> App () +testDeleteParentOfSubConv :: (HasCallStack) => Domain -> App () testDeleteParentOfSubConv secondDomain = do (alice, tid, _) <- createTeam OwnDomain 1 bob <- randomUser secondDomain def @@ -81,7 +81,7 @@ testDeleteParentOfSubConv secondDomain = do resp.status `shouldMatchInt` 404 resp.json %. "label" `shouldMatch` "no-conversation" -testDeleteSubConversation :: HasCallStack => Domain -> App () +testDeleteSubConversation :: (HasCallStack) => Domain -> App () testDeleteSubConversation otherDomain = do [alice, bob] <- createAndConnectUsers [OwnDomain, otherDomain] charlie <- randomUser OwnDomain def @@ -105,7 +105,7 @@ testDeleteSubConversation otherDomain = do data Leaver = Alice | Bob deriving stock (Generic) -testLeaveSubConv :: HasCallStack => Leaver -> App () +testLeaveSubConv :: (HasCallStack) => Leaver -> App () testLeaveSubConv leaver = do [alice, bob, charlie] <- createAndConnectUsers [OwnDomain, OwnDomain, OtherDomain] clients@[alice1, bob1, bob2, charlie1] <- traverse (createMLSClient def) [alice, bob, bob, charlie] @@ -224,7 +224,7 @@ testCreatorRemovesUserFromParent = do ws msg %. "payload.0.data" & asByteString - >>= mlsCliConsume consumer + >>= mlsCliConsume consumer -- remove bob from the child state modifyMLSState $ \s -> s {members = s.members Set.\\ Set.fromList [bob1, bob2]} diff --git a/integration/test/Test/MLS/Unreachable.hs b/integration/test/Test/MLS/Unreachable.hs index be8564352f5..4e32d293508 100644 --- a/integration/test/Test/MLS/Unreachable.hs +++ b/integration/test/Test/MLS/Unreachable.hs @@ -26,7 +26,7 @@ import SetupHelpers import Testlib.Prelude import Testlib.ResourcePool -testAddUsersSomeReachable :: HasCallStack => App () +testAddUsersSomeReachable :: (HasCallStack) => App () testAddUsersSomeReachable = do (addCommit, d) <- startDynamicBackends [mempty] $ \[thirdDomain] -> do ownDomain <- make OwnDomain & asString @@ -48,7 +48,7 @@ testAddUsersSomeReachable = do (resp.json %. "unreachable_backends" & asList) `shouldMatch` [d] -- | There is analogous counterpart for Proteus in the 'Test.Conversation' module. -testAddUserWithUnreachableRemoteUsers :: HasCallStack => App () +testAddUserWithUnreachableRemoteUsers :: (HasCallStack) => App () testAddUserWithUnreachableRemoteUsers = do resourcePool <- asks resourcePool runCodensity (acquireResources 1 resourcePool) $ \[cDom] -> do @@ -88,7 +88,7 @@ testAddUserWithUnreachableRemoteUsers = do resp.status `shouldMatchInt` 533 resp.jsonBody %. "unreachable_backends" `shouldMatchSet` [cDom.berDomain] -testAddUnreachableUserFromFederatingBackend :: HasCallStack => App () +testAddUnreachableUserFromFederatingBackend :: (HasCallStack) => App () testAddUnreachableUserFromFederatingBackend = do resourcePool <- asks resourcePool runCodensity (acquireResources 1 resourcePool) $ \[cDom] -> do diff --git a/integration/test/Test/MessageTimer.hs b/integration/test/Test/MessageTimer.hs index 9e2e38d4a66..853876c8632 100644 --- a/integration/test/Test/MessageTimer.hs +++ b/integration/test/Test/MessageTimer.hs @@ -26,7 +26,7 @@ import SetupHelpers import Testlib.Prelude import Testlib.ResourcePool -testMessageTimerChangeWithRemotes :: HasCallStack => App () +testMessageTimerChangeWithRemotes :: (HasCallStack) => App () testMessageTimerChangeWithRemotes = do [alice, bob] <- createAndConnectUsers [OwnDomain, OtherDomain] conv <- postConversation alice defProteus {qualifiedUsers = [bob]} >>= getJSON 201 @@ -37,7 +37,7 @@ testMessageTimerChangeWithRemotes = do notif %. "payload.0.qualified_conversation" `shouldMatch` objQidObject conv notif %. "payload.0.qualified_from" `shouldMatch` objQidObject alice -testMessageTimerChangeWithUnreachableRemotes :: HasCallStack => App () +testMessageTimerChangeWithUnreachableRemotes :: (HasCallStack) => App () testMessageTimerChangeWithUnreachableRemotes = do resourcePool <- asks resourcePool alice <- randomUser OwnDomain def diff --git a/integration/test/Test/Notifications.hs b/integration/test/Test/Notifications.hs index 14078b5b56e..b94060814ca 100644 --- a/integration/test/Test/Notifications.hs +++ b/integration/test/Test/Notifications.hs @@ -9,11 +9,11 @@ import Notifications import SetupHelpers import Testlib.Prelude -examplePush :: MakesValue u => u -> App Value +examplePush :: (MakesValue u) => u -> App Value examplePush u = do r <- recipient u - pure $ - object + pure + $ object [ "recipients" .= [r], "payload" .= [object ["hello" .= "world"]] ] @@ -24,8 +24,9 @@ testFetchAllNotifications = do push <- examplePush user let n = 10 - replicateM_ n $ - bindResponse (postPush user [push]) $ \res -> + replicateM_ n + $ bindResponse (postPush user [push]) + $ \res -> res.status `shouldMatchInt` 200 let c :: Maybe String = Just "deadbeef" @@ -74,23 +75,23 @@ testLastNotification = do lastNotif <- getLastNotification user def {client = Just "c"} >>= getJSON 200 lastNotif %. "payload" `shouldMatch` [object ["client" .= "c"]] -testInvalidNotification :: HasCallStack => App () +testInvalidNotification :: (HasCallStack) => App () testInvalidNotification = do user <- randomUserId OwnDomain -- test uuid v4 as "since" do notifId <- randomId - void $ - getNotifications user def {since = Just notifId} - >>= getJSON 400 + void + $ getNotifications user def {since = Just notifId} + >>= getJSON 400 -- test arbitrary uuid v1 as "since" do notifId <- randomUUIDv1 - void $ - getNotifications user def {since = Just notifId} - >>= getJSON 404 + void + $ getNotifications user def {since = Just notifId} + >>= getJSON 404 -- | Check that client-add notifications use the V5 format: -- @ @@ -98,7 +99,7 @@ testInvalidNotification = do -- @ -- -- Migration plan: clients must be able to parse both old and new schema starting from V6. Once V5 is deprecated, the backend can start sending notifications in the new form. -testAddClientNotification :: HasCallStack => App () +testAddClientNotification :: (HasCallStack) => App () testAddClientNotification = do alice <- randomUser OwnDomain def diff --git a/integration/test/Test/Presence.hs b/integration/test/Test/Presence.hs index e6252ea7e2a..75e45a51e38 100644 --- a/integration/test/Test/Presence.hs +++ b/integration/test/Test/Presence.hs @@ -12,7 +12,7 @@ ensurePresent u n = retryT $ do ps <- getPresence u >>= getJSON 200 >>= asList length ps `shouldMatchInt` n -registerUser :: HasCallStack => App (Value, String) +registerUser :: (HasCallStack) => App (Value, String) registerUser = do alice <- randomUserId OwnDomain c <- randomClientId @@ -20,10 +20,10 @@ registerUser = do ensurePresent alice 1 pure (alice, c) -testAddUser :: HasCallStack => App () +testAddUser :: (HasCallStack) => App () testAddUser = void registerUser -testRemoveUser :: HasCallStack => App () +testRemoveUser :: (HasCallStack) => App () testRemoveUser = do -- register alice and add a push token (alice, c) <- registerUser diff --git a/integration/test/Test/Provider.hs b/integration/test/Test/Provider.hs index 5663fb11912..9eb08ea114e 100644 --- a/integration/test/Test/Provider.hs +++ b/integration/test/Test/Provider.hs @@ -10,7 +10,7 @@ import Data.String.Conversions (cs) import SetupHelpers import Testlib.Prelude -testProviderUploadAsset :: HasCallStack => App () +testProviderUploadAsset :: (HasCallStack) => App () testProviderUploadAsset = do email <- randomEmail alice <- randomUser OwnDomain def diff --git a/integration/test/Test/Roles.hs b/integration/test/Test/Roles.hs index 34ccaff2eba..53886aae61e 100644 --- a/integration/test/Test/Roles.hs +++ b/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 diff --git a/integration/test/Test/Search.hs b/integration/test/Test/Search.hs index fab4fd54daa..af3f00d4e56 100644 --- a/integration/test/Test/Search.hs +++ b/integration/test/Test/Search.hs @@ -14,7 +14,7 @@ import Testlib.Prelude -------------------------------------------------------------------------------- -- LOCAL SEARCH -testSearchContactForExternalUsers :: HasCallStack => App () +testSearchContactForExternalUsers :: (HasCallStack) => App () testSearchContactForExternalUsers = do owner <- randomUser OwnDomain def {BrigI.team = True} tid <- owner %. "team" & asString @@ -74,7 +74,7 @@ data FedUserSearchTestCase = FedUserSearchTestCase } deriving (Eq, Ord, Show) -testFederatedUserSearch :: HasCallStack => App () +testFederatedUserSearch :: (HasCallStack) => App () testFederatedUserSearch = do let tcs = [ -- no search @@ -102,7 +102,7 @@ testFederatedUserSearch = do void $ BrigI.createFedConn d1 (BrigI.FedConn d2 "full_search" Nothing) forM_ tcs (federatedUserSearch d1 d2) -federatedUserSearch :: HasCallStack => String -> String -> FedUserSearchTestCase -> App () +federatedUserSearch :: (HasCallStack) => String -> String -> FedUserSearchTestCase -> App () federatedUserSearch d1 d2 test = do void $ BrigI.updateFedConn d2 d1 (BrigI.FedConn d1 test.searchPolicy (restriction test.restrictionD2D1)) void $ BrigI.updateFedConn d1 d2 (BrigI.FedConn d2 test.searchPolicy (restriction test.restrictionD1D2)) @@ -158,7 +158,7 @@ federatedUserSearch d1 d2 test = do TeamAllowed -> do BrigI.addFederationRemoteTeam ownDomain remoteDomain remoteTeam -testFederatedUserSearchNonTeamSearcher :: HasCallStack => App () +testFederatedUserSearchNonTeamSearcher :: (HasCallStack) => App () testFederatedUserSearchNonTeamSearcher = do startDynamicBackends [def, def] $ \[d1, d2] -> do void $ BrigI.createFedConn d2 (BrigI.FedConn d1 "full_search" (Just [])) @@ -189,7 +189,7 @@ testFederatedUserSearchNonTeamSearcher = do doc : _ -> assertFailure $ "Expected an empty result, but got " <> show doc <> " for test case " -testFederatedUserSearchForNonTeamUser :: HasCallStack => App () +testFederatedUserSearchForNonTeamUser :: (HasCallStack) => App () testFederatedUserSearchForNonTeamUser = do startDynamicBackends [def, def] $ \[d1, d2] -> do void $ BrigI.createFedConn d2 (BrigI.FedConn d1 "full_search" Nothing) diff --git a/integration/test/Test/Services.hs b/integration/test/Test/Services.hs index 3156a98561f..eea1ced16b3 100644 --- a/integration/test/Test/Services.hs +++ b/integration/test/Test/Services.hs @@ -22,7 +22,7 @@ import API.Common import SetupHelpers import Testlib.Prelude -testUpdateServiceUpdateAcceptHeader :: HasCallStack => App () +testUpdateServiceUpdateAcceptHeader :: (HasCallStack) => App () testUpdateServiceUpdateAcceptHeader = do let dom = OwnDomain email <- randomEmail @@ -31,12 +31,12 @@ testUpdateServiceUpdateAcceptHeader = do pId <- provider %. "id" & asString service <- newService dom pId def sId <- service %. "id" - void $ - updateService dom pId sId (Just "application/json") (Just "brand new service") - >>= getBody 200 - void $ - updateService dom pId sId (Just "text/plain") (Just "even newer service") - >>= getBody 200 - void $ - updateService dom pId sId Nothing (Just "really old service") - >>= getBody 200 + void + $ updateService dom pId sId (Just "application/json") (Just "brand new service") + >>= getBody 200 + void + $ updateService dom pId sId (Just "text/plain") (Just "even newer service") + >>= getBody 200 + void + $ updateService dom pId sId Nothing (Just "really old service") + >>= getBody 200 diff --git a/integration/test/Test/Spar.hs b/integration/test/Test/Spar.hs index d1e14e85984..ab147901071 100644 --- a/integration/test/Test/Spar.hs +++ b/integration/test/Test/Spar.hs @@ -7,7 +7,7 @@ import Control.Concurrent (threadDelay) import SetupHelpers import Testlib.Prelude -testSparUserCreationInvitationTimeout :: HasCallStack => App () +testSparUserCreationInvitationTimeout :: (HasCallStack) => App () testSparUserCreationInvitationTimeout = do (owner, _tid, _) <- createTeam OwnDomain 1 tok <- createScimToken owner >>= \resp -> resp.json %. "token" >>= asString diff --git a/integration/test/Test/Swagger.hs b/integration/test/Test/Swagger.hs index 76cf6ddc381..5836ead12e0 100644 --- a/integration/test/Test/Swagger.hs +++ b/integration/test/Test/Swagger.hs @@ -14,7 +14,7 @@ internalApis :: Set String internalApis = Set.fromList ["brig", "cannon", "cargohold", "cannon", "spar"] -- | See https://docs.wire.com/understand/api-client-perspective/swagger.html -testSwagger :: HasCallStack => App () +testSwagger :: (HasCallStack) => App () testSwagger = do bindResponse BrigP.getApiVersions $ \resp -> do resp.status `shouldMatchInt` 200 @@ -22,11 +22,13 @@ testSwagger = do sup <- resp.json %. "supported" & asSetOf asIntegral dev <- resp.json %. "development" & asSetOf asIntegral pure $ sup <> dev - assertBool ("unexpected actually existing versions: " <> show actualVersions) $ + assertBool ("unexpected actually existing versions: " <> show actualVersions) + $ -- make sure nobody has added a new version without adding it to `existingVersions`. -- ("subset" because blocked versions like v3 are not actually existing, but still -- documented.) - actualVersions `Set.isSubsetOf` existingVersions + actualVersions + `Set.isSubsetOf` existingVersions bindResponse BrigP.getSwaggerPublicTOC $ \resp -> do resp.status `shouldMatchInt` 200 @@ -52,7 +54,7 @@ testSwagger = do resp.status `shouldMatchInt` 200 void resp.json -testSwaggerInternalVersionedNotFound :: HasCallStack => App () +testSwaggerInternalVersionedNotFound :: (HasCallStack) => App () testSwaggerInternalVersionedNotFound = do forM_ internalApis $ \api -> do bindResponse (getSwaggerInternalUI api) $ \resp -> do @@ -63,7 +65,7 @@ testSwaggerInternalVersionedNotFound = do rawBaseRequest OwnDomain Brig (ExplicitVersion 2) (joinHttpPath ["api-internal", "swagger-ui", srv]) >>= submit "GET" -testSwaggerToc :: HasCallStack => App () +testSwaggerToc :: (HasCallStack) => App () testSwaggerToc = do forM_ ["/api/swagger-ui", "/api/swagger-ui/index.html", "/api/swagger.json"] $ \path -> bindResponse (get path) $ \resp -> do diff --git a/integration/test/Test/TeamSettings.hs b/integration/test/Test/TeamSettings.hs index 3be86c60d34..03a667cf78e 100644 --- a/integration/test/Test/TeamSettings.hs +++ b/integration/test/Test/TeamSettings.hs @@ -23,7 +23,7 @@ import API.Galley import SetupHelpers import Testlib.Prelude -testTeamSettingsUpdate :: HasCallStack => App () +testTeamSettingsUpdate :: (HasCallStack) => App () testTeamSettingsUpdate = do (ownerA, tidA, [mem]) <- createTeam OwnDomain 2 partner <- createTeamMemberWithRole ownerA tidA "partner" @@ -42,7 +42,7 @@ testTeamSettingsUpdate = do resp.status `shouldMatchInt` 403 resp.json %. "label" `shouldMatch` "no-team-member" -testTeamPropertiesUpdate :: HasCallStack => App () +testTeamPropertiesUpdate :: (HasCallStack) => App () testTeamPropertiesUpdate = do (ownerA, tidA, [mem]) <- createTeam OwnDomain 2 partner <- createTeamMemberWithRole ownerA tidA "partner" diff --git a/integration/test/Test/User.hs b/integration/test/Test/User.hs index 55fe4082550..4b397b680cc 100644 --- a/integration/test/Test/User.hs +++ b/integration/test/Test/User.hs @@ -11,7 +11,7 @@ import qualified Data.UUID.V4 as UUID import SetupHelpers import Testlib.Prelude -testSupportedProtocols :: HasCallStack => Domain -> App () +testSupportedProtocols :: (HasCallStack) => Domain -> App () testSupportedProtocols bobDomain = do alice <- randomUser OwnDomain def alice %. "supported_protocols" `shouldMatchSet` ["proteus"] @@ -43,7 +43,7 @@ testSupportedProtocols bobDomain = do resp.status `shouldMatchInt` 400 resp.json %. "label" `shouldMatch` "bad-request" -testCreateUserSupportedProtocols :: HasCallStack => App () +testCreateUserSupportedProtocols :: (HasCallStack) => App () testCreateUserSupportedProtocols = do alice <- randomUser OwnDomain def {supportedProtocols = Just ["proteus", "mls"]} bindResponse (getUserSupportedProtocols alice alice) $ \resp -> do @@ -56,7 +56,7 @@ testCreateUserSupportedProtocols = do -- | For now this only tests attempts to update /self/handle in E2EId-enabled teams. More -- tests can be found under `/services/brig/test/integration` (and should be moved here). -testUpdateHandle :: HasCallStack => App () +testUpdateHandle :: (HasCallStack) => App () testUpdateHandle = do -- create team with one member, without scim, but with `mlsE2EId` enabled. (owner, team, [mem1]) <- createTeam OwnDomain 2 @@ -120,7 +120,7 @@ testUpdateHandle = do -- | For now this only tests attempts to update one's own display name, email address, or -- language in E2EId-enabled teams (ie., everything except handle). More tests can be found -- under `/services/brig/test/integration` (and should be moved here). -testUpdateSelf :: HasCallStack => Tagged "mode" TestUpdateSelfMode -> App () +testUpdateSelf :: (HasCallStack) => Tagged "mode" TestUpdateSelfMode -> App () testUpdateSelf (MkTagged mode) = do -- create team with one member, without scim, but with `mlsE2EId` enabled. (owner, team, [mem1]) <- createTeam OwnDomain 2 diff --git a/integration/test/Test/Version.hs b/integration/test/Test/Version.hs index 40c4dfeb14d..abd59a49958 100644 --- a/integration/test/Test/Version.hs +++ b/integration/test/Test/Version.hs @@ -47,12 +47,12 @@ testVersion (Versioned' v) = withModifiedBackend domain `shouldMatch` dom federation `shouldMatch` True - unless (null (Set.intersection supported dev)) $ - assertFailure "development and supported versions should not overlap" + unless (null (Set.intersection supported dev)) + $ assertFailure "development and supported versions should not overlap" testVersionUnsupported :: App () -testVersionUnsupported = bindResponse (baseRequest OwnDomain Brig (ExplicitVersion 500) "/api-version" >>= submit "GET") $ - \resp -> do +testVersionUnsupported = bindResponse (baseRequest OwnDomain Brig (ExplicitVersion 500) "/api-version" >>= submit "GET") + $ \resp -> do resp.status `shouldMatchInt` 404 resp.json %. "label" `shouldMatch` "unsupported-version" diff --git a/integration/test/Testlib/App.hs b/integration/test/Testlib/App.hs index 904386a791e..38188f9a67e 100644 --- a/integration/test/Testlib/App.hs +++ b/integration/test/Testlib/App.hs @@ -18,7 +18,7 @@ import Testlib.JSON import Testlib.Types import Prelude -failApp :: HasCallStack => String -> App a +failApp :: (HasCallStack) => String -> App a failApp msg = throw (AppFailure msg) getPrekey :: App Value @@ -78,11 +78,11 @@ retryT :: App a -> App a retryT action = Retry.recoverAll (Retry.exponentialBackoff 8000 <> Retry.limitRetries 10) (const action) -- | make Bool lazy -liftBool :: Functor f => f Bool -> BoolT f +liftBool :: (Functor f) => f Bool -> BoolT f liftBool = MaybeT . fmap (bool Nothing (Just ())) -- | make Bool strict -unliftBool :: Functor f => BoolT f -> f Bool +unliftBool :: (Functor f) => BoolT f -> f Bool unliftBool = fmap isJust . runMaybeT -- | lazy (&&) diff --git a/integration/test/Testlib/Assertions.hs b/integration/test/Testlib/Assertions.hs index 7d19a5401a4..f426336b6c7 100644 --- a/integration/test/Testlib/Assertions.hs +++ b/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 diff --git a/integration/test/Testlib/Cannon.hs b/integration/test/Testlib/Cannon.hs index c6a57b66cce..9d0bbe22bd9 100644 --- a/integration/test/Testlib/Cannon.hs +++ b/integration/test/Testlib/Cannon.hs @@ -93,12 +93,12 @@ data WSConnect = WSConnect } class ToWSConnect a where - toWSConnect :: HasCallStack => a -> App WSConnect + toWSConnect :: (HasCallStack) => a -> App WSConnect instance {-# OVERLAPPING #-} ToWSConnect WSConnect where toWSConnect = pure -instance {-# OVERLAPPABLE #-} MakesValue user => ToWSConnect user where +instance {-# OVERLAPPABLE #-} (MakesValue user) => ToWSConnect user where toWSConnect u = do (domain, uid) <- objQid u mc <- lookupField u "client_id" @@ -118,14 +118,14 @@ instance (MakesValue user, MakesValue conn, MakesValue client) => ToWSConnect (u conn <- make c & asString pure (WSConnect uid domain (Just client) (Just conn)) -connect :: HasCallStack => WSConnect -> App WebSocket +connect :: (HasCallStack) => WSConnect -> App WebSocket connect wsConnect = do nchan <- liftIO newTChanIO latch <- liftIO newEmptyMVar wsapp <- run wsConnect (clientApp nchan latch) pure $ WebSocket nchan latch wsapp -clientApp :: HasCallStack => TChan Value -> MVar () -> WS.ClientApp () +clientApp :: (HasCallStack) => TChan Value -> MVar () -> WS.ClientApp () clientApp wsChan latch conn = do r <- async wsRead w <- async wsWrite @@ -143,7 +143,7 @@ clientApp wsChan latch conn = do -- | Start a client thread in 'Async' that opens a web socket to a Cannon, wait -- for the connection to register with Gundeck, and return the 'Async' thread. run :: - HasCallStack => + (HasCallStack) => WSConnect -> WS.ClientApp () -> App (Async ()) @@ -212,7 +212,7 @@ run wsConnect app = do liftIO $ race_ waitForPresence waitForException pure wsapp -close :: MonadIO m => WebSocket -> m () +close :: (MonadIO m) => WebSocket -> m () close ws = liftIO $ do putMVar (wsCloseLatch ws) () void $ waitCatch (wsAppThread ws) @@ -227,7 +227,7 @@ withWebSockets twcs k = do wcs <- for twcs toWSConnect go wcs [] where - go :: HasCallStack => [WSConnect] -> [WebSocket] -> App a + go :: (HasCallStack) => [WSConnect] -> [WebSocket] -> App a go [] wss = k (reverse wss) go (wc : wcs) wss = withWebSocket wc (\ws -> go wcs (ws : wss)) @@ -294,7 +294,7 @@ awaitAnyEvent tSecs = liftIO . timeout (tSecs * 1000 * 1000) . atomically . read -- received. When this functions returns it will push any non-matching -- events back to the websocket. awaitNMatchesResult :: - HasCallStack => + (HasCallStack) => -- | Number of matches Int -> -- | Selection function. Exceptions are *not* caught. @@ -334,7 +334,7 @@ awaitNMatchesResult nExpected checkMatch ws = go nExpected [] [] refill = mapM_ (liftIO . atomically . writeTChan (wsChan ws)) awaitAtLeastNMatchesResult :: - HasCallStack => + (HasCallStack) => -- | Minimum number of matches Int -> -- | Selection function. Exceptions are *not* caught. @@ -366,7 +366,7 @@ awaitAtLeastNMatchesResult nExpected checkMatch ws = go 0 [] [] refill = mapM_ (liftIO . atomically . writeTChan (wsChan ws)) awaitNToMMatchesResult :: - HasCallStack => + (HasCallStack) => -- | Minimum number of matches Int -> -- | Maximum number of matches @@ -400,7 +400,7 @@ awaitNToMMatchesResult nMin nMax checkMatch ws = go 0 [] [] refill = mapM_ (liftIO . atomically . writeTChan (wsChan ws)) awaitNMatches :: - HasCallStack => + (HasCallStack) => -- | Number of matches Int -> -- | Selection function. Should not throw any exceptions @@ -411,7 +411,7 @@ awaitNMatches nExpected checkMatch ws = do res <- awaitNMatchesResult nExpected checkMatch ws assertAwaitResult res -assertAwaitResult :: HasCallStack => AwaitResult -> App [Value] +assertAwaitResult :: (HasCallStack) => AwaitResult -> App [Value] assertAwaitResult res = do if res.success then pure res.matches @@ -421,7 +421,7 @@ assertAwaitResult res = do assertFailure $ unlines [msgHeader, details] awaitAtLeastNMatches :: - HasCallStack => + (HasCallStack) => -- | Minumum number of matches Int -> -- | Selection function. Should not throw any exceptions @@ -438,7 +438,7 @@ awaitAtLeastNMatches nExpected checkMatch ws = do assertFailure $ unlines [msgHeader, details] awaitNToMMatches :: - HasCallStack => + (HasCallStack) => -- | Minimum Number of matches Int -> -- | Maximum Number of matches @@ -457,7 +457,7 @@ awaitNToMMatches nMin nMax checkMatch ws = do assertFailure $ unlines [msgHeader, details] awaitMatch :: - HasCallStack => + (HasCallStack) => -- | Selection function. Should not throw any exceptions (Value -> App Bool) -> WebSocket -> @@ -465,7 +465,7 @@ awaitMatch :: awaitMatch checkMatch ws = head <$> awaitNMatches 1 checkMatch ws assertNoEvent :: - HasCallStack => + (HasCallStack) => Int -> WebSocket -> App () @@ -475,13 +475,13 @@ assertNoEvent to ws = do Just event -> assertFailure $ "Expected no event, but got: " <> show event Nothing -> pure () -nPayload :: MakesValue a => a -> App Value +nPayload :: (MakesValue a) => a -> App Value nPayload event = do payloads <- event %. "payload" & asList assertOne payloads -- | waits for an http response to satisfy a predicate -waitForResponse :: HasCallStack => App Response -> (Response -> App r) -> App r +waitForResponse :: (HasCallStack) => App Response -> (Response -> App r) -> App r waitForResponse act p = do tSecs <- asks timeOutSeconds r <- withRunInIO \inIO -> diff --git a/integration/test/Testlib/Certs.hs b/integration/test/Testlib/Certs.hs index 5a8ecee6af2..b6fda9b5204 100644 --- a/integration/test/Testlib/Certs.hs +++ b/integration/test/Testlib/Certs.hs @@ -37,10 +37,10 @@ keyPairToString :: RSAKeyPair -> (String, String) keyPairToString = bimap publicKeyToString privateKeyToString -- | the minimum key size is hard coded to be 256 bytes (= 2048 bits) -mkKeyPair :: HasCallStack => (Integer, Integer) -> App RSAKeyPair +mkKeyPair :: (HasCallStack) => (Integer, Integer) -> App RSAKeyPair mkKeyPair primes = - assertJust "key generation failed" $ - RSA.generateWith + assertJust "key generation failed" + $ RSA.generateWith primes 2048 65537 @@ -59,7 +59,7 @@ primesB = -- | create a root certificate authority CertificateBundle createRootCA :: - HasCallStack => + (HasCallStack) => -- | the root CA's name String -> -- | the root CA's keymaterial @@ -74,7 +74,7 @@ createRootCA caName (pubKey, privKey) = -- | sign an intermediate/ leaf certificate by signing with an intermediate/ root CA's key intermediateCert :: - HasCallStack => + (HasCallStack) => -- | name of the owner of the certificate String -> -- | the public key of the owner @@ -93,7 +93,7 @@ intermediateCert intermediateCaName pubKey rootCaName rootKey = -- | self sign a certificate selfSignedCert :: - HasCallStack => + (HasCallStack) => -- | name of the owner String -> -- | key material of the owner @@ -106,12 +106,12 @@ selfSignedCert ownerName (pubKey, privKey) = ownerName ownerName -signMsgWithPrivateKey :: HasCallStack => RSA.PrivateKey -> ByteString -> ByteString +signMsgWithPrivateKey :: (HasCallStack) => RSA.PrivateKey -> ByteString -> ByteString signMsgWithPrivateKey privKey = fromRight (error "signing unsuccessful") . PKCS15.sign Nothing (Just SHA256) privKey -- | create a signed certificate mkSignedCert :: - HasCallStack => + (HasCallStack) => -- | public key of the *owner* RSA.PublicKey -> -- | private key of *signatory* @@ -127,8 +127,8 @@ mkSignedCert pubKey privKey caName ownerName = [ (getObjectID DnCommonName, fromString $ name), (getObjectID DnCountry, fromString "DE") ] - in fst $ - objectToSignedExact + in fst + $ objectToSignedExact (\msg -> (signMsgWithPrivateKey privKey msg, SignatureALG HashSHA256 PubKeyALG_RSA, ())) Certificate { certVersion = 3, diff --git a/integration/test/Testlib/HTTP.hs b/integration/test/Testlib/HTTP.hs index 712c99a17ca..d155a45c46f 100644 --- a/integration/test/Testlib/HTTP.hs +++ b/integration/test/Testlib/HTTP.hs @@ -37,7 +37,7 @@ joinHttpPath = intercalate "/" addJSONObject :: [Aeson.Pair] -> HTTP.Request -> HTTP.Request addJSONObject = addJSON . Aeson.object -addJSON :: Aeson.ToJSON a => a -> HTTP.Request -> HTTP.Request +addJSON :: (Aeson.ToJSON a) => a -> HTTP.Request -> HTTP.Request addJSON obj = addBody (HTTP.RequestBodyLBS (Aeson.encode obj)) "application/json" addBody :: HTTP.RequestBody -> String -> HTTP.Request -> HTTP.Request @@ -83,41 +83,41 @@ contentTypeJSON = addHeader "Content-Type" "application/json" contentTypeMixed :: HTTP.Request -> HTTP.Request contentTypeMixed = addHeader "Content-Type" "multipart/mixed" -bindResponse :: HasCallStack => App Response -> (Response -> App a) -> App a +bindResponse :: (HasCallStack) => App Response -> (Response -> App a) -> App a bindResponse m k = m >>= \r -> withResponse r k infixl 1 `bindResponse` -withResponse :: HasCallStack => Response -> (Response -> App a) -> App a +withResponse :: (HasCallStack) => Response -> (Response -> App a) -> App a withResponse r k = onFailureAddResponse r (k r) -- | Check response status code, then return body. -getBody :: HasCallStack => Int -> Response -> App ByteString +getBody :: (HasCallStack) => Int -> Response -> App ByteString getBody status = flip withResponse \resp -> do resp.status `shouldMatch` status pure resp.body -- | Check response status code, then return JSON body. -getJSON :: HasCallStack => Int -> Response -> App Aeson.Value +getJSON :: (HasCallStack) => Int -> Response -> App Aeson.Value getJSON status = flip withResponse \resp -> do resp.status `shouldMatch` status resp.json -- | assert a response code in the 2** range -assertSuccess :: HasCallStack => Response -> App () +assertSuccess :: (HasCallStack) => Response -> App () assertSuccess = flip withResponse \resp -> resp.status `shouldMatchRange` (200, 299) -- | assert a response status code -assertStatus :: HasCallStack => Int -> Response -> App () +assertStatus :: (HasCallStack) => Int -> Response -> App () assertStatus status = flip withResponse \resp -> resp.status `shouldMatchInt` status -- | assert a failure with some failure code and label -assertLabel :: HasCallStack => Int -> String -> Response -> App () +assertLabel :: (HasCallStack) => Int -> String -> Response -> App () assertLabel status label resp = do j <- getJSON status resp j %. "label" `shouldMatch` label -onFailureAddResponse :: HasCallStack => Response -> App a -> App a +onFailureAddResponse :: (HasCallStack) => Response -> App a -> App a onFailureAddResponse r m = App $ do e <- ask liftIO $ E.catch (runAppWithEnv e m) $ \(AssertionFailure stack _ msg) -> do diff --git a/integration/test/Testlib/JSON.hs b/integration/test/Testlib/JSON.hs index 62eda62cba2..a62065ed5f4 100644 --- a/integration/test/Testlib/JSON.hs +++ b/integration/test/Testlib/JSON.hs @@ -54,42 +54,42 @@ import Prelude -- 2. has no "user" field -- 3. the nested update fails class MakesValue a where - make :: HasCallStack => a -> App Value + make :: (HasCallStack) => a -> App Value -instance {-# OVERLAPPABLE #-} ToJSON a => MakesValue a where +instance {-# OVERLAPPABLE #-} (ToJSON a) => MakesValue a where make = pure . toJSON -instance {-# OVERLAPPING #-} ToJSON a => MakesValue (App a) where +instance {-# OVERLAPPING #-} (ToJSON a) => MakesValue (App a) where make m = m <&> toJSON -- use this to provide Nothing for MakesValue a => (Maybe a) values. noValue :: Maybe Value noValue = Nothing -(.=) :: ToJSON a => String -> a -> Aeson.Pair +(.=) :: (ToJSON a) => String -> a -> Aeson.Pair (.=) k v = fromString k Aeson..= v -(.=?) :: ToJSON a => String -> Maybe a -> Maybe Aeson.Pair +(.=?) :: (ToJSON a) => String -> Maybe a -> Maybe Aeson.Pair (.=?) k v = (Aeson..=) (fromString k) <$> v -- | Convert JSON null to Nothing. -asOptional :: HasCallStack => MakesValue a => a -> App (Maybe Value) +asOptional :: (HasCallStack) => (MakesValue a) => a -> App (Maybe Value) asOptional x = do v <- make x pure $ case v of Null -> Nothing _ -> Just v -asString :: HasCallStack => MakesValue a => a -> App String +asString :: (HasCallStack) => (MakesValue a) => a -> App String asString x = make x >>= \case (String s) -> pure (T.unpack s) v -> assertFailureWithJSON x ("String" `typeWasExpectedButGot` v) -asText :: HasCallStack => MakesValue a => a -> App T.Text +asText :: (HasCallStack) => (MakesValue a) => a -> App T.Text asText = (fmap T.pack) . asString -asStringM :: HasCallStack => MakesValue a => a -> App (Maybe String) +asStringM :: (HasCallStack) => (MakesValue a) => a -> App (Maybe String) asStringM x = make x >>= \case (String s) -> pure (Just (T.unpack s)) @@ -103,16 +103,16 @@ asByteString x = do Left _ -> assertFailure "Could not base64 decode" Right a -> pure a -asObject :: HasCallStack => MakesValue a => a -> App Object +asObject :: (HasCallStack) => (MakesValue a) => a -> App Object asObject x = make x >>= \case (Object o) -> pure o v -> assertFailureWithJSON x ("Object" `typeWasExpectedButGot` v) -asInt :: HasCallStack => MakesValue a => a -> App Int +asInt :: (HasCallStack) => (MakesValue a) => a -> App Int asInt = asIntegral -asIntegral :: (Integral i, HasCallStack) => MakesValue a => a -> App i +asIntegral :: (Integral i, HasCallStack) => (MakesValue a) => a -> App i asIntegral x = make x >>= \case (Number n) -> @@ -121,23 +121,23 @@ asIntegral x = Right i -> pure i v -> assertFailureWithJSON x ("Number" `typeWasExpectedButGot` v) -asList :: HasCallStack => MakesValue a => a -> App [Value] +asList :: (HasCallStack) => (MakesValue a) => a -> App [Value] asList x = make x >>= \case (Array arr) -> pure (toList arr) v -> assertFailureWithJSON x ("Array" `typeWasExpectedButGot` v) -asListOf :: HasCallStack => (Value -> App b) -> MakesValue a => a -> App [b] +asListOf :: (HasCallStack) => (Value -> App b) -> (MakesValue a) => a -> App [b] asListOf makeElem x = asList x >>= mapM makeElem -asSet :: HasCallStack => MakesValue a => a -> App (Set.Set Value) +asSet :: (HasCallStack) => (MakesValue a) => a -> App (Set.Set Value) asSet = fmap Set.fromList . asList -asSetOf :: (HasCallStack, Ord b) => (Value -> App b) -> MakesValue a => a -> App (Set.Set b) +asSetOf :: (HasCallStack, Ord b) => (Value -> App b) -> (MakesValue a) => a -> App (Set.Set b) asSetOf makeElem x = Set.fromList <$> asListOf makeElem x -asBool :: HasCallStack => MakesValue a => a -> App Bool +asBool :: (HasCallStack) => (MakesValue a) => a -> App Bool asBool x = make x >>= \case (Bool b) -> pure b @@ -301,20 +301,20 @@ removeField selector x = do ob <- asObject v pure $ Object $ KM.insert (KM.fromString k) newValue ob -assertFailureWithJSON :: HasCallStack => MakesValue a => a -> String -> App b +assertFailureWithJSON :: (HasCallStack) => (MakesValue a) => a -> String -> App b assertFailureWithJSON v msg = do msg' <- ((msg <> "\n") <>) <$> prettyJSON v assertFailure msg' -- | Useful for debugging -printJSON :: MakesValue a => a -> App () +printJSON :: (MakesValue a) => a -> App () printJSON = prettyJSON >=> liftIO . putStrLn -- | useful for debugging, same as 'printJSON' but returns input JSON -traceJSON :: MakesValue a => a -> App a +traceJSON :: (MakesValue a) => a -> App a traceJSON a = printJSON a $> a -prettyJSON :: MakesValue a => a -> App String +prettyJSON :: (MakesValue a) => a -> App String prettyJSON x = make x <&> LC8.unpack . Aeson.encodePretty @@ -330,7 +330,7 @@ typeWasExpectedButGot :: String -> Value -> String typeWasExpectedButGot expectedType x = "Expected " <> expectedType <> " but got " <> jsonType x <> ":" -- Get "id" field or - if already string-like return String -objId :: HasCallStack => MakesValue a => a -> App String +objId :: (HasCallStack) => (MakesValue a) => a -> App String objId x = do v <- make x case v of @@ -339,7 +339,7 @@ objId x = do other -> assertFailureWithJSON other (typeWasExpectedButGot "Object or String" other) -- Get "qualified_id" field as (domain, id) or - if already is a qualified id object - return that -objQid :: HasCallStack => MakesValue a => a -> App (String, String) +objQid :: (HasCallStack) => (MakesValue a) => a -> App (String, String) objQid ob = do m <- firstSuccess [select ob, inField] case m of @@ -360,7 +360,7 @@ objQid ob = do Nothing -> pure Nothing Just x -> select x - firstSuccess :: Monad m => [m (Maybe a)] -> m (Maybe a) + firstSuccess :: (Monad m) => [m (Maybe a)] -> m (Maybe a) firstSuccess [] = pure Nothing firstSuccess (x : xs) = x >>= \case @@ -368,7 +368,7 @@ objQid ob = do Just y -> pure (Just y) -- | Get "qualified_id" field as {"id": _, "domain": _} object or - if already is a qualified id object - return that. -objQidObject :: HasCallStack => MakesValue a => a -> App Value +objQidObject :: (HasCallStack) => (MakesValue a) => a -> App Value objQidObject o = do (domain, id_) <- objQid o pure $ object ["domain" .= domain, "id" .= id_] diff --git a/integration/test/Testlib/Mock.hs b/integration/test/Testlib/Mock.hs index 9e957ccd702..6fd346c50cb 100644 --- a/integration/test/Testlib/Mock.hs +++ b/integration/test/Testlib/Mock.hs @@ -47,8 +47,8 @@ startMockServer config app = do let closeSocket sock = catch (Socket.close sock) (\(_ :: SomeException) -> pure ()) (port, sock) <- Codensity $ \k -> do action <- appToIOKleisli k - liftIO $ - bracket + liftIO + $ bracket ( case config.port of Nothing -> bindRandomPortTCP (fromString "*6") Just n -> (n,) <$> bindPortTCP n (fromString "*6") diff --git a/integration/test/Testlib/MockIntegrationService.hs b/integration/test/Testlib/MockIntegrationService.hs index 36ab35612dd..95dccb2fff7 100644 --- a/integration/test/Testlib/MockIntegrationService.hs +++ b/integration/test/Testlib/MockIntegrationService.hs @@ -32,7 +32,7 @@ import UnliftIO.Timeout (timeout) withFreePortAnyAddr :: (MonadMask m, MonadIO m) => ((Warp.Port, Socket) -> m a) -> m a withFreePortAnyAddr = bracket openFreePortAnyAddr (liftIO . Socket.close . snd) -openFreePortAnyAddr :: MonadIO m => m (Warp.Port, Socket) +openFreePortAnyAddr :: (MonadIO m) => m (Warp.Port, Socket) openFreePortAnyAddr = liftIO $ bindRandomPortTCP (fromString "*6") type LiftedApplication = Request -> (Wai.Response -> App ResponseReceived) -> App ResponseReceived @@ -119,10 +119,12 @@ lhMockAppWithPrekeys mks ch req cont = withRunInIO \inIO -> do where initiateResp :: Value -> [Value] -> Wai.Response initiateResp npk pks = - responseLBS status200 [(hContentType, cs "application/json")] . encode . Data.Aeson.object $ - [ "prekeys" .= pks, - "last_prekey" .= npk - ] + responseLBS status200 [(hContentType, cs "application/json")] + . encode + . Data.Aeson.object + $ [ "prekeys" .= pks, + "last_prekey" .= npk + ] respondOk :: Wai.Response respondOk = responseLBS status200 mempty mempty diff --git a/integration/test/Testlib/ModService.hs b/integration/test/Testlib/ModService.hs index f4390d7286f..061acca529e 100644 --- a/integration/test/Testlib/ModService.hs +++ b/integration/test/Testlib/ModService.hs @@ -46,7 +46,7 @@ import Testlib.Types import Text.RawString.QQ import Prelude -withModifiedBackend :: HasCallStack => ServiceOverrides -> (HasCallStack => String -> App a) -> App a +withModifiedBackend :: (HasCallStack) => ServiceOverrides -> ((HasCallStack) => String -> App a) -> App a withModifiedBackend overrides k = startDynamicBackends [overrides] (\domains -> k (head domains)) @@ -64,8 +64,8 @@ copyDirectoryRecursively from to = do -- | Concurrent traverse in the 'Codensity App' monad. traverseConcurrentlyCodensity :: - (HasCallStack => a -> Codensity App ()) -> - (HasCallStack => [a] -> Codensity App ()) + ((HasCallStack) => a -> Codensity App ()) -> + ((HasCallStack) => [a] -> Codensity App ()) traverseConcurrentlyCodensity f args = do -- Create variables for synchronisation of the various threads: -- * @result@ is used to store a possible exception @@ -242,7 +242,7 @@ updateServiceMapInConfig resource forSrv config = [(srv, berInternalServicePorts resource srv :: Int) | srv <- allServices] startBackend :: - HasCallStack => + (HasCallStack) => BackendResource -> ServiceOverrides -> Codensity App () @@ -382,7 +382,7 @@ logToConsole colorize prefix hdl = do `E.catch` (\(_ :: E.IOException) -> pure ()) go -retryRequestUntil :: HasCallStack => App Bool -> String -> App () +retryRequestUntil :: (HasCallStack) => App Bool -> String -> App () retryRequestUntil reqAction err = do isUp <- retrying diff --git a/integration/test/Testlib/One2One.hs b/integration/test/Testlib/One2One.hs index 0ef4ab6ff56..41cacb4949c 100644 --- a/integration/test/Testlib/One2One.hs +++ b/integration/test/Testlib/One2One.hs @@ -43,10 +43,10 @@ generateRemoteAndConvIdWithDomain remoteDomain shouldBeLocal lUserId = do isLocal = localDomain == cDomain if shouldBeLocal == isLocal then - pure $ - ( object ["id" .= (otherUsr), "domain" .= otherDomain], - object ["id" .= (UUID.toString cId), "domain" .= cDomain] - ) + pure + $ ( object ["id" .= (otherUsr), "domain" .= otherDomain], + object ["id" .= (UUID.toString cId), "domain" .= cDomain] + ) else generateRemoteAndConvIdWithDomain remoteDomain shouldBeLocal lUserId one2OneConvId :: (UUID, String) -> (UUID, String) -> (UUID, String) @@ -86,8 +86,8 @@ newtype UuidV5 = UuidV5 {toUuidV5 :: UUID} deriving (Eq, Ord, Show) mkV5 :: UUID -> UuidV5 -mkV5 u = UuidV5 $ - case toWords u of +mkV5 u = UuidV5 + $ case toWords u of (x0, x1, x2, x3) -> fromWords x0 diff --git a/integration/test/Testlib/Ports.hs b/integration/test/Testlib/Ports.hs index 4ca16d06910..29367b64dd8 100644 --- a/integration/test/Testlib/Ports.hs +++ b/integration/test/Testlib/Ports.hs @@ -9,7 +9,7 @@ data PortNamespace | FederatorExternal | ServiceInternal Service -port :: Num a => PortNamespace -> BackendName -> a +port :: (Num a) => PortNamespace -> BackendName -> a port NginzSSL bn = mkPort 8443 bn port NginzHttp2 bn = mkPort 8099 bn port FederatorExternal bn = mkPort 8098 bn @@ -24,10 +24,10 @@ port (ServiceInternal Nginz) bn = mkPort 8080 bn port (ServiceInternal Spar) bn = mkPort 8088 bn port (ServiceInternal Stern) bn = mkPort 8091 bn -portForDyn :: Num a => PortNamespace -> Int -> a +portForDyn :: (Num a) => PortNamespace -> Int -> a portForDyn ns i = port ns (DynamicBackend i) -mkPort :: Num a => Int -> BackendName -> a +mkPort :: (Num a) => Int -> BackendName -> a mkPort basePort bn = let i = case bn of BackendA -> 0 @@ -35,5 +35,5 @@ mkPort basePort bn = (DynamicBackend k) -> 1 + k in fromIntegral basePort + (fromIntegral i) * 1000 -internalServicePorts :: Num a => BackendName -> Service -> a +internalServicePorts :: (Num a) => BackendName -> Service -> a internalServicePorts backend service = port (ServiceInternal service) backend diff --git a/integration/test/Testlib/Prelude.hs b/integration/test/Testlib/Prelude.hs index 4f29605a227..69c3797f54d 100644 --- a/integration/test/Testlib/Prelude.hs +++ b/integration/test/Testlib/Prelude.hs @@ -174,37 +174,37 @@ import qualified Prelude as P ---------------------------------------------------------------------------- -- Lifted functions from Prelude -putChar :: MonadIO m => Char -> m () +putChar :: (MonadIO m) => Char -> m () putChar = liftIO . P.putChar -putStr :: MonadIO m => String -> m () +putStr :: (MonadIO m) => String -> m () putStr = liftIO . P.putStr -putStrLn :: MonadIO m => String -> m () +putStrLn :: (MonadIO m) => String -> m () putStrLn = liftIO . P.putStrLn print :: (Show a, MonadIO m) => a -> m () print = liftIO . P.print -getChar :: MonadIO m => m Char +getChar :: (MonadIO m) => m Char getChar = liftIO P.getChar -getLine :: MonadIO m => m String +getLine :: (MonadIO m) => m String getLine = liftIO P.getLine -getContents :: MonadIO m => m String +getContents :: (MonadIO m) => m String getContents = liftIO P.getContents -interact :: MonadIO m => (String -> String) -> m () +interact :: (MonadIO m) => (String -> String) -> m () interact = liftIO . P.interact -readFile :: MonadIO m => FilePath -> m String +readFile :: (MonadIO m) => FilePath -> m String readFile = liftIO . P.readFile -writeFile :: MonadIO m => FilePath -> String -> m () +writeFile :: (MonadIO m) => FilePath -> String -> m () writeFile = fmap liftIO . P.writeFile -appendFile :: MonadIO m => FilePath -> String -> m () +appendFile :: (MonadIO m) => FilePath -> String -> m () appendFile = fmap liftIO . P.appendFile readIO :: (Read a, MonadIO m) => String -> m a diff --git a/integration/test/Testlib/RunServices.hs b/integration/test/Testlib/RunServices.hs index aca7867aff3..e5c5c7611ce 100644 --- a/integration/test/Testlib/RunServices.hs +++ b/integration/test/Testlib/RunServices.hs @@ -53,8 +53,9 @@ main = do exitWith =<< waitForProcess ph runCodensity (createGlobalEnv cfg >>= mkEnv) $ \env -> - runAppWithEnv env $ - lowerCodensity $ do + runAppWithEnv env + $ lowerCodensity + $ do _modifyEnv <- traverseConcurrentlyCodensity (\r -> startDynamicBackend r mempty) diff --git a/integration/test/Testlib/Types.hs b/integration/test/Testlib/Types.hs index ae166c33b4c..e77e8b0a457 100644 --- a/integration/test/Testlib/Types.hs +++ b/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 diff --git a/libs/bilge/src/Bilge/Assert.hs b/libs/bilge/src/Bilge/Assert.hs index 622c945887c..5f44fd9d68b 100644 --- a/libs/bilge/src/Bilge/Assert.hs +++ b/libs/bilge/src/Bilge/Assert.hs @@ -57,10 +57,10 @@ instance Contains ByteString where instance Contains Lazy.ByteString where contains a b = contains (Lazy.toStrict a) (Lazy.toStrict b) -instance Eq a => Contains [a] where +instance (Eq a) => Contains [a] where contains = isInfixOf -instance Contains a => Contains (Maybe a) where +instance (Contains a) => Contains (Maybe a) where contains (Just a) (Just b) = contains a b contains Nothing _ = True contains _ Nothing = False @@ -145,25 +145,25 @@ f =~= g = Assertions $ tell [\r -> test " not in " contains (f r) (g r)] -- | Most generic assertion on a request. If the test function evaluates to -- @(Just msg)@ then the assertion fails with the error message @msg@. -assertResponse :: HasCallStack => (Response (Maybe Lazy.ByteString) -> Maybe String) -> Assertions () +assertResponse :: (HasCallStack) => (Response (Maybe Lazy.ByteString) -> Maybe String) -> Assertions () assertResponse f = Assertions $ tell [f] -- | Generic assertion on a request. The 'String' argument will be printed -- in case the assertion fails. -assertTrue :: HasCallStack => String -> (Response (Maybe Lazy.ByteString) -> Bool) -> Assertions () +assertTrue :: (HasCallStack) => String -> (Response (Maybe Lazy.ByteString) -> Bool) -> Assertions () assertTrue e f = Assertions $ tell [\r -> if f r then Nothing else Just e] -- | Generic assertion on a request. -assertTrue_ :: HasCallStack => (Response (Maybe Lazy.ByteString) -> Bool) -> Assertions () +assertTrue_ :: (HasCallStack) => (Response (Maybe Lazy.ByteString) -> Bool) -> Assertions () assertTrue_ = assertTrue "false" -- | Generic assertion inside the 'Assertions' monad. The 'String' argument -- will be printed in case the assertion fails. -assert :: HasCallStack => String -> Bool -> Assertions () +assert :: (HasCallStack) => String -> Bool -> Assertions () assert m = assertTrue m . const -- | Generic assertion inside the 'Assertions' monad. -assert_ :: HasCallStack => Bool -> Assertions () +assert_ :: (HasCallStack) => Bool -> Assertions () assert_ = assertTrue_ . const -- Internal diff --git a/libs/bilge/src/Bilge/IO.hs b/libs/bilge/src/Bilge/IO.hs index f1fa331ea05..e7abfd750aa 100644 --- a/libs/bilge/src/Bilge/IO.hs +++ b/libs/bilge/src/Bilge/IO.hs @@ -113,10 +113,10 @@ class MonadHttp m where handleRequestWithCont :: Request -> (Response BodyReader -> IO a) -> m a {-# MINIMAL handleRequestWithCont #-} -handleRequest :: MonadHttp m => Request -> m (Response (Maybe LByteString)) +handleRequest :: (MonadHttp m) => Request -> m (Response (Maybe LByteString)) handleRequest req = handleRequestWithCont req consumeBody -instance MonadIO m => MonadHttp (HttpT m) where +instance (MonadIO m) => MonadHttp (HttpT m) where handleRequestWithCont :: Request -> (Response BodyReader -> IO a) -> HttpT m a handleRequestWithCont req h = do m <- ask @@ -138,7 +138,7 @@ trivialBodyReader bodyBytes = do instance MonadHttp WaiTest.Session where handleRequestWithCont req cont = unSessionT $ handleRequestWithCont req cont -instance MonadIO m => MonadHttp (SessionT m) where +instance (MonadIO m) => MonadHttp (SessionT m) where handleRequestWithCont req cont = do reqBody <- liftIO $ getHttpClientRequestBody (Client.requestBody req) -- `srequest` sets the requestBody for us @@ -180,7 +180,7 @@ instance MonadIO m => MonadHttp (SessionT m) where -- | Does not support all constructors, but so far we only use 'RequestBodyLBS'. -- The other ones are slightly less straight-forward, so we can implement them later if needed. -getHttpClientRequestBody :: HasCallStack => Client.RequestBody -> IO LByteString +getHttpClientRequestBody :: (HasCallStack) => Client.RequestBody -> IO LByteString getHttpClientRequestBody = \case Client.RequestBodyLBS lbs -> pure lbs Client.RequestBodyBS bs -> pure (LBS.fromStrict bs) @@ -207,7 +207,7 @@ instance MonadBaseControl IO (HttpT IO) where liftBaseWith = defaultLiftBaseWith restoreM = defaultRestoreM -instance MonadUnliftIO m => MonadUnliftIO (HttpT m) where +instance (MonadUnliftIO m) => MonadUnliftIO (HttpT m) where withRunInIO inner = HttpT . ReaderT $ \r -> withRunInIO $ \run -> @@ -227,7 +227,7 @@ get, options, trace, patch :: - MonadHttp m => + (MonadHttp m) => (Request -> Request) -> m (Response (Maybe LByteString)) get f = httpLbs empty (method GET . f) @@ -247,7 +247,7 @@ get', options', trace', patch' :: - MonadHttp m => + (MonadHttp m) => Request -> (Request -> Request) -> m (Response (Maybe LByteString)) @@ -261,14 +261,14 @@ trace' r f = httpLbs r (method TRACE . f) patch' r f = httpLbs r (method PATCH . f) httpLbs :: - MonadHttp m => + (MonadHttp m) => Request -> (Request -> Request) -> m (Response (Maybe LByteString)) httpLbs r f = http r f consumeBody http :: - MonadHttp m => + (MonadHttp m) => Request -> (Request -> Request) -> (Response BodyReader -> IO a) -> diff --git a/libs/bilge/src/Bilge/RPC.hs b/libs/bilge/src/Bilge/RPC.hs index 386ba6b0279..77edab5326f 100644 --- a/libs/bilge/src/Bilge/RPC.hs +++ b/libs/bilge/src/Bilge/RPC.hs @@ -45,7 +45,7 @@ import System.Logger.Class class HasRequestId m where getRequestId :: m RequestId -instance Monad m => HasRequestId (ReaderT RequestId m) where +instance (Monad m) => HasRequestId (ReaderT RequestId m) where getRequestId = ask data RPCException = RPCException diff --git a/libs/bilge/src/Bilge/Request.hs b/libs/bilge/src/Bilge/Request.hs index 1acd96aa03e..ed4facd59ca 100644 --- a/libs/bilge/src/Bilge/Request.hs +++ b/libs/bilge/src/Bilge/Request.hs @@ -199,7 +199,7 @@ lbytes = body . RequestBodyLBS -- bytestring produced by JSON will get computed and stored as it is in memory -- in order to compute the @Content-Length@ header. For making a request with -- big JSON objects, please use @lbytesRefChunked@ -json :: ToJSON a => a -> Request -> Request +json :: (ToJSON a) => a -> Request -> Request json a = contentJson . lbytes (encode a) -- | Like @lbytesChunkedIO@ but for sending a JSON body @@ -227,7 +227,7 @@ jsonChunkedIO a = do -- This is because the closure for @lbytesPopper@ keeps the reference to @bs@ -- alive. To avoid this, this function allocates an @IORef@ and passes that to -- @lbytesRefChunked@. -lbytesChunkedIO :: MonadIO m => Lazy.ByteString -> m (Request -> Request) +lbytesChunkedIO :: (MonadIO m) => Lazy.ByteString -> m (Request -> Request) lbytesChunkedIO bs = do chunksRef <- newIORef $ Lazy.toChunks bs pure $ lbytesRefChunked chunksRef diff --git a/libs/bilge/src/Bilge/Response.hs b/libs/bilge/src/Bilge/Response.hs index a4e422094ae..c199dba9f64 100644 --- a/libs/bilge/src/Bilge/Response.hs +++ b/libs/bilge/src/Bilge/Response.hs @@ -147,7 +147,7 @@ responseJsonUnsafeWithMsg userErr = either err id . responseJsonEither <> [userErr | not $ null userErr] <> [parserErr] -showResponse :: Show a => Response a -> String +showResponse :: (Show a) => Response a -> String showResponse r = showString "HTTP/" . shows (httpMajor . responseVersion $ r) diff --git a/libs/bilge/src/Bilge/Retry.hs b/libs/bilge/src/Bilge/Retry.hs index 01f2dc7ab01..055a1ff5219 100644 --- a/libs/bilge/src/Bilge/Retry.hs +++ b/libs/bilge/src/Bilge/Retry.hs @@ -25,10 +25,10 @@ import Imports import Network.HTTP.Client (HttpException (..), HttpExceptionContent (..), responseStatus) import Network.HTTP.Types -httpHandlers :: Monad m => [a -> Handler m Bool] +httpHandlers :: (Monad m) => [a -> Handler m Bool] httpHandlers = [const . Handler $ pure . canRetry] -rpcHandlers :: Monad m => [a -> Handler m Bool] +rpcHandlers :: (Monad m) => [a -> Handler m Bool] rpcHandlers = [ const . Handler $ \(RPCException _ _ cause) -> pure $ maybe False canRetry (fromException cause) diff --git a/libs/bilge/src/Bilge/TestSession.hs b/libs/bilge/src/Bilge/TestSession.hs index b9c8223986e..246b7a17bcb 100644 --- a/libs/bilge/src/Bilge/TestSession.hs +++ b/libs/bilge/src/Bilge/TestSession.hs @@ -33,7 +33,7 @@ newtype SessionT m a = SessionT {unSessionT :: ReaderT Wai.Application (StateT W instance MonadTrans SessionT where lift = SessionT . lift . lift -liftSession :: MonadIO m => WaiTest.Session a -> SessionT m a +liftSession :: (MonadIO m) => WaiTest.Session a -> SessionT m a liftSession session = SessionT $ do app <- ask clientState <- lift ST.get @@ -41,5 +41,5 @@ liftSession session = SessionT $ do let resultInIO = ST.evalStateT resultInState clientState liftIO resultInIO -runSessionT :: Monad m => SessionT m a -> Wai.Application -> m a +runSessionT :: (Monad m) => SessionT m a -> Wai.Application -> m a runSessionT session app = ST.evalStateT (runReaderT (unSessionT session) app) WaiTest.initState diff --git a/libs/brig-types/src/Brig/Types/Instances.hs b/libs/brig-types/src/Brig/Types/Instances.hs index 347be2c0192..ca5fb8f6aa0 100644 --- a/libs/brig-types/src/Brig/Types/Instances.hs +++ b/libs/brig-types/src/Brig/Types/Instances.hs @@ -74,7 +74,7 @@ instance Cql ServiceKey where 0 -> pure $! ServiceKey RsaServiceKey s p _ -> Left $ "Unexpected service key type: " ++ show t where - required :: Cql r => Text -> Either String r + required :: (Cql r) => Text -> Either String r required f = maybe (Left ("ServiceKey: Missing required field '" ++ show f ++ "'")) diff --git a/libs/brig-types/src/Brig/Types/Search.hs b/libs/brig-types/src/Brig/Types/Search.hs index 2bf55eb1ea8..2a5006968f6 100644 --- a/libs/brig-types/src/Brig/Types/Search.hs +++ b/libs/brig-types/src/Brig/Types/Search.hs @@ -75,8 +75,10 @@ instance ToByteString SearchVisibilityInbound where instance FromByteString SearchVisibilityInbound where parser = - SearchableByOwnTeam <$ string "searchable-by-own-team" - <|> SearchableByAllTeams <$ string "searchable-by-all-teams" + SearchableByOwnTeam + <$ string "searchable-by-own-team" + <|> SearchableByAllTeams + <$ string "searchable-by-all-teams" instance C.Cql SearchVisibilityInbound where ctype = C.Tagged C.IntColumn diff --git a/libs/brig-types/src/Brig/Types/User/Auth.hs b/libs/brig-types/src/Brig/Types/User/Auth.hs index d6426a1483d..378f49f53bd 100644 --- a/libs/brig-types/src/Brig/Types/User/Auth.hs +++ b/libs/brig-types/src/Brig/Types/User/Auth.hs @@ -51,11 +51,11 @@ instance FromJSON LegalHoldLogin where parseJSON = withObject "LegalHoldLogin" $ \o -> LegalHoldLogin <$> o - .: "user" + .: "user" <*> o - .:? "password" + .:? "password" <*> o - .:? "label" + .:? "label" instance ToJSON LegalHoldLogin where toJSON (LegalHoldLogin uid password label) = diff --git a/libs/cassandra-util/src/Cassandra/Settings.hs b/libs/cassandra-util/src/Cassandra/Settings.hs index f4b4818dd5a..548019a27da 100644 --- a/libs/cassandra-util/src/Cassandra/Settings.hs +++ b/libs/cassandra-util/src/Cassandra/Settings.hs @@ -43,7 +43,7 @@ import System.Logger qualified as Log -- Given a server name and a url returning a wire-custom "disco" json (AWS describe-instances-like json), e.g. -- { "roles" : { "server_name": [ {"privateIpAddress": "...", ...}, {...} ] } }, -- return a list of IP addresses. -initialContactsDisco :: MonadIO m => String -> String -> m (NonEmpty String) +initialContactsDisco :: (MonadIO m) => String -> String -> m (NonEmpty String) initialContactsDisco (pack -> srv) url = liftIO $ do rs <- asValue =<< get url let srvs = map Key.fromText $ @@ -65,7 +65,7 @@ initialContactsDisco (pack -> srv) url = liftIO $ do _ -> error "initial-contacts: no IP addresses found." -- | Puts the address into a list using the same signature as the other initialContacts -initialContactsPlain :: MonadIO m => Text -> m (NonEmpty String) +initialContactsPlain :: (MonadIO m) => Text -> m (NonEmpty String) initialContactsPlain address = pure $ unpack address :| [] -- | Use dcAwareRandomPolicy if config option filterNodesByDatacentre is set, diff --git a/libs/deriving-swagger2/src/Deriving/Swagger.hs b/libs/deriving-swagger2/src/Deriving/Swagger.hs index 95a0c121a3e..508947a33b5 100644 --- a/libs/deriving-swagger2/src/Deriving/Swagger.hs +++ b/libs/deriving-swagger2/src/Deriving/Swagger.hs @@ -131,13 +131,13 @@ instance (StringModifier a, StringModifier b, StringModifier c, StringModifier d -- | Strips the given prefix, has no effect if the prefix doesn't exist data StripPrefix t -instance KnownSymbol prefix => StringModifier (StripPrefix prefix) where +instance (KnownSymbol prefix) => StringModifier (StripPrefix prefix) where getStringModifier = fromMaybe <*> stripPrefix (symbolVal (Proxy @prefix)) -- | Strips the given suffix, has no effect if the suffix doesn't exist data StripSuffix t -instance KnownSymbol suffix => StringModifier (StripSuffix suffix) where +instance (KnownSymbol suffix) => StringModifier (StripSuffix suffix) where getStringModifier = fromMaybe <*> stripSuffix (symbolVal (Proxy @suffix)) data CamelTo (separator :: Symbol) diff --git a/libs/dns-util/src/Wire/Network/DNS/Effect.hs b/libs/dns-util/src/Wire/Network/DNS/Effect.hs index fa82130f4eb..9910c28ba42 100644 --- a/libs/dns-util/src/Wire/Network/DNS/Effect.hs +++ b/libs/dns-util/src/Wire/Network/DNS/Effect.hs @@ -32,13 +32,13 @@ data DNSLookup m a where makeSem ''DNSLookup -runDNSLookupDefault :: Member (Embed IO) r => Sem (DNSLookup ': r) a -> Sem r a +runDNSLookupDefault :: (Member (Embed IO) r) => Sem (DNSLookup ': r) a -> Sem r a runDNSLookupDefault = interpret $ \action -> embed $ do rs <- DNS.makeResolvSeed DNS.defaultResolvConf DNS.withResolver rs $ flip runLookupIO action -runDNSLookupWithResolver :: Member (Embed IO) r => Resolver -> Sem (DNSLookup ': r) a -> Sem r a +runDNSLookupWithResolver :: (Member (Embed IO) r) => Resolver -> Sem (DNSLookup ': r) a -> Sem r a runDNSLookupWithResolver resolver = interpret $ embed . runLookupIO resolver runLookupIO :: Resolver -> DNSLookup m a -> IO a diff --git a/libs/extended/src/Options/Applicative/Extended.hs b/libs/extended/src/Options/Applicative/Extended.hs index 588fa9668b0..3a44fecb188 100644 --- a/libs/extended/src/Options/Applicative/Extended.hs +++ b/libs/extended/src/Options/Applicative/Extended.hs @@ -32,7 +32,7 @@ import Options.Applicative -- | A reader that accepts either @N@ or @N..M@ (not necessarily just -- numbers). -autoRange :: Read a => ReadM (a, a) +autoRange :: (Read a) => ReadM (a, a) autoRange = eitherReader $ \arg -> case stripInfix ".." arg of Nothing -> (\a -> (a, a)) <$> readEither arg Just (l, r) -> case (readEither l, readEither r) of diff --git a/libs/extended/src/Servant/API/Extended.hs b/libs/extended/src/Servant/API/Extended.hs index a531f141bd7..959249ac48b 100644 --- a/libs/extended/src/Servant/API/Extended.hs +++ b/libs/extended/src/Servant/API/Extended.hs @@ -109,10 +109,10 @@ instance Right v -> pure v instance - HasOpenApi (ReqBody' '[Required, Strict] cts a :> api) => + (HasOpenApi (ReqBody' '[Required, Strict] cts a :> api)) => HasOpenApi (ReqBodyCustomError cts tag a :> api) where toOpenApi Proxy = toOpenApi (Proxy @(ReqBody' '[Required, Strict] cts a :> api)) -instance RoutesToPaths rest => RoutesToPaths (ReqBodyCustomError' mods list tag a :> rest) where +instance (RoutesToPaths rest) => RoutesToPaths (ReqBodyCustomError' mods list tag a :> rest) where getRoutes = getRoutes @rest diff --git a/libs/extended/src/Servant/API/Extended/Endpath.hs b/libs/extended/src/Servant/API/Extended/Endpath.hs index 773230e8509..6e5d5dc40ef 100644 --- a/libs/extended/src/Servant/API/Extended/Endpath.hs +++ b/libs/extended/src/Servant/API/Extended/Endpath.hs @@ -22,5 +22,5 @@ instance (HasServer api context, HasContextEntry (context .++ DefaultErrorFormat hoistServerWithContext _ proxyCtx f s = hoistServerWithContext (Proxy @api) proxyCtx f s -- Endpath :> route -instance RoutesToPaths route => RoutesToPaths (Endpath :> route) where +instance (RoutesToPaths route) => RoutesToPaths (Endpath :> route) where getRoutes = getRoutes @route diff --git a/libs/galley-types/src/Galley/Types/Conversations/One2One.hs b/libs/galley-types/src/Galley/Types/Conversations/One2One.hs index 2101a27a600..4bd74342316 100644 --- a/libs/galley-types/src/Galley/Types/Conversations/One2One.hs +++ b/libs/galley-types/src/Galley/Types/Conversations/One2One.hs @@ -44,7 +44,7 @@ namespace :: BaseProtocolTag -> UUID namespace BaseProtocolProteusTag = UUID.fromWords 0x9a51edb8 0x060c0d9a 0x0c2950a8 0x5d152982 namespace BaseProtocolMLSTag = UUID.fromWords 0x95589dd5 0xb04540dc 0xa6aadd9c 0x4fad1c2f -compareDomains :: Ord a => Qualified a -> Qualified a -> Ordering +compareDomains :: (Ord a) => Qualified a -> Qualified a -> Ordering compareDomains (Qualified a1 dom1) (Qualified a2 dom2) = compare (dom1, a1) (dom2, a2) diff --git a/libs/galley-types/src/Galley/Types/Teams.hs b/libs/galley-types/src/Galley/Types/Teams.hs index 715377e42bb..75d70c0fb14 100644 --- a/libs/galley-types/src/Galley/Types/Teams.hs +++ b/libs/galley-types/src/Galley/Types/Teams.hs @@ -104,11 +104,11 @@ newtype Defaults a = Defaults {_unDefaults :: a} deriving (Eq, Ord, Show, Enum, Bounded, Generic, Functor) deriving newtype (Arbitrary) -instance FromJSON a => FromJSON (Defaults a) where +instance (FromJSON a) => FromJSON (Defaults a) where parseJSON = withObject "default object" $ \ob -> Defaults <$> (ob .: "defaults") -instance ToJSON a => ToJSON (Defaults a) where +instance (ToJSON a) => ToJSON (Defaults a) where toJSON (Defaults x) = object ["defaults" .= toJSON x] @@ -236,10 +236,10 @@ notTeamMember uids tmms = Set.toList $ Set.fromList uids `Set.difference` Set.fromList (map (view userId) tmms) -isTeamMember :: Foldable m => UserId -> m TeamMember -> Bool +isTeamMember :: (Foldable m) => UserId -> m TeamMember -> Bool isTeamMember u = isJust . findTeamMember u -findTeamMember :: Foldable m => UserId -> m TeamMember -> Maybe TeamMember +findTeamMember :: (Foldable m) => UserId -> m TeamMember -> Maybe TeamMember findTeamMember u = find ((u ==) . view userId) isTeamOwner :: TeamMemberOptPerms -> Bool diff --git a/libs/gundeck-types/src/Gundeck/Types/Common.hs b/libs/gundeck-types/src/Gundeck/Types/Common.hs index 388ac6b82ae..1158830d1c8 100644 --- a/libs/gundeck-types/src/Gundeck/Types/Common.hs +++ b/libs/gundeck-types/src/Gundeck/Types/Common.hs @@ -57,5 +57,5 @@ instance ToByteString URI where instance FromByteString URI where parser = takeByteString >>= parse . Bytes.unpack -parse :: MonadFail m => String -> m URI +parse :: (MonadFail m) => String -> m URI parse = maybe (fail "Invalid URI") (pure . URI) . Net.parseURI diff --git a/libs/gundeck-types/src/Gundeck/Types/Push/V2.hs b/libs/gundeck-types/src/Gundeck/Types/Push/V2.hs index b8794553a45..6c0df12d8a5 100644 --- a/libs/gundeck-types/src/Gundeck/Types/Push/V2.hs +++ b/libs/gundeck-types/src/Gundeck/Types/Push/V2.hs @@ -147,9 +147,12 @@ instance FromJSON Recipient where instance ToJSON Recipient where toJSON (Recipient u r c) = object $ - "user_id" .= u - # "route" .= r - # "clients" .= c + "user_id" + .= u + # "route" + .= r + # "clients" + .= c # [] -- "All clients" is encoded in the API as an empty list. @@ -191,10 +194,14 @@ apsData lk la = ApsData lk la Nothing True instance ToJSON ApsData where toJSON (ApsData k a s b) = object $ - "loc_key" .= k - # "loc_args" .= a - # "sound" .= s - # "badge" .= b + "loc_key" + .= k + # "loc_args" + .= a + # "sound" + .= s + # "badge" + .= b # [] instance FromJSON ApsData where @@ -269,7 +276,7 @@ newPush from to pload = singletonRecipient :: Recipient -> Range 1 1024 (Set Recipient) singletonRecipient = Range.unsafeRange . Set.singleton -singletonPayload :: ToJSONObject a => a -> List1 Object +singletonPayload :: (ToJSONObject a) => a -> List1 Object singletonPayload = List1.singleton . toJSONObject instance FromJSON Push where @@ -289,16 +296,26 @@ instance FromJSON Push where instance ToJSON Push where toJSON p = object $ - "recipients" .= _pushRecipients p - # "origin" .= _pushOrigin p - # "connections" .= ifNot Set.null (_pushConnections p) - # "origin_connection" .= _pushOriginConnection p - # "transient" .= ifNot not (_pushTransient p) - # "native_include_origin" .= ifNot id (_pushNativeIncludeOrigin p) - # "native_encrypt" .= ifNot id (_pushNativeEncrypt p) - # "native_aps" .= _pushNativeAps p - # "native_priority" .= ifNot (== HighPriority) (_pushNativePriority p) - # "payload" .= _pushPayload p + "recipients" + .= _pushRecipients p + # "origin" + .= _pushOrigin p + # "connections" + .= ifNot Set.null (_pushConnections p) + # "origin_connection" + .= _pushOriginConnection p + # "transient" + .= ifNot not (_pushTransient p) + # "native_include_origin" + .= ifNot id (_pushNativeIncludeOrigin p) + # "native_encrypt" + .= ifNot id (_pushNativeEncrypt p) + # "native_aps" + .= _pushNativeAps p + # "native_priority" + .= ifNot (== HighPriority) (_pushNativePriority p) + # "payload" + .= _pushPayload p # [] where ifNot f a = if f a then Nothing else Just a diff --git a/libs/hscim/hscim.cabal b/libs/hscim/hscim.cabal index a2a5a9c19b4..46e6f535ac1 100644 --- a/libs/hscim/hscim.cabal +++ b/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 diff --git a/libs/hscim/server/Main.hs b/libs/hscim/server/Main.hs index adcd58a2b86..cfb31664ce0 100644 --- a/libs/hscim/server/Main.hs +++ b/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 diff --git a/libs/hscim/src/Web/Scim/Capabilities/MetaSchema.hs b/libs/hscim/src/Web/Scim/Capabilities/MetaSchema.hs index 77f876ef2ed..4bdaf265af3 100644 --- a/libs/hscim/src/Web/Scim/Capabilities/MetaSchema.hs +++ b/libs/hscim/src/Web/Scim/Capabilities/MetaSchema.hs @@ -54,7 +54,7 @@ data Supported a = Supported } deriving (Show, Eq, Generic) -instance ToJSON a => ToJSON (Supported a) where +instance (ToJSON a) => ToJSON (Supported a) where toJSON (Supported (ScimBool b) v) = case toJSON v of (Object o) -> Object $ KeyMap.insert "supported" (Bool b) o _ -> Object $ KeyMap.fromList [("supported", Bool b)] @@ -134,7 +134,7 @@ empty = } configServer :: - Monad m => + (Monad m) => Configuration -> ConfigSite (AsServerT (ScimHandler m)) configServer config = diff --git a/libs/hscim/src/Web/Scim/Class/Group.hs b/libs/hscim/src/Web/Scim/Class/Group.hs index 2b3f49734e1..83a3c3ac44b 100644 --- a/libs/hscim/src/Web/Scim/Class/Group.hs +++ b/libs/hscim/src/Web/Scim/Class/Group.hs @@ -171,7 +171,7 @@ class (Monad m, GroupTypes tag, AuthDB tag m) => GroupDB tag m where groupServer :: forall tag m. - GroupDB tag m => + (GroupDB tag m) => Maybe (AuthData tag) -> GroupSite tag (AsServerT (ScimHandler m)) groupServer authData = diff --git a/libs/hscim/src/Web/Scim/Client.hs b/libs/hscim/src/Web/Scim/Client.hs index fee613ac875..c80070fb038 100644 --- a/libs/hscim/src/Web/Scim/Client.hs +++ b/libs/hscim/src/Web/Scim/Client.hs @@ -74,28 +74,28 @@ type HasScimClient tag = ToHttpApiData (GroupId tag) ) -scimClients :: HasScimClient tag => ClientEnv -> Site tag (AsClientT IO) +scimClients :: (HasScimClient tag) => ClientEnv -> Site tag (AsClientT IO) scimClients env = genericClientHoist $ \x -> runClientM x env >>= either throwIO pure -- config spConfig :: forall tag. - HasScimClient tag => + (HasScimClient tag) => ClientEnv -> IO MetaSchema.Configuration spConfig env = case config @tag (scimClients env) of ((r :<|> _) :<|> (_ :<|> _)) -> r getSchemas :: forall tag. - HasScimClient tag => + (HasScimClient tag) => ClientEnv -> IO (ListResponse Value) getSchemas env = case config @tag (scimClients env) of ((_ :<|> r) :<|> (_ :<|> _)) -> r schema :: forall tag. - HasScimClient tag => + (HasScimClient tag) => ClientEnv -> Text -> IO Value @@ -103,7 +103,7 @@ schema env = case config @tag (scimClients env) of ((_ :<|> _) :<|> (r :<|> _)) resourceTypes :: forall tag. - HasScimClient tag => + (HasScimClient tag) => ClientEnv -> IO (ListResponse ResourceType.Resource) resourceTypes env = case config @tag (scimClients env) of ((_ :<|> _) :<|> (_ :<|> r)) -> r @@ -111,7 +111,7 @@ resourceTypes env = case config @tag (scimClients env) of ((_ :<|> _) :<|> (_ :< -- users getUsers :: - HasScimClient tag => + (HasScimClient tag) => ClientEnv -> Maybe (AuthData tag) -> Maybe Filter -> @@ -119,7 +119,7 @@ getUsers :: getUsers env tok = case users (scimClients env) tok of ((r :<|> (_ :<|> _)) :<|> (_ :<|> (_ :<|> _))) -> r getUser :: - HasScimClient tag => + (HasScimClient tag) => ClientEnv -> Maybe (AuthData tag) -> UserId tag -> @@ -127,7 +127,7 @@ getUser :: getUser env tok = case users (scimClients env) tok of ((_ :<|> (r :<|> _)) :<|> (_ :<|> (_ :<|> _))) -> r postUser :: - HasScimClient tag => + (HasScimClient tag) => ClientEnv -> Maybe (AuthData tag) -> User tag -> @@ -135,7 +135,7 @@ postUser :: postUser env tok = case users (scimClients env) tok of ((_ :<|> (_ :<|> r)) :<|> (_ :<|> (_ :<|> _))) -> r putUser :: - HasScimClient tag => + (HasScimClient tag) => ClientEnv -> Maybe (AuthData tag) -> UserId tag -> @@ -144,7 +144,7 @@ putUser :: putUser env tok = case users (scimClients env) tok of ((_ :<|> (_ :<|> _)) :<|> (r :<|> (_ :<|> _))) -> r patchUser :: - HasScimClient tag => + (HasScimClient tag) => ClientEnv -> Maybe (AuthData tag) -> UserId tag -> @@ -154,7 +154,7 @@ patchUser env tok = case users (scimClients env) tok of ((_ :<|> (_ :<|> _)) :<| deleteUser :: forall tag. - HasScimClient tag => + (HasScimClient tag) => ClientEnv -> Maybe (AuthData tag) -> UserId tag -> diff --git a/libs/hscim/src/Web/Scim/ContentType.hs b/libs/hscim/src/Web/Scim/ContentType.hs index 81aa5dd10e9..bf79c7df790 100644 --- a/libs/hscim/src/Web/Scim/ContentType.hs +++ b/libs/hscim/src/Web/Scim/ContentType.hs @@ -46,8 +46,8 @@ instance Accept SCIM where "application" // "json" ] -instance ToJSON a => MimeRender SCIM a where +instance (ToJSON a) => MimeRender SCIM a where mimeRender _ = mimeRender (Proxy @JSON) -instance FromJSON a => MimeUnrender SCIM a where +instance (FromJSON a) => MimeUnrender SCIM a where mimeUnrender _ = mimeUnrender (Proxy @JSON) diff --git a/libs/hscim/src/Web/Scim/Handler.hs b/libs/hscim/src/Web/Scim/Handler.hs index 22133a77121..e600d50cd97 100644 --- a/libs/hscim/src/Web/Scim/Handler.hs +++ b/libs/hscim/src/Web/Scim/Handler.hs @@ -22,6 +22,7 @@ module Web.Scim.Handler ) where +import Control.Monad ((<=<)) import Control.Monad.Except import Web.Scim.Schema.Error @@ -29,7 +30,7 @@ import Web.Scim.Schema.Error 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 diff --git a/libs/hscim/src/Web/Scim/Schema/Common.hs b/libs/hscim/src/Web/Scim/Schema/Common.hs index eb95b05d2b0..4bceab55c08 100644 --- a/libs/hscim/src/Web/Scim/Schema/Common.hs +++ b/libs/hscim/src/Web/Scim/Schema/Common.hs @@ -99,7 +99,7 @@ parseOptions = -- -- (FUTUREWORK: The "recursively" part is a bit of a waste and could be dropped, but we would -- have to spend more effort in making sure it is always called manually in nested parsers.) -jsonLower :: forall m. m ~ Either [Text] => Value -> m Value +jsonLower :: forall m. (m ~ Either [Text]) => Value -> m Value jsonLower (Object (KeyMap.toList -> olist)) = Object . KeyMap.fromList <$> (nubCI >> mapM lowerPair olist) where diff --git a/libs/hscim/src/Web/Scim/Schema/ListResponse.hs b/libs/hscim/src/Web/Scim/Schema/ListResponse.hs index 0b9c9ba58a5..78e9a044cf6 100644 --- a/libs/hscim/src/Web/Scim/Schema/ListResponse.hs +++ b/libs/hscim/src/Web/Scim/Schema/ListResponse.hs @@ -58,10 +58,10 @@ fromList list = where len = length list -instance FromJSON a => FromJSON (ListResponse a) where +instance (FromJSON a) => FromJSON (ListResponse a) where parseJSON = either (fail . show) (genericParseJSON parseOptions) . jsonLower -instance ToJSON a => ToJSON (ListResponse a) where +instance (ToJSON a) => ToJSON (ListResponse a) where toJSON ListResponse {..} = object [ "Resources" .= resources, diff --git a/libs/hscim/src/Web/Scim/Schema/PatchOp.hs b/libs/hscim/src/Web/Scim/Schema/PatchOp.hs index 686e58b3ba7..1ac01c3b166 100644 --- a/libs/hscim/src/Web/Scim/Schema/PatchOp.hs +++ b/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" diff --git a/libs/hscim/src/Web/Scim/Schema/User.hs b/libs/hscim/src/Web/Scim/Schema/User.hs index 84655c898a0..1a37f6dae60 100644 --- a/libs/hscim/src/Web/Scim/Schema/User.hs +++ b/libs/hscim/src/Web/Scim/Schema/User.hs @@ -71,6 +71,7 @@ module Web.Scim.Schema.User ) where +import Control.Monad import Control.Monad.Except import Data.Aeson import qualified Data.Aeson.Key as Key @@ -139,9 +140,9 @@ data User tag = User } deriving (Generic) -deriving instance Show (UserExtra tag) => Show (User tag) +deriving instance (Show (UserExtra tag)) => Show (User tag) -deriving instance Eq (UserExtra tag) => Eq (User tag) +deriving instance (Eq (UserExtra tag)) => Eq (User tag) empty :: -- | Schemas @@ -177,7 +178,7 @@ empty schemas userName extra = extra = extra } -instance FromJSON (UserExtra tag) => FromJSON (User tag) where +instance (FromJSON (UserExtra tag)) => FromJSON (User tag) where parseJSON = withObject "User" $ \obj -> do -- Lowercase all fields let o = KeyMap.fromList . map (over _1 lowerKey) . KeyMap.toList $ obj @@ -208,7 +209,7 @@ instance FromJSON (UserExtra tag) => FromJSON (User tag) where extra <- parseJSON (Object obj) pure User {..} -instance ToJSON (UserExtra tag) => ToJSON (User tag) where +instance (ToJSON (UserExtra tag)) => ToJSON (User tag) where toJSON User {..} = let mainObject = KeyMap.fromList $ diff --git a/libs/hscim/src/Web/Scim/Server.hs b/libs/hscim/src/Web/Scim/Server.hs index db8176ae12d..364f382b0fb 100644 --- a/libs/hscim/src/Web/Scim/Server.hs +++ b/libs/hscim/src/Web/Scim/Server.hs @@ -85,7 +85,7 @@ data Site tag route = Site siteServer :: forall tag m. - DB tag m => + (DB tag m) => Configuration -> Site tag (AsServerT (ScimHandler m)) siteServer conf = @@ -117,7 +117,7 @@ mkapp proxy api nt = app :: forall tag m. - App tag m (SiteAPI tag) => + (App tag m (SiteAPI tag)) => Configuration -> (forall a. ScimHandler m a -> Handler a) -> Application diff --git a/libs/hscim/src/Web/Scim/Server/Mock.hs b/libs/hscim/src/Web/Scim/Server/Mock.hs index 11ffb37f60b..11a81d35642 100644 --- a/libs/hscim/src/Web/Scim/Server/Mock.hs +++ b/libs/hscim/src/Web/Scim/Server/Mock.hs @@ -23,6 +23,7 @@ -- ). module Web.Scim.Server.Mock where +import Control.Monad import Control.Monad.Morph import Control.Monad.Reader import Control.Monad.STM (STM, atomically) @@ -88,7 +89,7 @@ emptyTestStorage = -- in-memory implementation of the API for tests type TestServer = ReaderT TestStorage Handler -liftSTM :: MonadIO m => STM a -> m a +liftSTM :: (MonadIO m) => STM a -> m a liftSTM = liftIO . atomically hoistSTM :: (MFunctor t, MonadIO m) => t STM a -> t m a diff --git a/libs/hscim/src/Web/Scim/Test/Acceptance.hs b/libs/hscim/src/Web/Scim/Test/Acceptance.hs index c4eea4122a8..d6475eb1ad4 100644 --- a/libs/hscim/src/Web/Scim/Test/Acceptance.hs +++ b/libs/hscim/src/Web/Scim/Test/Acceptance.hs @@ -46,7 +46,7 @@ import Web.Scim.Schema.Meta import Web.Scim.Schema.UserTypes import Web.Scim.Test.Util -ignore :: Monad m => m a -> m () +ignore :: (Monad m) => m a -> m () ignore _ = pure () -- https://docs.microsoft.com/en-us/azure/active-directory/manage-apps/use-scim-to-provision-users-and-groups#step-2-understand-the-azure-ad-scim-implementation diff --git a/libs/hscim/src/Web/Scim/Test/Util.hs b/libs/hscim/src/Web/Scim/Test/Util.hs index 601cdaab598..da75b438a47 100644 --- a/libs/hscim/src/Web/Scim/Test/Util.hs +++ b/libs/hscim/src/Web/Scim/Test/Util.hs @@ -83,17 +83,17 @@ import Web.Scim.Schema.User (UserTypes (..)) -- FUTUREWORK: make this a PR upstream. (while we're at it, we can also patch 'WaiSession' -- and 'request' to keep track of the 'SRequest', and add that to the error message here with -- the response.) -shouldRespondWith :: HasCallStack => WaiSession st SResponse -> ResponseMatcher -> WaiExpectation st +shouldRespondWith :: (HasCallStack) => WaiSession st SResponse -> ResponseMatcher -> WaiExpectation st shouldRespondWith action matcher = either (liftIO . expectationFailure) pure =<< doesRespondWith action matcher -doesRespondWith :: HasCallStack => WaiSession st SResponse -> ResponseMatcher -> WaiSession st (Either String ()) +doesRespondWith :: (HasCallStack) => WaiSession st SResponse -> ResponseMatcher -> WaiSession st (Either String ()) doesRespondWith action matcher = do r <- action let extmsg = " details: " <> show r <> "\n" pure $ maybe (Right ()) (Left . (<> extmsg)) (match r matcher) -shouldEventuallyRespondWith :: HasCallStack => WaiSession st SResponse -> ResponseMatcher -> WaiExpectation st +shouldEventuallyRespondWith :: (HasCallStack) => WaiSession st SResponse -> ResponseMatcher -> WaiExpectation st shouldEventuallyRespondWith action matcher = either (liftIO . expectationFailure) pure =<< Retry.retrying diff --git a/libs/hscim/test/Test/FilterSpec.hs b/libs/hscim/test/Test/FilterSpec.hs index 888d84480d6..9fc6588e7f3 100644 --- a/libs/hscim/test/Test/FilterSpec.hs +++ b/libs/hscim/test/Test/FilterSpec.hs @@ -32,7 +32,7 @@ import Web.Scim.Schema.User (NoUserExtra) import Web.Scim.Schema.UserTypes (UserTypes (supportedSchemas)) import Web.Scim.Test.Util (TestTag) -prop_roundtrip :: forall tag. UserTypes tag => Property +prop_roundtrip :: forall tag. (UserTypes tag) => Property prop_roundtrip = property $ do x <- forAll $ genFilter @tag tripping x renderFilter $ parseFilter (supportedSchemas @tag) @@ -45,7 +45,7 @@ spec = do ---------------------------------------------------------------------------- -- Generators -genValuePath :: forall tag. UserTypes tag => Gen ValuePath +genValuePath :: forall tag. (UserTypes tag) => Gen ValuePath genValuePath = ValuePath <$> genAttrPath @tag <*> genFilter @tag genCompValue :: Gen CompValue @@ -72,16 +72,16 @@ genSubAttr = SubAttr <$> genAttrName -- FUTUREWORK: we also may want to factor a bounded enum type out of the 'Schema' type for -- this: @data Schema = Buitin BuitinSchema | Custom Text; data BuiltinSchema = ... deriving -- (Bounded, Enum, ...)@ -genSchema :: forall tag. UserTypes tag => Gen Schema +genSchema :: forall tag. (UserTypes tag) => Gen Schema genSchema = Gen.element (supportedSchemas @tag) -genAttrPath :: forall tag. UserTypes tag => Gen AttrPath +genAttrPath :: forall tag. (UserTypes tag) => Gen AttrPath genAttrPath = AttrPath <$> Gen.maybe (genSchema @tag) <*> genAttrName <*> Gen.maybe genSubAttr genAttrName :: Gen AttrName genAttrName = AttrName <$> (cons <$> Gen.alpha <*> Gen.text (Range.constant 0 50) (Gen.choice [Gen.alphaNum, Gen.constant '-', Gen.constant '_'])) -genFilter :: forall tag. UserTypes tag => Gen Filter +genFilter :: forall tag. (UserTypes tag) => Gen Filter genFilter = Gen.choice [ FilterAttrCompare <$> (genAttrPath @tag) <*> genCompareOp <*> genCompValue diff --git a/libs/hscim/test/Test/Schema/PatchOpSpec.hs b/libs/hscim/test/Test/Schema/PatchOpSpec.hs index dc5323cfa9c..2e9a0415316 100644 --- a/libs/hscim/test/Test/Schema/PatchOpSpec.hs +++ b/libs/hscim/test/Test/Schema/PatchOpSpec.hs @@ -48,28 +48,28 @@ isSuccess :: Result a -> Bool isSuccess (Success _) = True isSuccess (Error _) = False -genPatchOp :: forall tag. UserTypes tag => Gen Value -> Gen (PatchOp tag) +genPatchOp :: forall tag. (UserTypes tag) => Gen Value -> Gen (PatchOp tag) genPatchOp genValue = PatchOp <$> Gen.list (Range.constant 0 20) ((genOperation @tag) genValue) -genSimplePatchOp :: forall tag. UserTypes tag => Gen (PatchOp tag) +genSimplePatchOp :: forall tag. (UserTypes tag) => Gen (PatchOp tag) genSimplePatchOp = genPatchOp @tag (String <$> Gen.text (Range.constant 0 20) Gen.unicode) -genOperation :: forall tag. UserTypes tag => Gen Value -> Gen Operation +genOperation :: forall tag. (UserTypes tag) => Gen Value -> Gen Operation genOperation genValue = Operation <$> Gen.enumBounded <*> Gen.maybe (genPath @tag) <*> Gen.maybe genValue -genPath :: forall tag. UserTypes tag => Gen Path +genPath :: forall tag. (UserTypes tag) => Gen Path genPath = Gen.choice [ IntoValuePath <$> (genValuePath @tag) <*> Gen.maybe genSubAttr, NormalPath <$> (genAttrPath @tag) ] -prop_roundtrip :: forall tag. UserTypes tag => Property +prop_roundtrip :: forall tag. (UserTypes tag) => Property prop_roundtrip = property $ do x <- forAll $ genPath @tag tripping x (encodeUtf8 . rPath) (parseOnly $ pPath (supportedSchemas @tag)) -prop_roundtrip_PatchOp :: forall tag. UserTypes tag => Property +prop_roundtrip_PatchOp :: forall tag. (UserTypes tag) => Property prop_roundtrip_PatchOp = property $ do -- Just some strings for now. However, should be constrained to what the -- PatchOp is operating on in the future... We need better typed PatchOp for diff --git a/libs/hscim/test/Test/Schema/UserSpec.hs b/libs/hscim/test/Test/Schema/UserSpec.hs index deff894b70f..14b7b2ed8fb 100644 --- a/libs/hscim/test/Test/Schema/UserSpec.hs +++ b/libs/hscim/test/Test/Schema/UserSpec.hs @@ -156,7 +156,7 @@ genName = genStoredUser :: Gen (UserClass.StoredUser (TestTag Text () () NoUserExtra)) genStoredUser = do m <- genMeta - i <- Gen.element @_ @Text ["wef", "asdf", "@", "#", "1"] + i <- Gen.element ["wef", "asdf", "@", "#", "1"] WithMeta m . WithId i <$> genUser genMeta :: Gen Meta diff --git a/libs/hscim/test/Test/Schema/Util.hs b/libs/hscim/test/Test/Schema/Util.hs index a03c84d1ea1..83099d72b5b 100644 --- a/libs/hscim/test/Test/Schema/Util.hs +++ b/libs/hscim/test/Test/Schema/Util.hs @@ -60,5 +60,5 @@ mk_prop_caseInsensitive gen = property $ do same@(Bool _) -> same same@Null -> same -keyTextL :: Functor f => (Text -> f Text) -> Key -> f Key +keyTextL :: (Functor f) => (Text -> f Text) -> Key -> f Key keyTextL f key = fmap Key.fromText (f (Key.toText key)) diff --git a/libs/http2-manager/src/HTTP2/Client/Manager/Internal.hs b/libs/http2-manager/src/HTTP2/Client/Manager/Internal.hs index 0dd00173c8c..4861a150a4a 100644 --- a/libs/http2-manager/src/HTTP2/Client/Manager/Internal.hs +++ b/libs/http2-manager/src/HTTP2/Client/Manager/Internal.hs @@ -445,12 +445,13 @@ allocHTTP2Config (SecureTransport ssl) = do chunk <- SSL.read ssl n `catch` \(_ :: SSL.ConnectionAbruptlyTerminated) -> pure mempty let chunkLen = BS.length chunk if - | chunkLen == 0 || chunkLen == n -> - pure (acc <> chunk) - | chunkLen > n -> - error "openssl: SSL.read returned more bytes than asked for, this is probably a bug" - | otherwise -> - readData (acc <> chunk) (n - chunkLen) + | chunkLen == 0 || chunkLen == n -> + pure (acc <> chunk) + | chunkLen > n -> + error "openssl: SSL.read returned more bytes than asked for, this is probably a bug" + | otherwise -> + readData (acc <> chunk) (n - chunkLen) + pure HTTP2.Config { HTTP2.confWriteBuffer = buf, diff --git a/libs/http2-manager/test/Test/HTTP2/Client/ManagerSpec.hs b/libs/http2-manager/test/Test/HTTP2/Client/ManagerSpec.hs index f839619b9bb..04593bf39ab 100644 --- a/libs/http2-manager/test/Test/HTTP2/Client/ManagerSpec.hs +++ b/libs/http2-manager/test/Test/HTTP2/Client/ManagerSpec.hs @@ -287,12 +287,12 @@ allocServerConfig (Right ssl) = do chunk <- SSL.read ssl n `catch` \(_ :: SSL.ConnectionAbruptlyTerminated) -> pure mempty let chunkLen = BS.length chunk if - | chunkLen == 0 || chunkLen == n -> - pure (prevChunk <> chunk) - | chunkLen > n -> - error "openssl: SSL.read returned more bytes than asked for, this is probably a bug" - | otherwise -> - readData (prevChunk <> chunk) (n - chunkLen) + | chunkLen == 0 || chunkLen == n -> + pure (prevChunk <> chunk) + | chunkLen > n -> + error "openssl: SSL.read returned more bytes than asked for, this is probably a bug" + | otherwise -> + readData (prevChunk <> chunk) (n - chunkLen) pure Server.Config { Server.confWriteBuffer = buf, diff --git a/libs/imports/src/Imports.hs b/libs/imports/src/Imports.hs index 91841bbdd8c..ef162e09846 100644 --- a/libs/imports/src/Imports.hs +++ b/libs/imports/src/Imports.hs @@ -241,37 +241,37 @@ type LByteString = Data.ByteString.Lazy.ByteString ---------------------------------------------------------------------------- -- Lifted functions from Prelude -putChar :: MonadIO m => Char -> m () +putChar :: (MonadIO m) => Char -> m () putChar = liftIO . P.putChar -putStr :: MonadIO m => String -> m () +putStr :: (MonadIO m) => String -> m () putStr = liftIO . P.putStr -putStrLn :: MonadIO m => String -> m () +putStrLn :: (MonadIO m) => String -> m () putStrLn = liftIO . P.putStrLn print :: (Show a, MonadIO m) => a -> m () print = liftIO . P.print -getChar :: MonadIO m => m Char +getChar :: (MonadIO m) => m Char getChar = liftIO P.getChar -getLine :: MonadIO m => m String +getLine :: (MonadIO m) => m String getLine = liftIO P.getLine -getContents :: MonadIO m => m String +getContents :: (MonadIO m) => m String getContents = liftIO P.getContents -interact :: MonadIO m => (String -> String) -> m () +interact :: (MonadIO m) => (String -> String) -> m () interact = liftIO . P.interact -readFile :: MonadIO m => FilePath -> m String +readFile :: (MonadIO m) => FilePath -> m String readFile = liftIO . P.readFile -writeFile :: MonadIO m => FilePath -> String -> m () +writeFile :: (MonadIO m) => FilePath -> String -> m () writeFile = fmap liftIO . P.writeFile -appendFile :: MonadIO m => FilePath -> String -> m () +appendFile :: (MonadIO m) => FilePath -> String -> m () appendFile = fmap liftIO . P.appendFile readIO :: (Read a, MonadIO m) => String -> m a diff --git a/libs/libzauth/libzauth-c/Cargo.lock b/libs/libzauth/libzauth-c/Cargo.lock index 33cca98de2f..fc577f9994d 100644 --- a/libs/libzauth/libzauth-c/Cargo.lock +++ b/libs/libzauth/libzauth-c/Cargo.lock @@ -4,18 +4,18 @@ version = 3 [[package]] name = "aho-corasick" -version = "1.1.2" +version = "1.1.3" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "b2969dcb958b36655471fc61f7e416fa76033bdd4bfed0678d8fee1e2d07a1f0" +checksum = "8e60d3430d3a69478ad0993f19238d2df97c507009a52b3c10addcd7f6bcb916" dependencies = [ "memchr", ] [[package]] name = "anyhow" -version = "1.0.75" +version = "1.0.86" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "a4668cab20f66d8d020e1fbc0ebe47217433c1b6c8f2040faf858554e394ace6" +checksum = "b3d1d046238990b9cf5bcde22a3fb3584ee5cf65fb2765f454ed428c7a0063da" [[package]] name = "asexp" @@ -25,9 +25,9 @@ checksum = "5e368761ce758947307f1c2db1f46077b1aabb5af7f268b6cededd1b52802652" [[package]] name = "autocfg" -version = "1.1.0" +version = "1.3.0" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "d468802bab17cbc0cc575e9b053f41e72aa36bfa6b7f55e3529ffa43161b97fa" +checksum = "0c4b4d0bd25bd0b74681c0ad21497610ce1b7c91b1022cd21c80c6fbdd9476b0" [[package]] name = "base16ct" @@ -43,9 +43,9 @@ checksum = "4c7f02d4ea65f2c1853089ffd8d2787bdbc63de2f0d29dedbcf8ccdfa0ccd4cf" [[package]] name = "base64" -version = "0.21.5" +version = "0.21.7" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "35636a1494ede3b646cc98f74f8e62c773a38a659ebc777a2cf26b9b74171df9" +checksum = "9d297deb1925b89f2ccc13d7635fa0714f12c87adce1c75356b39ca9b7178567" [[package]] name = "base64ct" @@ -70,9 +70,9 @@ dependencies = [ [[package]] name = "bumpalo" -version = "3.14.0" +version = "3.16.0" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "7f30e7476521f6f8af1a1c4c0b8cc94f0bee37d91763d0ca2665f299b6cd8aec" +checksum = "79296716171880943b8470b5f8d03aa55eb2e645a4874bdbb28adb49162e012c" [[package]] name = "byteorder" @@ -82,12 +82,9 @@ checksum = "1fd0f2584146f6f2ef48085050886acf353beff7305ebd1ae69500e27c67f64b" [[package]] name = "cc" -version = "1.0.83" +version = "1.0.98" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "f1174fb0b6ec23863f8b971027804a42614e347eafb0a95bf0b12cdae21fc4d0" -dependencies = [ - "libc", -] +checksum = "41c270e7540d725e65ac7f1b212ac8ce349719624d7bcff99f8e2e488e8cf03f" [[package]] name = "cfg-if" @@ -97,27 +94,26 @@ checksum = "baf1de4339761588bc0619e3cbc0120ee582ebb74b53b4efbf79117bd2da40fd" [[package]] name = "coarsetime" -version = "0.1.29" +version = "0.1.34" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "a73ef0d00d14301df35d0f13f5ea32344de6b00837485c358458f1e7f2d27db4" +checksum = "13b3839cf01bb7960114be3ccf2340f541b6d0c81f8690b007b2b39f750f7e5d" dependencies = [ "libc", - "once_cell", - "wasi", + "wasix", "wasm-bindgen", ] [[package]] name = "const-oid" -version = "0.9.5" +version = "0.9.6" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "28c122c3980598d243d63d9a704629a2d748d101f278052ff068be5a4423ab6f" +checksum = "c2459377285ad874054d797f3ccebf984978aa39129f6eafde5cdc8315b612f8" [[package]] name = "cpufeatures" -version = "0.2.11" +version = "0.2.12" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "ce420fe07aecd3e67c5f910618fe65e94158f6dcc0adf44e00d69ce2bdfe0fd0" +checksum = "53fe5e26ff1b7aef8bca9c6080520cfb8d9333c7568e1829cef191a9723e5504" dependencies = [ "libc", ] @@ -136,9 +132,9 @@ dependencies = [ [[package]] name = "crypto-bigint" -version = "0.5.3" +version = "0.5.5" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "740fe28e594155f10cfc383984cbefd529d7396050557148f79cb0f621204124" +checksum = "0dc92fb57ca44df6db8059111ab3af99a63d5d0f8375d9972e319a379c6bab76" dependencies = [ "generic-array", "rand_core", @@ -175,9 +171,9 @@ dependencies = [ [[package]] name = "der" -version = "0.7.8" +version = "0.7.9" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "fffa369a668c8af7dbf8b5e56c9f744fbd399949ed171606040001947de40b1c" +checksum = "f55bf8e7b65898637379c1b74eb1551107c8294ed26d855ceb9fd1a09cfc9bc0" dependencies = [ "const-oid", "pem-rfc7468 0.7.0", @@ -210,16 +206,16 @@ dependencies = [ [[package]] name = "ecdsa" -version = "0.16.8" +version = "0.16.9" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "a4b1e0c257a9e9f25f90ff76d7a68360ed497ee519c8e428d1825ef0000799d4" +checksum = "ee27f32b5c5292967d2d4a9d7f1e0b0aed2c15daded5a60300e4abb9d8020bca" dependencies = [ - "der 0.7.8", + "der 0.7.9", "digest", - "elliptic-curve 0.13.6", + "elliptic-curve 0.13.8", "rfc6979 0.4.0", "signature 2.0.0", - "spki 0.7.2", + "spki 0.7.3", ] [[package]] @@ -233,9 +229,9 @@ dependencies = [ [[package]] name = "ed25519-compact" -version = "2.0.4" +version = "2.1.1" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "6a3d382e8464107391c8706b4c14b087808ecb909f6c15c34114bc42e53a9e4c" +checksum = "e9b3460f44bea8cd47f45a0c70892f1eff856d97cd55358b2f73f663789f6190" dependencies = [ "ct-codecs", "getrandom", @@ -265,12 +261,12 @@ dependencies = [ [[package]] name = "elliptic-curve" -version = "0.13.6" +version = "0.13.8" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "d97ca172ae9dc9f9b779a6e3a65d308f2af74e5b8c921299075bdb4a0370e914" +checksum = "b5e6043086bf7973472e0c7dff2142ea0b680d30e18d9cc40f267efbf222bd47" dependencies = [ "base16ct 0.2.0", - "crypto-bigint 0.5.3", + "crypto-bigint 0.5.5", "digest", "ff 0.13.0", "generic-array", @@ -317,13 +313,15 @@ dependencies = [ [[package]] name = "getrandom" -version = "0.2.10" +version = "0.2.15" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "be4136b2a15dd319360be1c07d9933517ccf0be8f16bf62a3bee4f0d618df427" +checksum = "c4567c8db10ae91089c99af84c68c38da3ec2f087c3f82960bcdbf3656b6f4d7" dependencies = [ "cfg-if", + "js-sys", "libc", "wasi", + "wasm-bindgen", ] [[package]] @@ -350,9 +348,9 @@ dependencies = [ [[package]] name = "hkdf" -version = "0.12.3" +version = "0.12.4" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "791a029f6b9fc27657f6f188ec6e5e43f6911f6f878e0dc5501396e09809d437" +checksum = "7b5f8eb2ad728638ea2c7d47a21db23b7b58a72ed6a38256b8a1849f15fbbdf7" dependencies = [ "hmac", ] @@ -392,9 +390,18 @@ dependencies = [ [[package]] name = "itoa" -version = "1.0.9" +version = "1.0.11" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "af150ab688ff2122fcef229be89cb50dd66af9e01a4ff320cc137eecc9bacc38" +checksum = "49f1f14873335454500d59611f1cf4a4b0f786f9ac11f4312a78e4cf2566695b" + +[[package]] +name = "js-sys" +version = "0.3.69" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "29c15563dc2726973df627357ce0c9ddddbea194836909d655df6a75d2cf296d" +dependencies = [ + "wasm-bindgen", +] [[package]] name = "jwt-simple" @@ -434,7 +441,7 @@ dependencies = [ "hmac-sha1-compact", "hmac-sha256", "hmac-sha512", - "k256 0.13.1", + "k256 0.13.3", "p256 0.13.2", "p384 0.13.0", "rand", @@ -462,13 +469,13 @@ dependencies = [ [[package]] name = "k256" -version = "0.13.1" +version = "0.13.3" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "cadb76004ed8e97623117f3df85b17aaa6626ab0b0831e6573f104df16cd1bcc" +checksum = "956ff9b67e26e1a6a866cb758f12c6f8746208489e3e4a4b5580802f2f0a587b" dependencies = [ "cfg-if", - "ecdsa 0.16.8", - "elliptic-curve 0.13.6", + "ecdsa 0.16.9", + "elliptic-curve 0.13.8", "once_cell", "sha2", "signature 2.0.0", @@ -485,9 +492,9 @@ dependencies = [ [[package]] name = "libc" -version = "0.2.149" +version = "0.2.155" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "a08173bc88b7955d1b3145aa561539096c421ac8debde8cbc3612ec635fee29b" +checksum = "97b3888a4aecf77e811145cadf6eef5901f4782c53886191b2f693f24761847c" [[package]] name = "libm" @@ -509,15 +516,15 @@ dependencies = [ [[package]] name = "log" -version = "0.4.20" +version = "0.4.21" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "b5e6163cb8c49088c2c36f57875e58ccd8c87c7427f7fbd50ea6710b2f3f2e8f" +checksum = "90ed8c1e510134f979dbc4f070f87d4313098b704861a105fe34231c70a3901c" [[package]] name = "memchr" -version = "2.6.4" +version = "2.7.2" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "f665ee40bc4a3c5590afb1e9677db74a508659dfd71e126420da8274909a0167" +checksum = "6c8640c5d730cb13ebd907d8d04b52f55ac9a2eec55b440c8892f40d56c76c1d" [[package]] name = "num-bigint-dig" @@ -538,19 +545,18 @@ dependencies = [ [[package]] name = "num-integer" -version = "0.1.45" +version = "0.1.46" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "225d3389fb3509a24c93f5c29eb6bde2586b98d9f016636dff58d7c6f7569cd9" +checksum = "7969661fd2958a5cb096e56c8e1ad0444ac2bbcd0061bd28660485a44879858f" dependencies = [ - "autocfg", "num-traits", ] [[package]] name = "num-iter" -version = "0.1.43" +version = "0.1.45" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "7d03e6c028c5dc5cac6e2dec0efda81fc887605bb3d884578bb6d6bf7514e252" +checksum = "1429034a0490724d0075ebb2bc9e875d6503c3cf69e235a8941aa757d83ef5bf" dependencies = [ "autocfg", "num-integer", @@ -559,9 +565,9 @@ dependencies = [ [[package]] name = "num-traits" -version = "0.2.17" +version = "0.2.19" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "39e3200413f237f41ab11ad6d161bc7239c84dcb631773ccd7de3dfe4b5c267c" +checksum = "071dfc062690e90b734c0b2273ce72ad0ffa95f0c74596bc250dcfd960262841" dependencies = [ "autocfg", "libm", @@ -569,9 +575,9 @@ dependencies = [ [[package]] name = "once_cell" -version = "1.18.0" +version = "1.19.0" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "dd8b5dd2ae5ed71462c540258bedcb51965123ad7e7ccf4b9a8cafaa4a63576d" +checksum = "3fdb12b2476b595f9358c5161aa467c2438859caa136dec86c26fdd2efe17b92" [[package]] name = "p256" @@ -591,9 +597,9 @@ version = "0.13.2" source = "registry+https://github.com/rust-lang/crates.io-index" checksum = "c9863ad85fa8f4460f9c48cb909d38a0d689dba1f6f6988a5e3e0d31071bcd4b" dependencies = [ - "ecdsa 0.16.8", - "elliptic-curve 0.13.6", - "primeorder 0.13.2", + "ecdsa 0.16.9", + "elliptic-curve 0.13.8", + "primeorder 0.13.6", "sha2", ] @@ -615,9 +621,9 @@ version = "0.13.0" source = "registry+https://github.com/rust-lang/crates.io-index" checksum = "70786f51bcc69f6a4c0360e063a4cac5419ef7c5cd5b3c99ad70f3be5ba79209" dependencies = [ - "ecdsa 0.16.8", - "elliptic-curve 0.13.6", - "primeorder 0.13.2", + "ecdsa 0.16.9", + "elliptic-curve 0.13.8", + "primeorder 0.13.6", "sha2", ] @@ -667,15 +673,15 @@ version = "0.10.2" source = "registry+https://github.com/rust-lang/crates.io-index" checksum = "f950b2377845cebe5cf8b5165cb3cc1a5e0fa5cfa3e1f7f55707d8fd82e0a7b7" dependencies = [ - "der 0.7.8", - "spki 0.7.2", + "der 0.7.9", + "spki 0.7.3", ] [[package]] name = "pkg-config" -version = "0.3.27" +version = "0.3.30" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "26072860ba924cbfa98ea39c8c19b4dd6a4a25423dbdf219c1eca91aa0cf6964" +checksum = "d231b230927b5e4ad203db57bbcbee2802f6bce620b1e4a9024a07d94e2907ec" [[package]] name = "ppv-lite86" @@ -694,27 +700,27 @@ dependencies = [ [[package]] name = "primeorder" -version = "0.13.2" +version = "0.13.6" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "3c2fcef82c0ec6eefcc179b978446c399b3cdf73c392c35604e399eee6df1ee3" +checksum = "353e1ca18966c16d9deb1c69278edbc5f194139612772bd9537af60ac231e1e6" dependencies = [ - "elliptic-curve 0.13.6", + "elliptic-curve 0.13.8", ] [[package]] name = "proc-macro2" -version = "1.0.69" +version = "1.0.84" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "134c189feb4956b20f6f547d2cf727d4c0fe06722b20a0eec87ed445a97f92da" +checksum = "ec96c6a92621310b51366f1e28d05ef11489516e93be030060e5fc12024a49d6" dependencies = [ "unicode-ident", ] [[package]] name = "quote" -version = "1.0.33" +version = "1.0.36" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "5267fca4496028628a95160fc423a33e8b2e6af8a5302579e322e4b520293cae" +checksum = "0fa76aaf39101c457836aec0ce2316dbdc3ab723cdda1c6bd4e6ad4208acaca7" dependencies = [ "proc-macro2", ] @@ -751,9 +757,9 @@ dependencies = [ [[package]] name = "regex" -version = "1.10.2" +version = "1.10.4" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "380b951a9c5e80ddfd6136919eef32310721aa4aacd4889a8d39124b026ab343" +checksum = "c117dbdfde9c8308975b6a18d71f3f385c89461f7b3fb054288ecf2a2058ba4c" dependencies = [ "aho-corasick", "memchr", @@ -763,9 +769,9 @@ dependencies = [ [[package]] name = "regex-automata" -version = "0.4.3" +version = "0.4.6" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "5f804c7828047e88b2d32e2d7fe5a105da8ee3264f01902f796c8e067dc2483f" +checksum = "86b83b8b9847f9bf95ef68afb0b8e6cdb80f498442f5179a29fad448fcc1eaea" dependencies = [ "aho-corasick", "memchr", @@ -774,9 +780,9 @@ dependencies = [ [[package]] name = "regex-syntax" -version = "0.8.2" +version = "0.8.3" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "c08c74e62047bb2de4ff487b251e4a92e24f48745648451635cec7d591162d9f" +checksum = "adad44e29e4c806119491a7f06f03de4d1af22c3a680dd47f1e6e179439d1f56" [[package]] name = "rfc6979" @@ -822,15 +828,15 @@ dependencies = [ [[package]] name = "rustc-serialize" -version = "0.3.24" +version = "0.3.25" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "dcf128d1287d2ea9d80910b5f1120d0b8eede3fbf1abe91c40d39ea7d51e6fda" +checksum = "fe834bc780604f4674073badbad26d7219cadfb4a2275802db12cbae17498401" [[package]] name = "ryu" -version = "1.0.15" +version = "1.0.18" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "1ad4cc8da4ef723ed60bced201181d83791ad433213d8c24efffda1eec85d741" +checksum = "f3cb5ba0dc43242ce17de99c180e96db90b235b8a9fdc9543c96d2209116bd9f" [[package]] name = "same-file" @@ -862,7 +868,7 @@ source = "registry+https://github.com/rust-lang/crates.io-index" checksum = "d3e97a565f76233a6003f9f5c54be1d9c5bdfa3eccfb189469f11ec4901c47dc" dependencies = [ "base16ct 0.2.0", - "der 0.7.8", + "der 0.7.9", "generic-array", "pkcs8 0.10.2", "subtle", @@ -871,18 +877,18 @@ dependencies = [ [[package]] name = "serde" -version = "1.0.190" +version = "1.0.203" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "91d3c334ca1ee894a2c6f6ad698fe8c435b76d504b13d436f0685d648d6d96f7" +checksum = "7253ab4de971e72fb7be983802300c30b5a7f0c2e56fab8abfc6a214307c0094" dependencies = [ "serde_derive", ] [[package]] name = "serde_derive" -version = "1.0.190" +version = "1.0.203" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "67c5609f394e5c2bd7fc51efda478004ea80ef42fee983d5c67a65e34f32c0e3" +checksum = "500cbc0ebeb6f46627f50f3f5811ccf6bf00643be300b4c3eabc0ef55dc5b5ba" dependencies = [ "proc-macro2", "quote", @@ -891,9 +897,9 @@ dependencies = [ [[package]] name = "serde_json" -version = "1.0.108" +version = "1.0.117" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "3d1c7e3eac408d115102c4c24ad393e0821bb3a5df4d506a80f85f7a742a526b" +checksum = "455182ea6142b14f93f4bc5320a2b31c1f266b66a4a5c858b013302a5d8cbfc3" dependencies = [ "itoa", "ryu", @@ -933,9 +939,9 @@ dependencies = [ [[package]] name = "smallvec" -version = "1.11.1" +version = "1.13.2" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "942b4a808e05215192e39f4ab80813e599068285906cc91aa64f923db842bd5a" +checksum = "3c5e1a9a646d36c3599cd173a41282daf47c44583ad367b8e6837255952e5c67" [[package]] name = "sodiumoxide" @@ -967,12 +973,12 @@ dependencies = [ [[package]] name = "spki" -version = "0.7.2" +version = "0.7.3" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "9d1e996ef02c474957d681f1b05213dfb0abab947b446a62d37770b23500184a" +checksum = "d91ed6c858b01f942cd56b37a94b3e0a1798290327d1236e4d9cf4eaca44d29d" dependencies = [ "base64ct", - "der 0.7.8", + "der 0.7.9", ] [[package]] @@ -983,9 +989,9 @@ checksum = "81cdd64d312baedb58e21336b31bc043b77e01cc99033ce76ef539f78e965ebc" [[package]] name = "syn" -version = "2.0.38" +version = "2.0.66" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "e96b79aaa137db8f61e26363a0c9b47d8b4ec75da28b7d1d614c2303e232408b" +checksum = "c42f3f41a2de00b01c0aaad383c5a45241efc8b2d1eda5661812fda5f3cdcff5" dependencies = [ "proc-macro2", "quote", @@ -994,18 +1000,18 @@ dependencies = [ [[package]] name = "thiserror" -version = "1.0.50" +version = "1.0.61" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "f9a7210f5c9a7156bb50aa36aed4c95afb51df0df00713949448cf9e97d382d2" +checksum = "c546c80d6be4bc6a00c0f01730c08df82eaa7a7a61f11d656526506112cc1709" dependencies = [ "thiserror-impl", ] [[package]] name = "thiserror-impl" -version = "1.0.50" +version = "1.0.61" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "266b2e40bc00e5a6c09c3584011e08b06f123c00362c92b975ba9843aaaa14b8" +checksum = "46c3384250002a6d5af4d114f2845d37b57521033f30d5c3f46c4d70e1197533" dependencies = [ "proc-macro2", "quote", @@ -1032,9 +1038,9 @@ checksum = "49874b5167b65d7193b8aba1567f5c7d93d001cafc34600cee003eda787e483f" [[package]] name = "walkdir" -version = "2.4.0" +version = "2.5.0" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "d71d857dc86794ca4c280d616f7da00d2dbfd8cd788846559a6813e6aa4b54ee" +checksum = "29790946404f91d9c5d06f9874efddea1dc06c5efe94541a7d6863108e3a5e4b" dependencies = [ "same-file", "winapi-util", @@ -1046,11 +1052,20 @@ version = "0.11.0+wasi-snapshot-preview1" source = "registry+https://github.com/rust-lang/crates.io-index" checksum = "9c8d87e72b64a3b4db28d11ce29237c246188f4f51057d65a7eab63b7987e423" +[[package]] +name = "wasix" +version = "0.12.21" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "c1fbb4ef9bbca0c1170e0b00dd28abc9e3b68669821600cad1caaed606583c6d" +dependencies = [ + "wasi", +] + [[package]] name = "wasm-bindgen" -version = "0.2.87" +version = "0.2.92" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "7706a72ab36d8cb1f80ffbf0e071533974a60d0a308d01a5d0375bf60499a342" +checksum = "4be2531df63900aeb2bca0daaaddec08491ee64ceecbee5076636a3b026795a8" dependencies = [ "cfg-if", "wasm-bindgen-macro", @@ -1058,9 +1073,9 @@ dependencies = [ [[package]] name = "wasm-bindgen-backend" -version = "0.2.87" +version = "0.2.92" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "5ef2b6d3c510e9625e5fe6f509ab07d66a760f0885d858736483c32ed7809abd" +checksum = "614d787b966d3989fa7bb98a654e369c762374fd3213d212cfc0251257e747da" dependencies = [ "bumpalo", "log", @@ -1073,9 +1088,9 @@ dependencies = [ [[package]] name = "wasm-bindgen-macro" -version = "0.2.87" +version = "0.2.92" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "dee495e55982a3bd48105a7b947fd2a9b4a8ae3010041b9e0faab3f9cd028f1d" +checksum = "a1f8823de937b71b9460c0c34e25f3da88250760bec0ebac694b49997550d726" dependencies = [ "quote", "wasm-bindgen-macro-support", @@ -1083,9 +1098,9 @@ dependencies = [ [[package]] name = "wasm-bindgen-macro-support" -version = "0.2.87" +version = "0.2.92" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "54681b18a46765f095758388f2d0cf16eb8d4169b639ab575a8f5693af210c7b" +checksum = "e94f17b526d0a461a191c78ea52bbce64071ed5c04c9ffe424dcb38f74171bb7" dependencies = [ "proc-macro2", "quote", @@ -1096,40 +1111,91 @@ dependencies = [ [[package]] name = "wasm-bindgen-shared" -version = "0.2.87" +version = "0.2.92" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "ca6ad05a4870b2bf5fe995117d3728437bd27d7cd5f06f13c17443ef369775a1" +checksum = "af190c94f2773fdb3729c55b007a722abb5384da03bc0986df4c289bf5567e96" [[package]] -name = "winapi" -version = "0.3.9" +name = "winapi-util" +version = "0.1.8" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "5c839a674fcd7a98952e593242ea400abe93992746761e38641405d28b00f419" +checksum = "4d4cc384e1e73b93bafa6fb4f1df8c41695c8a91cf9c4c64358067d15a7b6c6b" dependencies = [ - "winapi-i686-pc-windows-gnu", - "winapi-x86_64-pc-windows-gnu", + "windows-sys", ] [[package]] -name = "winapi-i686-pc-windows-gnu" -version = "0.4.0" +name = "windows-sys" +version = "0.52.0" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "ac3b87c63620426dd9b991e5ce0329eff545bccbbb34f3be09ff6fb6ab51b7b6" +checksum = "282be5f36a8ce781fad8c8ae18fa3f9beff57ec1b52cb3de0789201425d9a33d" +dependencies = [ + "windows-targets", +] [[package]] -name = "winapi-util" -version = "0.1.6" +name = "windows-targets" +version = "0.52.5" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "f29e6f9198ba0d26b4c9f07dbe6f9ed633e1f3d5b8b414090084349e46a52596" +checksum = "6f0713a46559409d202e70e28227288446bf7841d3211583a4b53e3f6d96e7eb" dependencies = [ - "winapi", + "windows_aarch64_gnullvm", + "windows_aarch64_msvc", + "windows_i686_gnu", + "windows_i686_gnullvm", + "windows_i686_msvc", + "windows_x86_64_gnu", + "windows_x86_64_gnullvm", + "windows_x86_64_msvc", ] [[package]] -name = "winapi-x86_64-pc-windows-gnu" -version = "0.4.0" +name = "windows_aarch64_gnullvm" +version = "0.52.5" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "712e227841d057c1ee1cd2fb22fa7e5a5461ae8e48fa2ca79ec42cfc1931183f" +checksum = "7088eed71e8b8dda258ecc8bac5fb1153c5cffaf2578fc8ff5d61e23578d3263" + +[[package]] +name = "windows_aarch64_msvc" +version = "0.52.5" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "9985fd1504e250c615ca5f281c3f7a6da76213ebd5ccc9561496568a2752afb6" + +[[package]] +name = "windows_i686_gnu" +version = "0.52.5" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "88ba073cf16d5372720ec942a8ccbf61626074c6d4dd2e745299726ce8b89670" + +[[package]] +name = "windows_i686_gnullvm" +version = "0.52.5" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "87f4261229030a858f36b459e748ae97545d6f1ec60e5e0d6a3d32e0dc232ee9" + +[[package]] +name = "windows_i686_msvc" +version = "0.52.5" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "db3c2bf3d13d5b658be73463284eaf12830ac9a26a90c717b7f771dfe97487bf" + +[[package]] +name = "windows_x86_64_gnu" +version = "0.52.5" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "4e4246f76bdeff09eb48875a0fd3e2af6aada79d409d33011886d3e1581517d9" + +[[package]] +name = "windows_x86_64_gnullvm" +version = "0.52.5" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "852298e482cd67c356ddd9570386e2862b5673c85bd5f88df9ab6802b334c596" + +[[package]] +name = "windows_x86_64_msvc" +version = "0.52.5" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "bec47e5bfd1bff0eeaf6d8b485cc1074891a197ab4225d504cb7a1ab88b02bf0" [[package]] name = "zauth" @@ -1158,6 +1224,6 @@ dependencies = [ [[package]] name = "zeroize" -version = "1.6.0" +version = "1.8.1" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "2a0956f1ba7c7909bfb66c2e9e4124ab6f6482560f6628b5aaeba39207c9aad9" +checksum = "ced3678a2879b30306d323f4542626697a464a97c0a07c9aebf7ebca65cd4dde" diff --git a/libs/libzauth/libzauth-c/Cargo.nix b/libs/libzauth/libzauth-c/Cargo.nix index ac5c917bd28..1c3b94dad3b 100644 --- a/libs/libzauth/libzauth-c/Cargo.nix +++ b/libs/libzauth/libzauth-c/Cargo.nix @@ -83,9 +83,9 @@ rec { crates = { "aho-corasick" = rec { crateName = "aho-corasick"; - version = "1.1.2"; + version = "1.1.3"; edition = "2021"; - sha256 = "1w510wnixvlgimkx1zjbvlxh6xps2vjgfqgwf5a6adlbjp5rv5mj"; + sha256 = "05mrpkvdgp5d20y2p989f187ry9diliijgwrs254fs9s1m1x6q4f"; libName = "aho_corasick"; authors = [ "Andrew Gallant " @@ -104,13 +104,13 @@ rec { "perf-literal" = [ "dep:memchr" ]; "std" = [ "memchr?/std" ]; }; - resolvedDefaultFeatures = [ "default" "perf-literal" "std" ]; + resolvedDefaultFeatures = [ "perf-literal" "std" ]; }; "anyhow" = rec { crateName = "anyhow"; - version = "1.0.75"; + version = "1.0.86"; edition = "2018"; - sha256 = "1rmcjkim91c5mw7h9wn8nv0k6x118yz0xg0z1q18svgn42mqqrm4"; + sha256 = "1nk301x8qhpdaks6a9zvcp7yakjqnczjmqndbg7vk4494d3d1ldk"; authors = [ "David Tolnay " ]; @@ -132,9 +132,9 @@ rec { }; "autocfg" = rec { crateName = "autocfg"; - version = "1.1.0"; + version = "1.3.0"; edition = "2015"; - sha256 = "1ylp3cb47ylzabimazvbz9ms6ap784zhb6syaz6c1jqpmcmq0s6l"; + sha256 = "1c3njkfzpil03k92q0mij5y1pkhhfr4j3bf0h53bgl2vs85lsjqc"; authors = [ "Josh Stone " ]; @@ -168,9 +168,9 @@ rec { }; "base64" = rec { crateName = "base64"; - version = "0.21.5"; + version = "0.21.7"; edition = "2018"; - sha256 = "1y8x2xs9nszj5ix7gg4ycn5a6wy7ca74zxwqri3bdqzdjha6lqrm"; + sha256 = "0rw52yvsk75kar9wgqfwgb414kvil1gn7mqkrhn9zf1537mpsacx"; authors = [ "Alice Maz " "Marshall Pierce " @@ -222,14 +222,15 @@ rec { }; "bumpalo" = rec { crateName = "bumpalo"; - version = "3.14.0"; + version = "3.16.0"; edition = "2021"; - sha256 = "1v4arnv9kwk54v5d0qqpv4vyw2sgr660nk0w3apzixi1cm3yfc3z"; + sha256 = "0b015qb4knwanbdlp1x48pkb4pm57b8gidbhhhxr900q2wb6fabr"; authors = [ "Nick Fitzgerald " ]; features = { "allocator-api2" = [ "dep:allocator-api2" ]; + "serde" = [ "dep:serde" ]; }; resolvedDefaultFeatures = [ "default" ]; }; @@ -247,24 +248,17 @@ rec { }; "cc" = rec { crateName = "cc"; - version = "1.0.83"; + version = "1.0.98"; edition = "2018"; - crateBin = [ ]; - sha256 = "1l643zidlb5iy1dskc5ggqs4wqa29a02f44piczqc8zcnsq4y5zi"; + sha256 = "0gzhij74hblfkzwwyysdc8crfd6fr0m226vzmijmwwhdakkp1hj1"; authors = [ "Alex Crichton " ]; - dependencies = [ - { - name = "libc"; - packageId = "libc"; - usesDefaultFeatures = false; - target = { target, features }: (target."unix" or false); - } - ]; features = { "jobserver" = [ "dep:jobserver" ]; - "parallel" = [ "jobserver" ]; + "libc" = [ "dep:libc" ]; + "once_cell" = [ "dep:once_cell" ]; + "parallel" = [ "libc" "jobserver" "once_cell" ]; }; }; "cfg-if" = rec { @@ -283,9 +277,9 @@ rec { }; "coarsetime" = rec { crateName = "coarsetime"; - version = "0.1.29"; + version = "0.1.34"; edition = "2018"; - sha256 = "1d3xsbrfgwaqhhsmqj1p12qfck9l6bmga4qgbprisc0l1p8g0gm7"; + sha256 = "0pby1xsrzcxj0yq911hzr38bchgm80iwyg5y2h0rddqvy2f87cqk"; authors = [ "Frank Denis " ]; @@ -293,16 +287,12 @@ rec { { name = "libc"; packageId = "libc"; - target = { target, features }: (!("wasi" == target."os")); + target = { target, features }: (!(("wasix" == target."os") || ("wasi" == target."os"))); } { - name = "once_cell"; - packageId = "once_cell"; - } - { - name = "wasi"; - packageId = "wasi"; - target = { target, features }: ("wasi" == target."os"); + name = "wasix"; + packageId = "wasix"; + target = { target, features }: (("wasix" == target."os") || ("wasi" == target."os")); } { name = "wasm-bindgen"; @@ -310,13 +300,15 @@ rec { target = { target, features }: ((("wasm32" == target."arch") || ("wasm64" == target."arch")) && ("unknown" == target."os")); } ]; - features = { }; + features = { + "wasi-abi2" = [ "dep:wasi-abi2" ]; + }; }; "const-oid" = rec { crateName = "const-oid"; - version = "0.9.5"; + version = "0.9.6"; edition = "2021"; - sha256 = "0vxb4d25mgk8y0phay7j078limx2553716ixsr1x5605k31j5h98"; + sha256 = "1y0jnqaq7p2wvspnx7qj76m7hjcqpz73qzvr9l2p9n2s51vr6if2"; authors = [ "RustCrypto Developers" ]; @@ -326,9 +318,9 @@ rec { }; "cpufeatures" = rec { crateName = "cpufeatures"; - version = "0.2.11"; + version = "0.2.12"; edition = "2018"; - sha256 = "1l0gzsyy576n017g9bf0vkv5hhg9cpz1h1libxyfdlzcgbh0yhnf"; + sha256 = "012m7rrak4girqlii3jnqwrr73gv1i980q4wra5yyyhvzwk5xzjk"; authors = [ "RustCrypto Developers" ]; @@ -407,11 +399,11 @@ rec { }; resolvedDefaultFeatures = [ "generic-array" "rand_core" "zeroize" ]; }; - "crypto-bigint 0.5.3" = rec { + "crypto-bigint 0.5.5" = rec { crateName = "crypto-bigint"; - version = "0.5.3"; + version = "0.5.5"; edition = "2021"; - sha256 = "092140hzdc4wyx472mahc0wxfafmxz5q8f9qzh6g2ma1b67f43vl"; + sha256 = "0xmbdff3g6ii5sbxjxc31xfkv9lrmyril4arh3dzckd4gjsjzj8d"; authors = [ "RustCrypto Developers" ]; @@ -537,11 +529,11 @@ rec { }; resolvedDefaultFeatures = [ "alloc" "const-oid" "oid" "pem" "pem-rfc7468" "std" "zeroize" ]; }; - "der 0.7.8" = rec { + "der 0.7.9" = rec { crateName = "der"; - version = "0.7.8"; + version = "0.7.9"; edition = "2021"; - sha256 = "070bwiyr80800h31c5zd96ckkgagfjgnrrdmz3dzg2lccsd3dypz"; + sha256 = "1h4vzjfa1lczxdf8avfj9qlwh1qianqlxdy1g5rn762qnvkzhnzm"; authors = [ "RustCrypto Developers" ]; @@ -681,18 +673,18 @@ rec { }; resolvedDefaultFeatures = [ "alloc" "arithmetic" "der" "digest" "hazmat" "pem" "pkcs8" "rfc6979" "signing" "std" "verifying" ]; }; - "ecdsa 0.16.8" = rec { + "ecdsa 0.16.9" = rec { crateName = "ecdsa"; - version = "0.16.8"; + version = "0.16.9"; edition = "2021"; - sha256 = "1m4r0w0g0pl2s4lf9j0rwmz4kvb0hfkdfxpzj1gz5sd9az1f1cd4"; + sha256 = "1jhb0bcbkaz4001sdmfyv8ajrv8a1cg7z7aa5myrd4jjbhmz69zf"; authors = [ "RustCrypto Developers" ]; dependencies = [ { name = "der"; - packageId = "der 0.7.8"; + packageId = "der 0.7.9"; optional = true; } { @@ -704,7 +696,7 @@ rec { } { name = "elliptic-curve"; - packageId = "elliptic-curve 0.13.6"; + packageId = "elliptic-curve 0.13.8"; usesDefaultFeatures = false; features = [ "digest" "sec1" ]; } @@ -721,7 +713,7 @@ rec { } { name = "spki"; - packageId = "spki 0.7.2"; + packageId = "spki 0.7.3"; optional = true; usesDefaultFeatures = false; } @@ -729,7 +721,7 @@ rec { devDependencies = [ { name = "elliptic-curve"; - packageId = "elliptic-curve 0.13.6"; + packageId = "elliptic-curve 0.13.8"; usesDefaultFeatures = false; features = [ "dev" ]; } @@ -783,9 +775,9 @@ rec { }; "ed25519-compact" = rec { crateName = "ed25519-compact"; - version = "2.0.4"; + version = "2.1.1"; edition = "2018"; - sha256 = "0k4y7bjl5g0l871iav4zj35qx047n0a4qsvhr28p6434hhp3hgba"; + sha256 = "1431kxw67xkk5y5kamfdjxnqbzqy5y4p032syi3wva5y8h7ldcz9"; authors = [ "Frank Denis " ]; @@ -799,6 +791,14 @@ rec { name = "getrandom"; packageId = "getrandom"; optional = true; + target = { target, features }: ((("wasm32" == target."arch") || ("wasm64" == target."arch")) && ("unknown" == target."os")); + features = [ "js" ]; + } + { + name = "getrandom"; + packageId = "getrandom"; + optional = true; + target = { target, features }: (!((("wasm32" == target."arch") || ("wasm64" == target."arch")) && ("unknown" == target."os"))); } ]; devDependencies = [ @@ -809,6 +809,13 @@ rec { { name = "getrandom"; packageId = "getrandom"; + target = { target, features }: ((("wasm32" == target."arch") || ("wasm64" == target."arch")) && ("unknown" == target."os")); + features = [ "js" ]; + } + { + name = "getrandom"; + packageId = "getrandom"; + target = { target, features }: (!((("wasm32" == target."arch") || ("wasm64" == target."arch")) && ("unknown" == target."os"))); } ]; features = { @@ -935,11 +942,11 @@ rec { }; resolvedDefaultFeatures = [ "alloc" "arithmetic" "digest" "ecdh" "ff" "group" "hazmat" "hkdf" "pem" "pem-rfc7468" "pkcs8" "sec1" "std" ]; }; - "elliptic-curve 0.13.6" = rec { + "elliptic-curve 0.13.8" = rec { crateName = "elliptic-curve"; - version = "0.13.6"; + version = "0.13.8"; edition = "2021"; - sha256 = "0579f01lmnsv0yci54lcbd7gfalg61fsdqx6g6vzkjcxmrra2z6r"; + sha256 = "0ixx4brgnzi61z29r3g1606nh2za88hzyz8c5r3p6ydzhqq09rmm"; authors = [ "RustCrypto Developers" ]; @@ -950,7 +957,7 @@ rec { } { name = "crypto-bigint"; - packageId = "crypto-bigint 0.5.3"; + packageId = "crypto-bigint 0.5.5"; usesDefaultFeatures = false; features = [ "rand_core" "generic-array" "zeroize" ]; } @@ -1141,9 +1148,9 @@ rec { }; "getrandom" = rec { crateName = "getrandom"; - version = "0.2.10"; + version = "0.2.15"; edition = "2018"; - sha256 = "09zlimhhskzf7cmgcszix05wyz2i6fcpvh711cv1klsxl6r3chdy"; + sha256 = "1mzlnrb3dgyd1fb84gvw10pyr8wdqdl4ry4sr64i1s8an66pqmn4"; authors = [ "The Rand Project Developers" ]; @@ -1152,6 +1159,12 @@ rec { name = "cfg-if"; packageId = "cfg-if"; } + { + name = "js-sys"; + packageId = "js-sys"; + optional = true; + target = { target, features }: ((("wasm32" == target."arch") || ("wasm64" == target."arch")) && ("unknown" == target."os")); + } { name = "libc"; packageId = "libc"; @@ -1164,6 +1177,13 @@ rec { usesDefaultFeatures = false; target = { target, features }: ("wasi" == target."os"); } + { + name = "wasm-bindgen"; + packageId = "wasm-bindgen"; + optional = true; + usesDefaultFeatures = false; + target = { target, features }: ((("wasm32" == target."arch") || ("wasm64" == target."arch")) && ("unknown" == target."os")); + } ]; features = { "compiler_builtins" = [ "dep:compiler_builtins" ]; @@ -1173,7 +1193,7 @@ rec { "rustc-dep-of-std" = [ "compiler_builtins" "core" "libc/rustc-dep-of-std" "wasi/rustc-dep-of-std" ]; "wasm-bindgen" = [ "dep:wasm-bindgen" ]; }; - resolvedDefaultFeatures = [ "std" ]; + resolvedDefaultFeatures = [ "js" "js-sys" "std" "wasm-bindgen" ]; }; "group 0.12.1" = rec { crateName = "group"; @@ -1248,9 +1268,9 @@ rec { }; "hkdf" = rec { crateName = "hkdf"; - version = "0.12.3"; + version = "0.12.4"; edition = "2018"; - sha256 = "0dyl16cf15hka32hv3l7dwgr3xj3brpfr27iyrbpdhlzdfgh46kr"; + sha256 = "1xxxzcarz151p1b858yn5skmhyrvn8fs4ivx5km3i1kjmnr8wpvv"; authors = [ "RustCrypto Developers" ]; @@ -1363,9 +1383,9 @@ rec { }; "itoa" = rec { crateName = "itoa"; - version = "1.0.9"; + version = "1.0.11"; edition = "2018"; - sha256 = "0f6cpb4yqzhkrhhg6kqsw3wnmmhdnnffi6r2xzy248gzi2v0l5dg"; + sha256 = "0nv9cqjwzr3q58qz84dcz63ggc54yhf1yqar1m858m1kfd4g3wa9"; authors = [ "David Tolnay " ]; @@ -1373,6 +1393,22 @@ rec { "no-panic" = [ "dep:no-panic" ]; }; }; + "js-sys" = rec { + crateName = "js-sys"; + version = "0.3.69"; + edition = "2018"; + sha256 = "0v99rz97asnzapb0jsc3jjhvxpfxr7h7qd97yqyrf9i7viimbh99"; + authors = [ + "The wasm-bindgen Developers" + ]; + dependencies = [ + { + name = "wasm-bindgen"; + packageId = "wasm-bindgen"; + } + ]; + + }; "jwt-simple 0.11.3" = rec { crateName = "jwt-simple"; version = "0.11.3"; @@ -1523,7 +1559,7 @@ rec { } { name = "k256"; - packageId = "k256 0.13.1"; + packageId = "k256 0.13.3"; features = [ "ecdsa" "std" "pkcs8" "pem" ]; } { @@ -1654,11 +1690,11 @@ rec { }; resolvedDefaultFeatures = [ "alloc" "arithmetic" "default" "digest" "ecdsa" "ecdsa-core" "once_cell" "pem" "pkcs8" "precomputed-tables" "schnorr" "sha2" "sha256" "signature" "std" ]; }; - "k256 0.13.1" = rec { + "k256 0.13.3" = rec { crateName = "k256"; - version = "0.13.1"; + version = "0.13.3"; edition = "2021"; - sha256 = "1k0vrlbdy17ifdjix0xhn1m659ma2xdzhgbz24ipdsfq9q07dnya"; + sha256 = "0ysq18pjz040am5llgly90464x7qqq98yxfbcsladq96gsvgjvwm"; authors = [ "RustCrypto Developers" ]; @@ -1669,7 +1705,7 @@ rec { } { name = "ecdsa"; - packageId = "ecdsa 0.16.8"; + packageId = "ecdsa 0.16.9"; rename = "ecdsa-core"; optional = true; usesDefaultFeatures = false; @@ -1677,7 +1713,7 @@ rec { } { name = "elliptic-curve"; - packageId = "elliptic-curve 0.13.6"; + packageId = "elliptic-curve 0.13.8"; usesDefaultFeatures = false; features = [ "hazmat" "sec1" ]; } @@ -1702,7 +1738,7 @@ rec { devDependencies = [ { name = "ecdsa"; - packageId = "ecdsa 0.16.8"; + packageId = "ecdsa 0.16.9"; rename = "ecdsa-core"; usesDefaultFeatures = false; features = [ "dev" ]; @@ -1760,9 +1796,9 @@ rec { }; "libc" = rec { crateName = "libc"; - version = "0.2.149"; + version = "0.2.155"; edition = "2015"; - sha256 = "16z2zqswcbk1qg5yigfyr0d44v0974amdaj564dmv5dpi2y770d0"; + sha256 = "0z44c53z54znna8n322k5iwg80arxxpdzjj5260pxxzc9a58icwp"; authors = [ "The Rust Project Developers" ]; @@ -1829,17 +1865,20 @@ rec { }; "log" = rec { crateName = "log"; - version = "0.4.20"; - edition = "2015"; - sha256 = "13rf7wphnwd61vazpxr7fiycin6cb1g8fmvgqg18i464p0y1drmm"; + version = "0.4.21"; + edition = "2021"; + sha256 = "074hldq1q8rlzq2s2qa8f25hj4s3gpw71w64vdwzjd01a4g8rvch"; authors = [ "The Rust Project Developers" ]; features = { - "kv_unstable" = [ "value-bag" ]; - "kv_unstable_serde" = [ "kv_unstable_std" "value-bag/serde" "serde" ]; - "kv_unstable_std" = [ "std" "kv_unstable" "value-bag/error" ]; - "kv_unstable_sval" = [ "kv_unstable" "value-bag/sval" "sval" "sval_ref" ]; + "kv_serde" = [ "kv_std" "value-bag/serde" "serde" ]; + "kv_std" = [ "std" "kv" "value-bag/error" ]; + "kv_sval" = [ "kv" "value-bag/sval" "sval" "sval_ref" ]; + "kv_unstable" = [ "kv" "value-bag" ]; + "kv_unstable_serde" = [ "kv_serde" "kv_unstable_std" ]; + "kv_unstable_std" = [ "kv_std" "kv_unstable" ]; + "kv_unstable_sval" = [ "kv_sval" "kv_unstable" ]; "serde" = [ "dep:serde" ]; "sval" = [ "dep:sval" ]; "sval_ref" = [ "dep:sval_ref" ]; @@ -1848,9 +1887,9 @@ rec { }; "memchr" = rec { crateName = "memchr"; - version = "2.6.4"; + version = "2.7.2"; edition = "2021"; - sha256 = "0rq1ka8790ns41j147npvxcqcl2anxyngsdimy85ag2api0fwrgn"; + sha256 = "07bcqxb0vx4ji0648ny5xsicjnpma95x1n07v7mi7jrhsz2l11kc"; authors = [ "Andrew Gallant " "bluss" @@ -1864,7 +1903,7 @@ rec { "std" = [ "alloc" ]; "use_std" = [ "std" ]; }; - resolvedDefaultFeatures = [ "alloc" "default" "std" ]; + resolvedDefaultFeatures = [ "alloc" "std" ]; }; "num-bigint-dig" = rec { crateName = "num-bigint-dig"; @@ -1947,9 +1986,9 @@ rec { }; "num-integer" = rec { crateName = "num-integer"; - version = "0.1.45"; - edition = "2015"; - sha256 = "1ncwavvwdmsqzxnn65phv6c6nn72pnv9xhpmjd6a429mzf4k6p92"; + version = "0.1.46"; + edition = "2018"; + sha256 = "13w5g54a9184cqlbsq80rnxw4jj4s0d8wv75jsq5r2lms8gncsbr"; authors = [ "The Rust Project Developers" ]; @@ -1958,26 +1997,20 @@ rec { name = "num-traits"; packageId = "num-traits"; usesDefaultFeatures = false; - } - ]; - buildDependencies = [ - { - name = "autocfg"; - packageId = "autocfg"; + features = [ "i128" ]; } ]; features = { "default" = [ "std" ]; - "i128" = [ "num-traits/i128" ]; "std" = [ "num-traits/std" ]; }; resolvedDefaultFeatures = [ "i128" ]; }; "num-iter" = rec { crateName = "num-iter"; - version = "0.1.43"; - edition = "2015"; - sha256 = "0lp22isvzmmnidbq9n5kbdh8gj0zm3yhxv1ddsn5rp65530fc0vx"; + version = "0.1.45"; + edition = "2018"; + sha256 = "1gzm7vc5g9qsjjl3bqk9rz1h6raxhygbrcpbfl04swlh0i506a8l"; authors = [ "The Rust Project Developers" ]; @@ -1986,11 +2019,13 @@ rec { name = "num-integer"; packageId = "num-integer"; usesDefaultFeatures = false; + features = [ "i128" ]; } { name = "num-traits"; packageId = "num-traits"; usesDefaultFeatures = false; + features = [ "i128" ]; } ]; buildDependencies = [ @@ -2001,15 +2036,14 @@ rec { ]; features = { "default" = [ "std" ]; - "i128" = [ "num-integer/i128" "num-traits/i128" ]; "std" = [ "num-integer/std" "num-traits/std" ]; }; }; "num-traits" = rec { crateName = "num-traits"; - version = "0.2.17"; - edition = "2018"; - sha256 = "0z16bi5zwgfysz6765v3rd6whfbjpihx3mhsn4dg8dzj2c221qrr"; + version = "0.2.19"; + edition = "2021"; + sha256 = "0h984rhdkkqd4ny9cif7y2azl3xdfb7768hb9irhpsch4q3gq787"; authors = [ "The Rust Project Developers" ]; @@ -2034,18 +2068,19 @@ rec { }; "once_cell" = rec { crateName = "once_cell"; - version = "1.18.0"; + version = "1.19.0"; edition = "2021"; - sha256 = "0vapcd5ambwck95wyz3ymlim35jirgnqn9a0qmi19msymv95v2yx"; + sha256 = "14kvw7px5z96dk4dwdm1r9cqhhy2cyj1l5n5b29mynbb8yr15nrz"; authors = [ "Aleksey Kladov " ]; features = { "alloc" = [ "race" ]; "atomic-polyfill" = [ "critical-section" ]; - "critical-section" = [ "dep:critical-section" "dep:atomic-polyfill" ]; + "critical-section" = [ "dep:critical-section" "portable-atomic" ]; "default" = [ "std" ]; "parking_lot" = [ "dep:parking_lot_core" ]; + "portable-atomic" = [ "dep:portable-atomic" ]; "std" = [ "alloc" ]; }; resolvedDefaultFeatures = [ "alloc" "default" "race" "std" ]; @@ -2129,7 +2164,7 @@ rec { dependencies = [ { name = "ecdsa"; - packageId = "ecdsa 0.16.8"; + packageId = "ecdsa 0.16.9"; rename = "ecdsa-core"; optional = true; usesDefaultFeatures = false; @@ -2137,13 +2172,13 @@ rec { } { name = "elliptic-curve"; - packageId = "elliptic-curve 0.13.6"; + packageId = "elliptic-curve 0.13.8"; usesDefaultFeatures = false; features = [ "hazmat" "sec1" ]; } { name = "primeorder"; - packageId = "primeorder 0.13.2"; + packageId = "primeorder 0.13.6"; optional = true; } { @@ -2156,14 +2191,14 @@ rec { devDependencies = [ { name = "ecdsa"; - packageId = "ecdsa 0.16.8"; + packageId = "ecdsa 0.16.9"; rename = "ecdsa-core"; usesDefaultFeatures = false; features = [ "dev" ]; } { name = "primeorder"; - packageId = "primeorder 0.13.2"; + packageId = "primeorder 0.13.6"; features = [ "dev" ]; } ]; @@ -2272,7 +2307,7 @@ rec { dependencies = [ { name = "ecdsa"; - packageId = "ecdsa 0.16.8"; + packageId = "ecdsa 0.16.9"; rename = "ecdsa-core"; optional = true; usesDefaultFeatures = false; @@ -2280,13 +2315,13 @@ rec { } { name = "elliptic-curve"; - packageId = "elliptic-curve 0.13.6"; + packageId = "elliptic-curve 0.13.8"; usesDefaultFeatures = false; features = [ "hazmat" "sec1" ]; } { name = "primeorder"; - packageId = "primeorder 0.13.2"; + packageId = "primeorder 0.13.6"; } { name = "sha2"; @@ -2298,7 +2333,7 @@ rec { devDependencies = [ { name = "ecdsa"; - packageId = "ecdsa 0.16.8"; + packageId = "ecdsa 0.16.9"; rename = "ecdsa-core"; usesDefaultFeatures = false; features = [ "dev" ]; @@ -2420,12 +2455,12 @@ rec { dependencies = [ { name = "der"; - packageId = "der 0.7.8"; + packageId = "der 0.7.9"; features = [ "oid" ]; } { name = "spki"; - packageId = "spki 0.7.2"; + packageId = "spki 0.7.3"; } ]; features = { @@ -2479,9 +2514,9 @@ rec { }; "pkg-config" = rec { crateName = "pkg-config"; - version = "0.3.27"; + version = "0.3.30"; edition = "2015"; - sha256 = "0r39ryh1magcq4cz5g9x88jllsnxnhcqr753islvyk4jp9h2h1r6"; + sha256 = "1v07557dj1sa0aly9c90wsygc0i8xv5vnmyv0g94lpkvj8qb4cfj"; authors = [ "Alex Crichton " ]; @@ -2522,33 +2557,35 @@ rec { "std" = [ "elliptic-curve/std" ]; }; }; - "primeorder 0.13.2" = rec { + "primeorder 0.13.6" = rec { crateName = "primeorder"; - version = "0.13.2"; + version = "0.13.6"; edition = "2021"; - sha256 = "1qqyvzkfx6g30ibc74n3fggkr6rrdi27ifbrq7yfxihf5kwcwbrw"; + sha256 = "1rp16710mxksagcjnxqjjq9r9wf5vf72fs8wxffnvhb6i6hiqgim"; authors = [ "RustCrypto Developers" ]; dependencies = [ { name = "elliptic-curve"; - packageId = "elliptic-curve 0.13.6"; + packageId = "elliptic-curve 0.13.8"; usesDefaultFeatures = false; features = [ "arithmetic" "sec1" ]; } ]; features = { + "alloc" = [ "elliptic-curve/alloc" ]; "serde" = [ "elliptic-curve/serde" "serdect" ]; "serdect" = [ "dep:serdect" ]; - "std" = [ "elliptic-curve/std" ]; + "std" = [ "alloc" "elliptic-curve/std" ]; }; }; "proc-macro2" = rec { crateName = "proc-macro2"; - version = "1.0.69"; + version = "1.0.84"; edition = "2021"; - sha256 = "1nljgyllbm3yr3pa081bf83gxh6l4zvjqzaldw7v4mj9xfgihk0k"; + sha256 = "1mj998115z75c0007glkdr8qj57ibv82h7kg6r8hnc914slwd5pc"; + libName = "proc_macro2"; authors = [ "David Tolnay " "Alex Crichton " @@ -2566,9 +2603,9 @@ rec { }; "quote" = rec { crateName = "quote"; - version = "1.0.33"; + version = "1.0.36"; edition = "2018"; - sha256 = "1biw54hbbr12wdwjac55z1m2x2rylciw83qnjn564a3096jgqrsj"; + sha256 = "19xcmh445bg6simirnnd4fvkmp6v2qiwxh5f6rw4a70h76pnm9qg"; authors = [ "David Tolnay " ]; @@ -2685,9 +2722,9 @@ rec { }; "regex" = rec { crateName = "regex"; - version = "1.10.2"; + version = "1.10.4"; edition = "2021"; - sha256 = "0hxkd814n4irind8im5c9am221ri6bprx49nc7yxv02ykhd9a2rq"; + sha256 = "0k5sb0h2mkwf51ab0gvv3x38jp1q7wgxf63abfbhi0wwvvgxn5y1"; authors = [ "The Rust Project Developers" "Andrew Gallant " @@ -2697,11 +2734,13 @@ rec { name = "aho-corasick"; packageId = "aho-corasick"; optional = true; + usesDefaultFeatures = false; } { name = "memchr"; packageId = "memchr"; optional = true; + usesDefaultFeatures = false; } { name = "regex-automata"; @@ -2741,9 +2780,9 @@ rec { }; "regex-automata" = rec { crateName = "regex-automata"; - version = "0.4.3"; + version = "0.4.6"; edition = "2021"; - sha256 = "0gs8q9yhd3kcg4pr00ag4viqxnh5l7jpyb9fsfr8hzh451w4r02z"; + sha256 = "1spaq7y4im7s56d1gxa2hi4hzf6dwswb1bv8xyavzya7k25kpf46"; authors = [ "The Rust Project Developers" "Andrew Gallant " @@ -2801,9 +2840,9 @@ rec { }; "regex-syntax" = rec { crateName = "regex-syntax"; - version = "0.8.2"; + version = "0.8.3"; edition = "2021"; - sha256 = "17rd2s8xbiyf6lb4aj2nfi44zqlj98g2ays8zzj2vfs743k79360"; + sha256 = "0mhzkm1pkqg6y53xv056qciazlg47pq0czqs94cn302ckvi49bdd"; authors = [ "The Rust Project Developers" "Andrew Gallant " @@ -2972,9 +3011,9 @@ rec { }; "rustc-serialize" = rec { crateName = "rustc-serialize"; - version = "0.3.24"; + version = "0.3.25"; edition = "2015"; - sha256 = "1nkg3vasg7nk80ffkazizgiyv3hb1l9g3d8h17cajbkx538jiwfw"; + sha256 = "00c494bsxjqjvc15h9x2nkgwl6bjdp9bmb9v0xs4ckv0h33lp0zy"; authors = [ "The Rust Project Developers" ]; @@ -2982,9 +3021,9 @@ rec { }; "ryu" = rec { crateName = "ryu"; - version = "1.0.15"; + version = "1.0.18"; edition = "2018"; - sha256 = "0hfphpn1xnpzxwj8qg916ga1lyc33lc03lnf1gb3wwpglj6wrm0s"; + sha256 = "17xx2s8j1lln7iackzd9p0sv546vjq71i779gphjq923vjh5pjzk"; authors = [ "David Tolnay " ]; @@ -3089,7 +3128,7 @@ rec { } { name = "der"; - packageId = "der 0.7.8"; + packageId = "der 0.7.9"; optional = true; features = [ "oid" ]; } @@ -3134,9 +3173,9 @@ rec { }; "serde" = rec { crateName = "serde"; - version = "1.0.190"; + version = "1.0.203"; edition = "2018"; - sha256 = "1xwndn6n8pb8y0vd84sba1nvfdf4x27nkbgnqsi99s0yr8sc7lwi"; + sha256 = "1500ghq198n6py5anvz5qbqagd9h1hq04f4qpsvjzrvix56snlvj"; authors = [ "Erick Tryzelaar " "David Tolnay " @@ -3168,9 +3207,9 @@ rec { }; "serde_derive" = rec { crateName = "serde_derive"; - version = "1.0.190"; + version = "1.0.203"; edition = "2015"; - sha256 = "1qy0697y6rbsqvaq7sgy8bpq1sh4h13xmvsizkbjnp2f76gn1ib7"; + sha256 = "1fmmqmfza3mwxb1v80737dj01gznrh8mhgqgylkndx5npq7bq32h"; procMacro = true; authors = [ "Erick Tryzelaar " @@ -3180,14 +3219,20 @@ rec { { name = "proc-macro2"; packageId = "proc-macro2"; + usesDefaultFeatures = false; + features = [ "proc-macro" ]; } { name = "quote"; packageId = "quote"; + usesDefaultFeatures = false; + features = [ "proc-macro" ]; } { name = "syn"; packageId = "syn"; + usesDefaultFeatures = false; + features = [ "clone-impls" "derive" "parsing" "printing" "proc-macro" ]; } ]; features = { }; @@ -3195,9 +3240,9 @@ rec { }; "serde_json" = rec { crateName = "serde_json"; - version = "1.0.108"; + version = "1.0.117"; edition = "2021"; - sha256 = "0ssj59s7lpzqh1m50kfzlnrip0p0jg9lmhn4098i33a0mhz7w71x"; + sha256 = "1hxziifjlc0kn1cci9d4crmjc7qwnfi20lxwyj9lzca2c7m84la5"; authors = [ "Erick Tryzelaar " "David Tolnay " @@ -3337,9 +3382,9 @@ rec { }; "smallvec" = rec { crateName = "smallvec"; - version = "1.11.1"; + version = "1.13.2"; edition = "2018"; - sha256 = "0nmx8aw3v4jglqdcjv4hhn10d6g52c4bhjlzwf952885is04lawl"; + sha256 = "0rsw5samawl3wsw6glrsb127rx6sh89a8wyikicw6dkdcjd1lpiw"; authors = [ "The Servo Project Developers" ]; @@ -3435,11 +3480,11 @@ rec { }; resolvedDefaultFeatures = [ "alloc" "base64ct" "pem" "std" ]; }; - "spki 0.7.2" = rec { + "spki 0.7.3" = rec { crateName = "spki"; - version = "0.7.2"; + version = "0.7.3"; edition = "2021"; - sha256 = "0jhq00sv4w3psdi6li3vjjmspc6z2d9b1wc1srbljircy1p9j7lx"; + sha256 = "17fj8k5fmx4w9mp27l970clrh5qa7r5sjdvbsln987xhb34dc7nr"; authors = [ "RustCrypto Developers" ]; @@ -3452,7 +3497,7 @@ rec { } { name = "der"; - packageId = "der 0.7.8"; + packageId = "der 0.7.9"; features = [ "oid" ]; } ]; @@ -3483,9 +3528,9 @@ rec { }; "syn" = rec { crateName = "syn"; - version = "2.0.38"; + version = "2.0.66"; edition = "2021"; - sha256 = "12s06bi068scc4fpv2x2bp3lx2vxnk4s0qv3w9hqznrpl6m7jsz9"; + sha256 = "1xfgrprsbz8j31kabvfinb4fyhajlk2q7lxa18fb006yl90kyby4"; authors = [ "David Tolnay " ]; @@ -3508,18 +3553,17 @@ rec { ]; features = { "default" = [ "derive" "parsing" "printing" "clone-impls" "proc-macro" ]; - "printing" = [ "quote" ]; - "proc-macro" = [ "proc-macro2/proc-macro" "quote/proc-macro" ]; - "quote" = [ "dep:quote" ]; + "printing" = [ "dep:quote" ]; + "proc-macro" = [ "proc-macro2/proc-macro" "quote?/proc-macro" ]; "test" = [ "syn-test-suite/all-features" ]; }; - resolvedDefaultFeatures = [ "clone-impls" "default" "derive" "full" "parsing" "printing" "proc-macro" "quote" "visit" ]; + resolvedDefaultFeatures = [ "clone-impls" "default" "derive" "full" "parsing" "printing" "proc-macro" "visit" ]; }; "thiserror" = rec { crateName = "thiserror"; - version = "1.0.50"; + version = "1.0.61"; edition = "2021"; - sha256 = "1ll2sfbrxks8jja161zh1pgm3yssr7aawdmaa2xmcwcsbh7j39zr"; + sha256 = "028prh962l16cmjivwb1g9xalbpqip0305zhq006mg74dc6whin5"; authors = [ "David Tolnay " ]; @@ -3533,10 +3577,11 @@ rec { }; "thiserror-impl" = rec { crateName = "thiserror-impl"; - version = "1.0.50"; + version = "1.0.61"; edition = "2021"; - sha256 = "1f0lmam4765sfnwr4b1n00y14vxh10g0311mkk0adr80pi02wsr6"; + sha256 = "0cvm37hp0kbcyk1xac1z0chpbd9pbn2g456iyid6sah0a113ihs6"; procMacro = true; + libName = "thiserror_impl"; authors = [ "David Tolnay " ]; @@ -3593,9 +3638,9 @@ rec { }; "walkdir" = rec { crateName = "walkdir"; - version = "2.4.0"; + version = "2.5.0"; edition = "2018"; - sha256 = "1vjl9fmfc4v8k9ald23qrpcbyb8dl1ynyq8d516cm537r1yqa7fp"; + sha256 = "0jsy7a710qv8gld5957ybrnc07gavppp963gs32xk4ag8130jy99"; authors = [ "Andrew Gallant " ]; @@ -3627,13 +3672,39 @@ rec { "rustc-dep-of-std" = [ "compiler_builtins" "core" "rustc-std-workspace-alloc" ]; "rustc-std-workspace-alloc" = [ "dep:rustc-std-workspace-alloc" ]; }; + resolvedDefaultFeatures = [ "std" ]; + }; + "wasix" = rec { + crateName = "wasix"; + version = "0.12.21"; + edition = "2018"; + sha256 = "0v9wb03ddbnas75005l2d63bdqy9mclds00b1qbw385wkgpv9yy1"; + authors = [ + "The Cranelift Project Developers" + "john-sharratt" + ]; + dependencies = [ + { + name = "wasi"; + packageId = "wasi"; + usesDefaultFeatures = false; + } + ]; + features = { + "compiler_builtins" = [ "dep:compiler_builtins" ]; + "core" = [ "dep:core" ]; + "default" = [ "std" ]; + "rustc-dep-of-std" = [ "compiler_builtins" "core" "rustc-std-workspace-alloc" "wasi/rustc-dep-of-std" ]; + "rustc-std-workspace-alloc" = [ "dep:rustc-std-workspace-alloc" ]; + "std" = [ "wasi/std" ]; + }; resolvedDefaultFeatures = [ "default" "std" ]; }; "wasm-bindgen" = rec { crateName = "wasm-bindgen"; - version = "0.2.87"; + version = "0.2.92"; edition = "2018"; - sha256 = "0hm3k42gcnrps2jh339h186scx1radqy1w7v1zwb333dncmaf1kp"; + sha256 = "1a4mcw13nsk3fr8fxjzf9kk1wj88xkfsmnm0pjraw01ryqfm7qjb"; authors = [ "The wasm-bindgen Developers" ]; @@ -3662,9 +3733,9 @@ rec { }; "wasm-bindgen-backend" = rec { crateName = "wasm-bindgen-backend"; - version = "0.2.87"; + version = "0.2.92"; edition = "2018"; - sha256 = "1gcsh3bjxhw3cirmin45107pcsnn0ymhkxg6bxg65s8hqp9vdwjy"; + sha256 = "1nj7wxbi49f0rw9d44rjzms26xlw6r76b2mrggx8jfbdjrxphkb1"; authors = [ "The wasm-bindgen Developers" ]; @@ -3706,9 +3777,9 @@ rec { }; "wasm-bindgen-macro" = rec { crateName = "wasm-bindgen-macro"; - version = "0.2.87"; + version = "0.2.92"; edition = "2018"; - sha256 = "07cg0b6zkcxa1yg1n10h62paid59s9zr8yss214bv8w2b7jrbr6y"; + sha256 = "09npa1srjjabd6nfph5yc03jb26sycjlxhy0c2a1pdrpx4yq5y51"; procMacro = true; authors = [ "The wasm-bindgen Developers" @@ -3731,9 +3802,9 @@ rec { }; "wasm-bindgen-macro-support" = rec { crateName = "wasm-bindgen-macro-support"; - version = "0.2.87"; + version = "0.2.92"; edition = "2018"; - sha256 = "0yqc46pr6mlgb9bsnfdnd50qvsqnrz8g5243fnaz0rb7lhc1ns2l"; + sha256 = "1dqv2xs8zcyw4kjgzj84bknp2h76phmsb3n7j6hn396h4ssifkz9"; authors = [ "The wasm-bindgen Developers" ]; @@ -3768,74 +3839,408 @@ rec { }; "wasm-bindgen-shared" = rec { crateName = "wasm-bindgen-shared"; - version = "0.2.87"; + version = "0.2.92"; edition = "2018"; - sha256 = "18bmjwvfyhvlq49nzw6mgiyx4ys350vps4cmx5gvzckh91dd0sna"; + sha256 = "15kyavsrna2cvy30kg03va257fraf9x00ny554vxngvpyaa0q6dg"; authors = [ "The wasm-bindgen Developers" ]; }; - "winapi" = rec { - crateName = "winapi"; - version = "0.3.9"; - edition = "2015"; - sha256 = "06gl025x418lchw1wxj64ycr7gha83m44cjr5sarhynd9xkrm0sw"; + "winapi-util" = rec { + crateName = "winapi-util"; + version = "0.1.8"; + edition = "2021"; + sha256 = "0svcgddd2rw06mj4r76gj655qsa1ikgz3d3gzax96fz7w62c6k2d"; authors = [ - "Peter Atashian " + "Andrew Gallant " ]; dependencies = [ { - name = "winapi-i686-pc-windows-gnu"; - packageId = "winapi-i686-pc-windows-gnu"; - target = { target, features }: (pkgs.rust.lib.toRustTarget stdenv.hostPlatform == "i686-pc-windows-gnu"); + name = "windows-sys"; + packageId = "windows-sys"; + target = { target, features }: (target."windows" or false); + features = [ "Win32_Foundation" "Win32_Storage_FileSystem" "Win32_System_Console" "Win32_System_SystemInformation" ]; } + ]; + + }; + "windows-sys" = rec { + crateName = "windows-sys"; + version = "0.52.0"; + edition = "2021"; + sha256 = "0gd3v4ji88490zgb6b5mq5zgbvwv7zx1ibn8v3x83rwcdbryaar8"; + authors = [ + "Microsoft" + ]; + dependencies = [ { - name = "winapi-x86_64-pc-windows-gnu"; - packageId = "winapi-x86_64-pc-windows-gnu"; - target = { target, features }: (pkgs.rust.lib.toRustTarget stdenv.hostPlatform == "x86_64-pc-windows-gnu"); + name = "windows-targets"; + packageId = "windows-targets"; } ]; features = { - "debug" = [ "impl-debug" ]; + "Wdk_Foundation" = [ "Wdk" ]; + "Wdk_Graphics" = [ "Wdk" ]; + "Wdk_Graphics_Direct3D" = [ "Wdk_Graphics" ]; + "Wdk_Storage" = [ "Wdk" ]; + "Wdk_Storage_FileSystem" = [ "Wdk_Storage" ]; + "Wdk_Storage_FileSystem_Minifilters" = [ "Wdk_Storage_FileSystem" ]; + "Wdk_System" = [ "Wdk" ]; + "Wdk_System_IO" = [ "Wdk_System" ]; + "Wdk_System_OfflineRegistry" = [ "Wdk_System" ]; + "Wdk_System_Registry" = [ "Wdk_System" ]; + "Wdk_System_SystemInformation" = [ "Wdk_System" ]; + "Wdk_System_SystemServices" = [ "Wdk_System" ]; + "Wdk_System_Threading" = [ "Wdk_System" ]; + "Win32_Data" = [ "Win32" ]; + "Win32_Data_HtmlHelp" = [ "Win32_Data" ]; + "Win32_Data_RightsManagement" = [ "Win32_Data" ]; + "Win32_Devices" = [ "Win32" ]; + "Win32_Devices_AllJoyn" = [ "Win32_Devices" ]; + "Win32_Devices_BiometricFramework" = [ "Win32_Devices" ]; + "Win32_Devices_Bluetooth" = [ "Win32_Devices" ]; + "Win32_Devices_Communication" = [ "Win32_Devices" ]; + "Win32_Devices_DeviceAndDriverInstallation" = [ "Win32_Devices" ]; + "Win32_Devices_DeviceQuery" = [ "Win32_Devices" ]; + "Win32_Devices_Display" = [ "Win32_Devices" ]; + "Win32_Devices_Enumeration" = [ "Win32_Devices" ]; + "Win32_Devices_Enumeration_Pnp" = [ "Win32_Devices_Enumeration" ]; + "Win32_Devices_Fax" = [ "Win32_Devices" ]; + "Win32_Devices_HumanInterfaceDevice" = [ "Win32_Devices" ]; + "Win32_Devices_PortableDevices" = [ "Win32_Devices" ]; + "Win32_Devices_Properties" = [ "Win32_Devices" ]; + "Win32_Devices_Pwm" = [ "Win32_Devices" ]; + "Win32_Devices_Sensors" = [ "Win32_Devices" ]; + "Win32_Devices_SerialCommunication" = [ "Win32_Devices" ]; + "Win32_Devices_Tapi" = [ "Win32_Devices" ]; + "Win32_Devices_Usb" = [ "Win32_Devices" ]; + "Win32_Devices_WebServicesOnDevices" = [ "Win32_Devices" ]; + "Win32_Foundation" = [ "Win32" ]; + "Win32_Gaming" = [ "Win32" ]; + "Win32_Globalization" = [ "Win32" ]; + "Win32_Graphics" = [ "Win32" ]; + "Win32_Graphics_Dwm" = [ "Win32_Graphics" ]; + "Win32_Graphics_Gdi" = [ "Win32_Graphics" ]; + "Win32_Graphics_GdiPlus" = [ "Win32_Graphics" ]; + "Win32_Graphics_Hlsl" = [ "Win32_Graphics" ]; + "Win32_Graphics_OpenGL" = [ "Win32_Graphics" ]; + "Win32_Graphics_Printing" = [ "Win32_Graphics" ]; + "Win32_Graphics_Printing_PrintTicket" = [ "Win32_Graphics_Printing" ]; + "Win32_Management" = [ "Win32" ]; + "Win32_Management_MobileDeviceManagementRegistration" = [ "Win32_Management" ]; + "Win32_Media" = [ "Win32" ]; + "Win32_Media_Audio" = [ "Win32_Media" ]; + "Win32_Media_DxMediaObjects" = [ "Win32_Media" ]; + "Win32_Media_KernelStreaming" = [ "Win32_Media" ]; + "Win32_Media_Multimedia" = [ "Win32_Media" ]; + "Win32_Media_Streaming" = [ "Win32_Media" ]; + "Win32_Media_WindowsMediaFormat" = [ "Win32_Media" ]; + "Win32_NetworkManagement" = [ "Win32" ]; + "Win32_NetworkManagement_Dhcp" = [ "Win32_NetworkManagement" ]; + "Win32_NetworkManagement_Dns" = [ "Win32_NetworkManagement" ]; + "Win32_NetworkManagement_InternetConnectionWizard" = [ "Win32_NetworkManagement" ]; + "Win32_NetworkManagement_IpHelper" = [ "Win32_NetworkManagement" ]; + "Win32_NetworkManagement_Multicast" = [ "Win32_NetworkManagement" ]; + "Win32_NetworkManagement_Ndis" = [ "Win32_NetworkManagement" ]; + "Win32_NetworkManagement_NetBios" = [ "Win32_NetworkManagement" ]; + "Win32_NetworkManagement_NetManagement" = [ "Win32_NetworkManagement" ]; + "Win32_NetworkManagement_NetShell" = [ "Win32_NetworkManagement" ]; + "Win32_NetworkManagement_NetworkDiagnosticsFramework" = [ "Win32_NetworkManagement" ]; + "Win32_NetworkManagement_P2P" = [ "Win32_NetworkManagement" ]; + "Win32_NetworkManagement_QoS" = [ "Win32_NetworkManagement" ]; + "Win32_NetworkManagement_Rras" = [ "Win32_NetworkManagement" ]; + "Win32_NetworkManagement_Snmp" = [ "Win32_NetworkManagement" ]; + "Win32_NetworkManagement_WNet" = [ "Win32_NetworkManagement" ]; + "Win32_NetworkManagement_WebDav" = [ "Win32_NetworkManagement" ]; + "Win32_NetworkManagement_WiFi" = [ "Win32_NetworkManagement" ]; + "Win32_NetworkManagement_WindowsConnectionManager" = [ "Win32_NetworkManagement" ]; + "Win32_NetworkManagement_WindowsFilteringPlatform" = [ "Win32_NetworkManagement" ]; + "Win32_NetworkManagement_WindowsFirewall" = [ "Win32_NetworkManagement" ]; + "Win32_NetworkManagement_WindowsNetworkVirtualization" = [ "Win32_NetworkManagement" ]; + "Win32_Networking" = [ "Win32" ]; + "Win32_Networking_ActiveDirectory" = [ "Win32_Networking" ]; + "Win32_Networking_Clustering" = [ "Win32_Networking" ]; + "Win32_Networking_HttpServer" = [ "Win32_Networking" ]; + "Win32_Networking_Ldap" = [ "Win32_Networking" ]; + "Win32_Networking_WebSocket" = [ "Win32_Networking" ]; + "Win32_Networking_WinHttp" = [ "Win32_Networking" ]; + "Win32_Networking_WinInet" = [ "Win32_Networking" ]; + "Win32_Networking_WinSock" = [ "Win32_Networking" ]; + "Win32_Networking_WindowsWebServices" = [ "Win32_Networking" ]; + "Win32_Security" = [ "Win32" ]; + "Win32_Security_AppLocker" = [ "Win32_Security" ]; + "Win32_Security_Authentication" = [ "Win32_Security" ]; + "Win32_Security_Authentication_Identity" = [ "Win32_Security_Authentication" ]; + "Win32_Security_Authorization" = [ "Win32_Security" ]; + "Win32_Security_Credentials" = [ "Win32_Security" ]; + "Win32_Security_Cryptography" = [ "Win32_Security" ]; + "Win32_Security_Cryptography_Catalog" = [ "Win32_Security_Cryptography" ]; + "Win32_Security_Cryptography_Certificates" = [ "Win32_Security_Cryptography" ]; + "Win32_Security_Cryptography_Sip" = [ "Win32_Security_Cryptography" ]; + "Win32_Security_Cryptography_UI" = [ "Win32_Security_Cryptography" ]; + "Win32_Security_DiagnosticDataQuery" = [ "Win32_Security" ]; + "Win32_Security_DirectoryServices" = [ "Win32_Security" ]; + "Win32_Security_EnterpriseData" = [ "Win32_Security" ]; + "Win32_Security_ExtensibleAuthenticationProtocol" = [ "Win32_Security" ]; + "Win32_Security_Isolation" = [ "Win32_Security" ]; + "Win32_Security_LicenseProtection" = [ "Win32_Security" ]; + "Win32_Security_NetworkAccessProtection" = [ "Win32_Security" ]; + "Win32_Security_WinTrust" = [ "Win32_Security" ]; + "Win32_Security_WinWlx" = [ "Win32_Security" ]; + "Win32_Storage" = [ "Win32" ]; + "Win32_Storage_Cabinets" = [ "Win32_Storage" ]; + "Win32_Storage_CloudFilters" = [ "Win32_Storage" ]; + "Win32_Storage_Compression" = [ "Win32_Storage" ]; + "Win32_Storage_DistributedFileSystem" = [ "Win32_Storage" ]; + "Win32_Storage_FileHistory" = [ "Win32_Storage" ]; + "Win32_Storage_FileSystem" = [ "Win32_Storage" ]; + "Win32_Storage_Imapi" = [ "Win32_Storage" ]; + "Win32_Storage_IndexServer" = [ "Win32_Storage" ]; + "Win32_Storage_InstallableFileSystems" = [ "Win32_Storage" ]; + "Win32_Storage_IscsiDisc" = [ "Win32_Storage" ]; + "Win32_Storage_Jet" = [ "Win32_Storage" ]; + "Win32_Storage_Nvme" = [ "Win32_Storage" ]; + "Win32_Storage_OfflineFiles" = [ "Win32_Storage" ]; + "Win32_Storage_OperationRecorder" = [ "Win32_Storage" ]; + "Win32_Storage_Packaging" = [ "Win32_Storage" ]; + "Win32_Storage_Packaging_Appx" = [ "Win32_Storage_Packaging" ]; + "Win32_Storage_ProjectedFileSystem" = [ "Win32_Storage" ]; + "Win32_Storage_StructuredStorage" = [ "Win32_Storage" ]; + "Win32_Storage_Vhd" = [ "Win32_Storage" ]; + "Win32_Storage_Xps" = [ "Win32_Storage" ]; + "Win32_System" = [ "Win32" ]; + "Win32_System_AddressBook" = [ "Win32_System" ]; + "Win32_System_Antimalware" = [ "Win32_System" ]; + "Win32_System_ApplicationInstallationAndServicing" = [ "Win32_System" ]; + "Win32_System_ApplicationVerifier" = [ "Win32_System" ]; + "Win32_System_ClrHosting" = [ "Win32_System" ]; + "Win32_System_Com" = [ "Win32_System" ]; + "Win32_System_Com_Marshal" = [ "Win32_System_Com" ]; + "Win32_System_Com_StructuredStorage" = [ "Win32_System_Com" ]; + "Win32_System_Com_Urlmon" = [ "Win32_System_Com" ]; + "Win32_System_ComponentServices" = [ "Win32_System" ]; + "Win32_System_Console" = [ "Win32_System" ]; + "Win32_System_CorrelationVector" = [ "Win32_System" ]; + "Win32_System_DataExchange" = [ "Win32_System" ]; + "Win32_System_DeploymentServices" = [ "Win32_System" ]; + "Win32_System_DeveloperLicensing" = [ "Win32_System" ]; + "Win32_System_Diagnostics" = [ "Win32_System" ]; + "Win32_System_Diagnostics_Ceip" = [ "Win32_System_Diagnostics" ]; + "Win32_System_Diagnostics_Debug" = [ "Win32_System_Diagnostics" ]; + "Win32_System_Diagnostics_Debug_Extensions" = [ "Win32_System_Diagnostics_Debug" ]; + "Win32_System_Diagnostics_Etw" = [ "Win32_System_Diagnostics" ]; + "Win32_System_Diagnostics_ProcessSnapshotting" = [ "Win32_System_Diagnostics" ]; + "Win32_System_Diagnostics_ToolHelp" = [ "Win32_System_Diagnostics" ]; + "Win32_System_DistributedTransactionCoordinator" = [ "Win32_System" ]; + "Win32_System_Environment" = [ "Win32_System" ]; + "Win32_System_ErrorReporting" = [ "Win32_System" ]; + "Win32_System_EventCollector" = [ "Win32_System" ]; + "Win32_System_EventLog" = [ "Win32_System" ]; + "Win32_System_EventNotificationService" = [ "Win32_System" ]; + "Win32_System_GroupPolicy" = [ "Win32_System" ]; + "Win32_System_HostCompute" = [ "Win32_System" ]; + "Win32_System_HostComputeNetwork" = [ "Win32_System" ]; + "Win32_System_HostComputeSystem" = [ "Win32_System" ]; + "Win32_System_Hypervisor" = [ "Win32_System" ]; + "Win32_System_IO" = [ "Win32_System" ]; + "Win32_System_Iis" = [ "Win32_System" ]; + "Win32_System_Ioctl" = [ "Win32_System" ]; + "Win32_System_JobObjects" = [ "Win32_System" ]; + "Win32_System_Js" = [ "Win32_System" ]; + "Win32_System_Kernel" = [ "Win32_System" ]; + "Win32_System_LibraryLoader" = [ "Win32_System" ]; + "Win32_System_Mailslots" = [ "Win32_System" ]; + "Win32_System_Mapi" = [ "Win32_System" ]; + "Win32_System_Memory" = [ "Win32_System" ]; + "Win32_System_Memory_NonVolatile" = [ "Win32_System_Memory" ]; + "Win32_System_MessageQueuing" = [ "Win32_System" ]; + "Win32_System_MixedReality" = [ "Win32_System" ]; + "Win32_System_Ole" = [ "Win32_System" ]; + "Win32_System_PasswordManagement" = [ "Win32_System" ]; + "Win32_System_Performance" = [ "Win32_System" ]; + "Win32_System_Performance_HardwareCounterProfiling" = [ "Win32_System_Performance" ]; + "Win32_System_Pipes" = [ "Win32_System" ]; + "Win32_System_Power" = [ "Win32_System" ]; + "Win32_System_ProcessStatus" = [ "Win32_System" ]; + "Win32_System_Recovery" = [ "Win32_System" ]; + "Win32_System_Registry" = [ "Win32_System" ]; + "Win32_System_RemoteDesktop" = [ "Win32_System" ]; + "Win32_System_RemoteManagement" = [ "Win32_System" ]; + "Win32_System_RestartManager" = [ "Win32_System" ]; + "Win32_System_Restore" = [ "Win32_System" ]; + "Win32_System_Rpc" = [ "Win32_System" ]; + "Win32_System_Search" = [ "Win32_System" ]; + "Win32_System_Search_Common" = [ "Win32_System_Search" ]; + "Win32_System_SecurityCenter" = [ "Win32_System" ]; + "Win32_System_Services" = [ "Win32_System" ]; + "Win32_System_SetupAndMigration" = [ "Win32_System" ]; + "Win32_System_Shutdown" = [ "Win32_System" ]; + "Win32_System_StationsAndDesktops" = [ "Win32_System" ]; + "Win32_System_SubsystemForLinux" = [ "Win32_System" ]; + "Win32_System_SystemInformation" = [ "Win32_System" ]; + "Win32_System_SystemServices" = [ "Win32_System" ]; + "Win32_System_Threading" = [ "Win32_System" ]; + "Win32_System_Time" = [ "Win32_System" ]; + "Win32_System_TpmBaseServices" = [ "Win32_System" ]; + "Win32_System_UserAccessLogging" = [ "Win32_System" ]; + "Win32_System_Variant" = [ "Win32_System" ]; + "Win32_System_VirtualDosMachines" = [ "Win32_System" ]; + "Win32_System_WindowsProgramming" = [ "Win32_System" ]; + "Win32_System_Wmi" = [ "Win32_System" ]; + "Win32_UI" = [ "Win32" ]; + "Win32_UI_Accessibility" = [ "Win32_UI" ]; + "Win32_UI_ColorSystem" = [ "Win32_UI" ]; + "Win32_UI_Controls" = [ "Win32_UI" ]; + "Win32_UI_Controls_Dialogs" = [ "Win32_UI_Controls" ]; + "Win32_UI_HiDpi" = [ "Win32_UI" ]; + "Win32_UI_Input" = [ "Win32_UI" ]; + "Win32_UI_Input_Ime" = [ "Win32_UI_Input" ]; + "Win32_UI_Input_KeyboardAndMouse" = [ "Win32_UI_Input" ]; + "Win32_UI_Input_Pointer" = [ "Win32_UI_Input" ]; + "Win32_UI_Input_Touch" = [ "Win32_UI_Input" ]; + "Win32_UI_Input_XboxController" = [ "Win32_UI_Input" ]; + "Win32_UI_InteractionContext" = [ "Win32_UI" ]; + "Win32_UI_Magnification" = [ "Win32_UI" ]; + "Win32_UI_Shell" = [ "Win32_UI" ]; + "Win32_UI_Shell_PropertiesSystem" = [ "Win32_UI_Shell" ]; + "Win32_UI_TabletPC" = [ "Win32_UI" ]; + "Win32_UI_TextServices" = [ "Win32_UI" ]; + "Win32_UI_WindowsAndMessaging" = [ "Win32_UI" ]; + "Win32_Web" = [ "Win32" ]; + "Win32_Web_InternetExplorer" = [ "Win32_Web" ]; }; - resolvedDefaultFeatures = [ "consoleapi" "errhandlingapi" "fileapi" "minwindef" "processenv" "std" "sysinfoapi" "winbase" "wincon" "winerror" "winnt" ]; + resolvedDefaultFeatures = [ "Win32" "Win32_Foundation" "Win32_Storage" "Win32_Storage_FileSystem" "Win32_System" "Win32_System_Console" "Win32_System_SystemInformation" "default" ]; }; - "winapi-i686-pc-windows-gnu" = rec { - crateName = "winapi-i686-pc-windows-gnu"; - version = "0.4.0"; - edition = "2015"; - sha256 = "1dmpa6mvcvzz16zg6d5vrfy4bxgg541wxrcip7cnshi06v38ffxc"; + "windows-targets" = rec { + crateName = "windows-targets"; + version = "0.52.5"; + edition = "2021"; + sha256 = "1sz7jrnkygmmlj1ia8fk85wbyil450kq5qkh5qh9sh2rcnj161vg"; + authors = [ + "Microsoft" + ]; + dependencies = [ + { + name = "windows_aarch64_gnullvm"; + packageId = "windows_aarch64_gnullvm"; + target = { target, features }: (pkgs.rust.lib.toRustTarget stdenv.hostPlatform == "aarch64-pc-windows-gnullvm"); + } + { + name = "windows_aarch64_msvc"; + packageId = "windows_aarch64_msvc"; + target = { target, features }: (("aarch64" == target."arch") && ("msvc" == target."env") && (!(target."windows_raw_dylib" or false))); + } + { + name = "windows_i686_gnu"; + packageId = "windows_i686_gnu"; + target = { target, features }: (("x86" == target."arch") && ("gnu" == target."env") && (!("llvm" == target."abi")) && (!(target."windows_raw_dylib" or false))); + } + { + name = "windows_i686_gnullvm"; + packageId = "windows_i686_gnullvm"; + target = { target, features }: (pkgs.rust.lib.toRustTarget stdenv.hostPlatform == "i686-pc-windows-gnullvm"); + } + { + name = "windows_i686_msvc"; + packageId = "windows_i686_msvc"; + target = { target, features }: (("x86" == target."arch") && ("msvc" == target."env") && (!(target."windows_raw_dylib" or false))); + } + { + name = "windows_x86_64_gnu"; + packageId = "windows_x86_64_gnu"; + target = { target, features }: (("x86_64" == target."arch") && ("gnu" == target."env") && (!("llvm" == target."abi")) && (!(target."windows_raw_dylib" or false))); + } + { + name = "windows_x86_64_gnullvm"; + packageId = "windows_x86_64_gnullvm"; + target = { target, features }: (pkgs.rust.lib.toRustTarget stdenv.hostPlatform == "x86_64-pc-windows-gnullvm"); + } + { + name = "windows_x86_64_msvc"; + packageId = "windows_x86_64_msvc"; + target = { target, features }: ((("x86_64" == target."arch") || ("arm64ec" == target."arch")) && ("msvc" == target."env") && (!(target."windows_raw_dylib" or false))); + } + ]; + + }; + "windows_aarch64_gnullvm" = rec { + crateName = "windows_aarch64_gnullvm"; + version = "0.52.5"; + edition = "2021"; + sha256 = "0qrjimbj67nnyn7zqy15mzzmqg0mn5gsr2yciqjxm3cb3vbyx23h"; authors = [ - "Peter Atashian " + "Microsoft" ]; }; - "winapi-util" = rec { - crateName = "winapi-util"; - version = "0.1.6"; + "windows_aarch64_msvc" = rec { + crateName = "windows_aarch64_msvc"; + version = "0.52.5"; edition = "2021"; - sha256 = "15i5lm39wd44004i9d5qspry2cynkrpvwzghr6s2c3dsk28nz7pj"; + sha256 = "1dmga8kqlmln2ibckk6mxc9n59vdg8ziqa2zr8awcl720hazv1cr"; authors = [ - "Andrew Gallant " + "Microsoft" ]; - dependencies = [ - { - name = "winapi"; - packageId = "winapi"; - target = { target, features }: (target."windows" or false); - features = [ "std" "consoleapi" "errhandlingapi" "fileapi" "minwindef" "processenv" "sysinfoapi" "winbase" "wincon" "winerror" "winnt" ]; - } + + }; + "windows_i686_gnu" = rec { + crateName = "windows_i686_gnu"; + version = "0.52.5"; + edition = "2021"; + sha256 = "0w4np3l6qwlra9s2xpflqrs60qk1pz6ahhn91rr74lvdy4y0gfl8"; + authors = [ + "Microsoft" ]; }; - "winapi-x86_64-pc-windows-gnu" = rec { - crateName = "winapi-x86_64-pc-windows-gnu"; - version = "0.4.0"; - edition = "2015"; - sha256 = "0gqq64czqb64kskjryj8isp62m2sgvx25yyj3kpc2myh85w24bki"; + "windows_i686_gnullvm" = rec { + crateName = "windows_i686_gnullvm"; + version = "0.52.5"; + edition = "2021"; + sha256 = "1s9f4gff0cixd86mw3n63rpmsm4pmr4ffndl6s7qa2h35492dx47"; + authors = [ + "Microsoft" + ]; + + }; + "windows_i686_msvc" = rec { + crateName = "windows_i686_msvc"; + version = "0.52.5"; + edition = "2021"; + sha256 = "1gw7fklxywgpnwbwg43alb4hm0qjmx72hqrlwy5nanrxs7rjng6v"; + authors = [ + "Microsoft" + ]; + + }; + "windows_x86_64_gnu" = rec { + crateName = "windows_x86_64_gnu"; + version = "0.52.5"; + edition = "2021"; + sha256 = "1n8p2mcf3lw6300k77a0knksssmgwb9hynl793mhkzyydgvlchjf"; authors = [ - "Peter Atashian " + "Microsoft" + ]; + + }; + "windows_x86_64_gnullvm" = rec { + crateName = "windows_x86_64_gnullvm"; + version = "0.52.5"; + edition = "2021"; + sha256 = "15n56jrh4s5bz66zimavr1rmcaw6wa306myrvmbc6rydhbj9h8l5"; + authors = [ + "Microsoft" + ]; + + }; + "windows_x86_64_msvc" = rec { + crateName = "windows_x86_64_msvc"; + version = "0.52.5"; + edition = "2021"; + sha256 = "1w1bn24ap8dp9i85s8mlg8cim2bl2368bd6qyvm0xzqvzmdpxi5y"; + authors = [ + "Microsoft" ]; }; @@ -3929,9 +4334,9 @@ rec { }; "zeroize" = rec { crateName = "zeroize"; - version = "1.6.0"; + version = "1.8.1"; edition = "2021"; - sha256 = "1ndar43r58zbmasjhrhgas168vxb4i0rwbkcnszhjybwpbqmc29a"; + sha256 = "1pjdrmjwmszpxfd7r860jx54cyk94qk59x13sc307cvr5256glyf"; authors = [ "The RustCrypto Project Developers" ]; @@ -4043,7 +4448,6 @@ rec { ( _: { buildTests = true; - release = false; } ); # If the user hasn't set any pre/post commands, we don't want to @@ -4068,7 +4472,7 @@ rec { # recreate a file hierarchy as when running tests with cargo # the source for test data - ${pkgs.buildPackages.xorg.lndir}/bin/lndir ${crate.src} + ${pkgs.xorg.lndir}/bin/lndir ${crate.src} # build outputs testRoot=target/debug @@ -4098,12 +4502,10 @@ rec { passthru = (crate.passthru or { }) // { inherit test; }; - } - (lib.optionalString (stdenv.buildPlatform.canExecute stdenv.hostPlatform) '' - echo tested by ${test} - '' + '' - ${lib.concatMapStringsSep "\n" (output: "ln -s ${crate.${output}} ${"$"}${output}") crate.outputs} - ''); + } '' + echo tested by ${test} + ${lib.concatMapStringsSep "\n" (output: "ln -s ${crate.${output}} ${"$"}${output}") crate.outputs} + ''; /* A restricted overridable version of builtRustCratesWithFeatures. */ buildRustCrateWithFeatures = diff --git a/libs/libzauth/libzauth-c/crate-hashes.json b/libs/libzauth/libzauth-c/crate-hashes.json index 35f3b6ec1e4..e6d8e90ef5a 100644 --- a/libs/libzauth/libzauth-c/crate-hashes.json +++ b/libs/libzauth/libzauth-c/crate-hashes.json @@ -1,4 +1,127 @@ { - "jwt-simple 0.11.3 (git+https://github.com/wireapp/rust-jwt-simple?rev=15a69f82288d68b74a75c1364e5d4bf681f1c07b#15a69f82288d68b74a75c1364e5d4bf681f1c07b)": "1ms7bym5j3gvn10gdbacai7v5dsdw8cf747py7igg5almk105n0z", - "jwt-simple 0.11.4 (git+https://github.com/wireapp/rust-jwt-simple?rev=5a35177ae37c06d65225df4ba2c2b065917748c5#5a35177ae37c06d65225df4ba2c2b065917748c5)": "1fkv1w82dy681qbw9wwja2dapgg1m8d01j5i2zxn1vccpsy89cnc" + "git+https://github.com/wireapp/rust-jwt-simple?rev=15a69f82288d68b74a75c1364e5d4bf681f1c07b#jwt-simple@0.11.3": "1ms7bym5j3gvn10gdbacai7v5dsdw8cf747py7igg5almk105n0z", + "git+https://github.com/wireapp/rust-jwt-simple?rev=5a35177ae37c06d65225df4ba2c2b065917748c5#jwt-simple@0.11.4": "1fkv1w82dy681qbw9wwja2dapgg1m8d01j5i2zxn1vccpsy89cnc", + "registry+https://github.com/rust-lang/crates.io-index#aho-corasick@1.1.3": "05mrpkvdgp5d20y2p989f187ry9diliijgwrs254fs9s1m1x6q4f", + "registry+https://github.com/rust-lang/crates.io-index#anyhow@1.0.86": "1nk301x8qhpdaks6a9zvcp7yakjqnczjmqndbg7vk4494d3d1ldk", + "registry+https://github.com/rust-lang/crates.io-index#asexp@0.3.2": "0li6h191ppfyrsv6iwppbaxsmcbpc3sb2b8wgwq4g2bmrrhqfdjy", + "registry+https://github.com/rust-lang/crates.io-index#autocfg@1.3.0": "1c3njkfzpil03k92q0mij5y1pkhhfr4j3bf0h53bgl2vs85lsjqc", + "registry+https://github.com/rust-lang/crates.io-index#base16ct@0.1.1": "1klccxr7igf73wpi0x3asjd8n0xjg0v6a7vxgvfk5ybvgh1hd6il", + "registry+https://github.com/rust-lang/crates.io-index#base16ct@0.2.0": "1kylrjhdzk7qpknrvlphw8ywdnvvg39dizw9622w3wk5xba04zsc", + "registry+https://github.com/rust-lang/crates.io-index#base64@0.21.7": "0rw52yvsk75kar9wgqfwgb414kvil1gn7mqkrhn9zf1537mpsacx", + "registry+https://github.com/rust-lang/crates.io-index#base64ct@1.6.0": "0nvdba4jb8aikv60az40x2w1y96sjdq8z3yp09rwzmkhiwv1lg4c", + "registry+https://github.com/rust-lang/crates.io-index#binstring@0.1.1": "11bsghizyz2xwxmqvsj7hlxs6qp180kl2vr0n4n7484k7nbn03by", + "registry+https://github.com/rust-lang/crates.io-index#block-buffer@0.10.4": "0w9sa2ypmrsqqvc20nhwr75wbb5cjr4kkyhpjm1z1lv2kdicfy1h", + "registry+https://github.com/rust-lang/crates.io-index#bumpalo@3.16.0": "0b015qb4knwanbdlp1x48pkb4pm57b8gidbhhhxr900q2wb6fabr", + "registry+https://github.com/rust-lang/crates.io-index#byteorder@1.5.0": "0jzncxyf404mwqdbspihyzpkndfgda450l0893pz5xj685cg5l0z", + "registry+https://github.com/rust-lang/crates.io-index#cc@1.0.98": "0gzhij74hblfkzwwyysdc8crfd6fr0m226vzmijmwwhdakkp1hj1", + "registry+https://github.com/rust-lang/crates.io-index#cfg-if@1.0.0": "1za0vb97n4brpzpv8lsbnzmq5r8f2b0cpqqr0sy8h5bn751xxwds", + "registry+https://github.com/rust-lang/crates.io-index#coarsetime@0.1.34": "0pby1xsrzcxj0yq911hzr38bchgm80iwyg5y2h0rddqvy2f87cqk", + "registry+https://github.com/rust-lang/crates.io-index#const-oid@0.9.6": "1y0jnqaq7p2wvspnx7qj76m7hjcqpz73qzvr9l2p9n2s51vr6if2", + "registry+https://github.com/rust-lang/crates.io-index#cpufeatures@0.2.12": "012m7rrak4girqlii3jnqwrr73gv1i980q4wra5yyyhvzwk5xzjk", + "registry+https://github.com/rust-lang/crates.io-index#crypto-bigint@0.4.9": "1vqprgj0aj1340w186zyspi58397ih78jsc0iydvhs6zrlilnazg", + "registry+https://github.com/rust-lang/crates.io-index#crypto-bigint@0.5.5": "0xmbdff3g6ii5sbxjxc31xfkv9lrmyril4arh3dzckd4gjsjzj8d", + "registry+https://github.com/rust-lang/crates.io-index#crypto-common@0.1.6": "1cvby95a6xg7kxdz5ln3rl9xh66nz66w46mm3g56ri1z5x815yqv", + "registry+https://github.com/rust-lang/crates.io-index#ct-codecs@1.1.1": "1pvmrkk95jadmhhd5mn88mq2dfnq0yng8mk3pfd5l6dq0i2fpdzk", + "registry+https://github.com/rust-lang/crates.io-index#der@0.6.1": "1pnl3y52m1s6srxpfrfbazf6qilzq8fgksk5dv79nxaybjk6g97i", + "registry+https://github.com/rust-lang/crates.io-index#der@0.7.9": "1h4vzjfa1lczxdf8avfj9qlwh1qianqlxdy1g5rn762qnvkzhnzm", + "registry+https://github.com/rust-lang/crates.io-index#digest@0.10.7": "14p2n6ih29x81akj097lvz7wi9b6b9hvls0lwrv7b6xwyy0s5ncy", + "registry+https://github.com/rust-lang/crates.io-index#ecdsa@0.15.1": "0zk3nz2qlczayd8w7zp3nh1skxh5nvrk1l16m62l3msab50l310j", + "registry+https://github.com/rust-lang/crates.io-index#ecdsa@0.16.9": "1jhb0bcbkaz4001sdmfyv8ajrv8a1cg7z7aa5myrd4jjbhmz69zf", + "registry+https://github.com/rust-lang/crates.io-index#ed25519-compact@2.1.1": "1431kxw67xkk5y5kamfdjxnqbzqy5y4p032syi3wva5y8h7ldcz9", + "registry+https://github.com/rust-lang/crates.io-index#ed25519@1.5.3": "1rzydm5wd8szkddx3g55w4vm86y1ika8qp8qwckada5vf1fg7kwi", + "registry+https://github.com/rust-lang/crates.io-index#elliptic-curve@0.12.3": "1lwi108mh6drw5nzqzlz7ighdba5qxdg5vmwwnw1j2ihnn58ifz7", + "registry+https://github.com/rust-lang/crates.io-index#elliptic-curve@0.13.8": "0ixx4brgnzi61z29r3g1606nh2za88hzyz8c5r3p6ydzhqq09rmm", + "registry+https://github.com/rust-lang/crates.io-index#ff@0.12.1": "0q3imz4m3dj2cy182i20wa8kbclgj13ddfngqb2miicc6cjzq4yh", + "registry+https://github.com/rust-lang/crates.io-index#ff@0.13.0": "0jcl8yhcs5kbfxfpnrhpkkvnk7s666vly6sgawg3nri9nx215m6y", + "registry+https://github.com/rust-lang/crates.io-index#generic-array@0.14.7": "16lyyrzrljfq424c3n8kfwkqihlimmsg5nhshbbp48np3yjrqr45", + "registry+https://github.com/rust-lang/crates.io-index#getrandom@0.2.15": "1mzlnrb3dgyd1fb84gvw10pyr8wdqdl4ry4sr64i1s8an66pqmn4", + "registry+https://github.com/rust-lang/crates.io-index#group@0.12.1": "1ixspxqdpq0hxg0hd9s6rngrp6rll21v4jjnr7ar1lzvdhxgpysx", + "registry+https://github.com/rust-lang/crates.io-index#group@0.13.0": "0qqs2p5vqnv3zvq9mfjkmw3qlvgqb0c3cm6p33srkh7pc9sfzygh", + "registry+https://github.com/rust-lang/crates.io-index#hkdf@0.12.4": "1xxxzcarz151p1b858yn5skmhyrvn8fs4ivx5km3i1kjmnr8wpvv", + "registry+https://github.com/rust-lang/crates.io-index#hmac-sha1-compact@1.1.4": "19w4iiwrprcnvq3k2gkv6xm9b11alda4w9l7vvya6bvkxh2x9yfz", + "registry+https://github.com/rust-lang/crates.io-index#hmac-sha256@1.1.7": "0dapmabsj2mvblwjy64h518frj1cvk468kr5awayr3q172dyd21n", + "registry+https://github.com/rust-lang/crates.io-index#hmac-sha512@1.1.5": "12pp9qdf0f62lgwcb8h1xnvlb1pmkgqgjf5rzaiqkrdsar31zkp4", + "registry+https://github.com/rust-lang/crates.io-index#hmac@0.12.1": "0pmbr069sfg76z7wsssfk5ddcqd9ncp79fyz6zcm6yn115yc6jbc", + "registry+https://github.com/rust-lang/crates.io-index#itoa@1.0.11": "0nv9cqjwzr3q58qz84dcz63ggc54yhf1yqar1m858m1kfd4g3wa9", + "registry+https://github.com/rust-lang/crates.io-index#js-sys@0.3.69": "0v99rz97asnzapb0jsc3jjhvxpfxr7h7qd97yqyrf9i7viimbh99", + "registry+https://github.com/rust-lang/crates.io-index#k256@0.12.0": "15rk834ksg9jw96kh6hwiyv94i5qy6brw784rwmjcb5pyc7mx9cj", + "registry+https://github.com/rust-lang/crates.io-index#k256@0.13.3": "0ysq18pjz040am5llgly90464x7qqq98yxfbcsladq96gsvgjvwm", + "registry+https://github.com/rust-lang/crates.io-index#lazy_static@1.4.0": "0in6ikhw8mgl33wjv6q6xfrb5b9jr16q8ygjy803fay4zcisvaz2", + "registry+https://github.com/rust-lang/crates.io-index#libc@0.2.155": "0z44c53z54znna8n322k5iwg80arxxpdzjj5260pxxzc9a58icwp", + "registry+https://github.com/rust-lang/crates.io-index#libm@0.2.8": "0n4hk1rs8pzw8hdfmwn96c4568s93kfxqgcqswr7sajd2diaihjf", + "registry+https://github.com/rust-lang/crates.io-index#libsodium-sys@0.2.7": "1zcjka23grayr8kjrgbada6vwagp0kkni9m45v0gpbanrn3r6xvb", + "registry+https://github.com/rust-lang/crates.io-index#log@0.4.21": "074hldq1q8rlzq2s2qa8f25hj4s3gpw71w64vdwzjd01a4g8rvch", + "registry+https://github.com/rust-lang/crates.io-index#memchr@2.7.2": "07bcqxb0vx4ji0648ny5xsicjnpma95x1n07v7mi7jrhsz2l11kc", + "registry+https://github.com/rust-lang/crates.io-index#num-bigint-dig@0.8.4": "0lb12df24wgxxbspz4gw1sf1kdqwvpdcpwq4fdlwg4gj41c1k16w", + "registry+https://github.com/rust-lang/crates.io-index#num-integer@0.1.46": "13w5g54a9184cqlbsq80rnxw4jj4s0d8wv75jsq5r2lms8gncsbr", + "registry+https://github.com/rust-lang/crates.io-index#num-iter@0.1.45": "1gzm7vc5g9qsjjl3bqk9rz1h6raxhygbrcpbfl04swlh0i506a8l", + "registry+https://github.com/rust-lang/crates.io-index#num-traits@0.2.19": "0h984rhdkkqd4ny9cif7y2azl3xdfb7768hb9irhpsch4q3gq787", + "registry+https://github.com/rust-lang/crates.io-index#once_cell@1.19.0": "14kvw7px5z96dk4dwdm1r9cqhhy2cyj1l5n5b29mynbb8yr15nrz", + "registry+https://github.com/rust-lang/crates.io-index#p256@0.12.0": "0m8f1d0n69bvm4xpranhwv3nrvcq3lcfqn4cqsxbqhyfrfrj9ha9", + "registry+https://github.com/rust-lang/crates.io-index#p256@0.13.2": "0jyd3c3k239ybs59ixpnl7dqkmm072fr1js8kh7ldx58bzc3m1n9", + "registry+https://github.com/rust-lang/crates.io-index#p384@0.12.0": "1m6jw4zm5v9czk6ncbdzcdq82jsnby8a8qdfrz78wd0q4sdll2k3", + "registry+https://github.com/rust-lang/crates.io-index#p384@0.13.0": "02cjlxdvxwvhmnckqnydqpvrwhf5raj67q300d66m7y6pi8nyy3h", + "registry+https://github.com/rust-lang/crates.io-index#pem-rfc7468@0.6.0": "1b5d8rvc4lgwxhs72m99fnrg0wq7bqh4x4wq0c7501ci7a1mkl94", + "registry+https://github.com/rust-lang/crates.io-index#pem-rfc7468@0.7.0": "04l4852scl4zdva31c1z6jafbak0ni5pi0j38ml108zwzjdrrcw8", + "registry+https://github.com/rust-lang/crates.io-index#pkcs1@0.4.1": "06gpasl1v2d2r74xa8vm72vqy6ryxjynwxna5s5cjk65vzdkpwzg", + "registry+https://github.com/rust-lang/crates.io-index#pkcs8@0.10.2": "1dx7w21gvn07azszgqd3ryjhyphsrjrmq5mmz1fbxkj5g0vv4l7r", + "registry+https://github.com/rust-lang/crates.io-index#pkcs8@0.9.0": "1fm4sigvcd0zpzg9jcp862a8p272kk08b9lgcs1dm1az19cjrjly", + "registry+https://github.com/rust-lang/crates.io-index#pkg-config@0.3.30": "1v07557dj1sa0aly9c90wsygc0i8xv5vnmyv0g94lpkvj8qb4cfj", + "registry+https://github.com/rust-lang/crates.io-index#ppv-lite86@0.2.17": "1pp6g52aw970adv3x2310n7glqnji96z0a9wiamzw89ibf0ayh2v", + "registry+https://github.com/rust-lang/crates.io-index#primeorder@0.12.1": "1cn5lh5pb1g7x9l0cq888qp6im36bg95pkqlyji6bfix3c9zfm0b", + "registry+https://github.com/rust-lang/crates.io-index#primeorder@0.13.6": "1rp16710mxksagcjnxqjjq9r9wf5vf72fs8wxffnvhb6i6hiqgim", + "registry+https://github.com/rust-lang/crates.io-index#proc-macro2@1.0.84": "1mj998115z75c0007glkdr8qj57ibv82h7kg6r8hnc914slwd5pc", + "registry+https://github.com/rust-lang/crates.io-index#quote@1.0.36": "19xcmh445bg6simirnnd4fvkmp6v2qiwxh5f6rw4a70h76pnm9qg", + "registry+https://github.com/rust-lang/crates.io-index#rand@0.8.5": "013l6931nn7gkc23jz5mm3qdhf93jjf0fg64nz2lp4i51qd8vbrl", + "registry+https://github.com/rust-lang/crates.io-index#rand_chacha@0.3.1": "123x2adin558xbhvqb8w4f6syjsdkmqff8cxwhmjacpsl1ihmhg6", + "registry+https://github.com/rust-lang/crates.io-index#rand_core@0.6.4": "0b4j2v4cb5krak1pv6kakv4sz6xcwbrmy2zckc32hsigbrwy82zc", + "registry+https://github.com/rust-lang/crates.io-index#regex-automata@0.4.6": "1spaq7y4im7s56d1gxa2hi4hzf6dwswb1bv8xyavzya7k25kpf46", + "registry+https://github.com/rust-lang/crates.io-index#regex-syntax@0.8.3": "0mhzkm1pkqg6y53xv056qciazlg47pq0czqs94cn302ckvi49bdd", + "registry+https://github.com/rust-lang/crates.io-index#regex@1.10.4": "0k5sb0h2mkwf51ab0gvv3x38jp1q7wgxf63abfbhi0wwvvgxn5y1", + "registry+https://github.com/rust-lang/crates.io-index#rfc6979@0.3.1": "1fzsp705b5lhwd2r9il9grc3lj6rm3b2r89vh0xv181gy5xg2hvp", + "registry+https://github.com/rust-lang/crates.io-index#rfc6979@0.4.0": "1chw95jgcfrysyzsq6a10b1j5qb7bagkx8h0wda4lv25in02mpgq", + "registry+https://github.com/rust-lang/crates.io-index#rsa@0.7.2": "1709a7gcb2h4r95qyrkdz8nz3jb8k4hafj5q3ibfzg0c8zam4h09", + "registry+https://github.com/rust-lang/crates.io-index#rustc-serialize@0.3.25": "00c494bsxjqjvc15h9x2nkgwl6bjdp9bmb9v0xs4ckv0h33lp0zy", + "registry+https://github.com/rust-lang/crates.io-index#ryu@1.0.18": "17xx2s8j1lln7iackzd9p0sv546vjq71i779gphjq923vjh5pjzk", + "registry+https://github.com/rust-lang/crates.io-index#same-file@1.0.6": "00h5j1w87dmhnvbv9l8bic3y7xxsnjmssvifw2ayvgx9mb1ivz4k", + "registry+https://github.com/rust-lang/crates.io-index#sec1@0.3.0": "0a09lk5w3nyggpyz54m10nnlg9v8qbh6kw3v1bgla31988c4rqiv", + "registry+https://github.com/rust-lang/crates.io-index#sec1@0.7.3": "1p273j8c87pid6a1iyyc7vxbvifrw55wbxgr0dh3l8vnbxb7msfk", + "registry+https://github.com/rust-lang/crates.io-index#serde@1.0.203": "1500ghq198n6py5anvz5qbqagd9h1hq04f4qpsvjzrvix56snlvj", + "registry+https://github.com/rust-lang/crates.io-index#serde_derive@1.0.203": "1fmmqmfza3mwxb1v80737dj01gznrh8mhgqgylkndx5npq7bq32h", + "registry+https://github.com/rust-lang/crates.io-index#serde_json@1.0.117": "1hxziifjlc0kn1cci9d4crmjc7qwnfi20lxwyj9lzca2c7m84la5", + "registry+https://github.com/rust-lang/crates.io-index#sha2@0.10.8": "1j1x78zk9il95w9iv46dh9wm73r6xrgj32y6lzzw7bxws9dbfgbr", + "registry+https://github.com/rust-lang/crates.io-index#signature@1.6.4": "0z3xg405pg827g6hfdprnszsdqkkbrsfx7f1dl04nv9g7cxks8vl", + "registry+https://github.com/rust-lang/crates.io-index#signature@2.0.0": "0zg534qaa8cl5spq8d0rs0jq6km4w9vil69148awiy9khg4mir4g", + "registry+https://github.com/rust-lang/crates.io-index#smallvec@1.13.2": "0rsw5samawl3wsw6glrsb127rx6sh89a8wyikicw6dkdcjd1lpiw", + "registry+https://github.com/rust-lang/crates.io-index#sodiumoxide@0.2.7": "0a00rcp2vphrs8qh0477rzs6lhsng1m5i0l4qamagnf2nsnf6sz2", + "registry+https://github.com/rust-lang/crates.io-index#spin@0.5.2": "0b84m6dbzrwf2kxylnw82d3dr8w06av7rfkr8s85fb5f43rwyqvf", + "registry+https://github.com/rust-lang/crates.io-index#spki@0.6.0": "0ar1ldkl7svp8l3gfw2hyiiph7n2nqynjnjgdv1pscvsmjxh5kv7", + "registry+https://github.com/rust-lang/crates.io-index#spki@0.7.3": "17fj8k5fmx4w9mp27l970clrh5qa7r5sjdvbsln987xhb34dc7nr", + "registry+https://github.com/rust-lang/crates.io-index#subtle@2.5.0": "1g2yjs7gffgmdvkkq0wrrh0pxds3q0dv6dhkw9cdpbib656xdkc1", + "registry+https://github.com/rust-lang/crates.io-index#syn@2.0.66": "1xfgrprsbz8j31kabvfinb4fyhajlk2q7lxa18fb006yl90kyby4", + "registry+https://github.com/rust-lang/crates.io-index#thiserror-impl@1.0.61": "0cvm37hp0kbcyk1xac1z0chpbd9pbn2g456iyid6sah0a113ihs6", + "registry+https://github.com/rust-lang/crates.io-index#thiserror@1.0.61": "028prh962l16cmjivwb1g9xalbpqip0305zhq006mg74dc6whin5", + "registry+https://github.com/rust-lang/crates.io-index#typenum@1.17.0": "09dqxv69m9lj9zvv6xw5vxaqx15ps0vxyy5myg33i0kbqvq0pzs2", + "registry+https://github.com/rust-lang/crates.io-index#unicode-ident@1.0.12": "0jzf1znfpb2gx8nr8mvmyqs1crnv79l57nxnbiszc7xf7ynbjm1k", + "registry+https://github.com/rust-lang/crates.io-index#version_check@0.9.4": "0gs8grwdlgh0xq660d7wr80x14vxbizmd8dbp29p2pdncx8lp1s9", + "registry+https://github.com/rust-lang/crates.io-index#walkdir@2.5.0": "0jsy7a710qv8gld5957ybrnc07gavppp963gs32xk4ag8130jy99", + "registry+https://github.com/rust-lang/crates.io-index#wasi@0.11.0+wasi-snapshot-preview1": "08z4hxwkpdpalxjps1ai9y7ihin26y9f476i53dv98v45gkqg3cw", + "registry+https://github.com/rust-lang/crates.io-index#wasix@0.12.21": "0v9wb03ddbnas75005l2d63bdqy9mclds00b1qbw385wkgpv9yy1", + "registry+https://github.com/rust-lang/crates.io-index#wasm-bindgen-backend@0.2.92": "1nj7wxbi49f0rw9d44rjzms26xlw6r76b2mrggx8jfbdjrxphkb1", + "registry+https://github.com/rust-lang/crates.io-index#wasm-bindgen-macro-support@0.2.92": "1dqv2xs8zcyw4kjgzj84bknp2h76phmsb3n7j6hn396h4ssifkz9", + "registry+https://github.com/rust-lang/crates.io-index#wasm-bindgen-macro@0.2.92": "09npa1srjjabd6nfph5yc03jb26sycjlxhy0c2a1pdrpx4yq5y51", + "registry+https://github.com/rust-lang/crates.io-index#wasm-bindgen-shared@0.2.92": "15kyavsrna2cvy30kg03va257fraf9x00ny554vxngvpyaa0q6dg", + "registry+https://github.com/rust-lang/crates.io-index#wasm-bindgen@0.2.92": "1a4mcw13nsk3fr8fxjzf9kk1wj88xkfsmnm0pjraw01ryqfm7qjb", + "registry+https://github.com/rust-lang/crates.io-index#winapi-util@0.1.8": "0svcgddd2rw06mj4r76gj655qsa1ikgz3d3gzax96fz7w62c6k2d", + "registry+https://github.com/rust-lang/crates.io-index#windows-sys@0.52.0": "0gd3v4ji88490zgb6b5mq5zgbvwv7zx1ibn8v3x83rwcdbryaar8", + "registry+https://github.com/rust-lang/crates.io-index#windows-targets@0.52.5": "1sz7jrnkygmmlj1ia8fk85wbyil450kq5qkh5qh9sh2rcnj161vg", + "registry+https://github.com/rust-lang/crates.io-index#windows_aarch64_gnullvm@0.52.5": "0qrjimbj67nnyn7zqy15mzzmqg0mn5gsr2yciqjxm3cb3vbyx23h", + "registry+https://github.com/rust-lang/crates.io-index#windows_aarch64_msvc@0.52.5": "1dmga8kqlmln2ibckk6mxc9n59vdg8ziqa2zr8awcl720hazv1cr", + "registry+https://github.com/rust-lang/crates.io-index#windows_i686_gnu@0.52.5": "0w4np3l6qwlra9s2xpflqrs60qk1pz6ahhn91rr74lvdy4y0gfl8", + "registry+https://github.com/rust-lang/crates.io-index#windows_i686_gnullvm@0.52.5": "1s9f4gff0cixd86mw3n63rpmsm4pmr4ffndl6s7qa2h35492dx47", + "registry+https://github.com/rust-lang/crates.io-index#windows_i686_msvc@0.52.5": "1gw7fklxywgpnwbwg43alb4hm0qjmx72hqrlwy5nanrxs7rjng6v", + "registry+https://github.com/rust-lang/crates.io-index#windows_x86_64_gnu@0.52.5": "1n8p2mcf3lw6300k77a0knksssmgwb9hynl793mhkzyydgvlchjf", + "registry+https://github.com/rust-lang/crates.io-index#windows_x86_64_gnullvm@0.52.5": "15n56jrh4s5bz66zimavr1rmcaw6wa306myrvmbc6rydhbj9h8l5", + "registry+https://github.com/rust-lang/crates.io-index#windows_x86_64_msvc@0.52.5": "1w1bn24ap8dp9i85s8mlg8cim2bl2368bd6qyvm0xzqvzmdpxi5y", + "registry+https://github.com/rust-lang/crates.io-index#zeroize@1.8.1": "1pjdrmjwmszpxfd7r860jx54cyk94qk59x13sc307cvr5256glyf" } \ No newline at end of file diff --git a/libs/metrics-wai/src/Data/Metrics/Middleware/Prometheus.hs b/libs/metrics-wai/src/Data/Metrics/Middleware/Prometheus.hs index c9806e60788..f1f7c1ca562 100644 --- a/libs/metrics-wai/src/Data/Metrics/Middleware/Prometheus.hs +++ b/libs/metrics-wai/src/Data/Metrics/Middleware/Prometheus.hs @@ -32,7 +32,7 @@ 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 :: (Monad m) => Routes a m b -> Wai.Middleware waiPrometheusMiddleware routes = Promth.prometheus conf . instrument (normalizeWaiRequestRoute paths) where diff --git a/libs/metrics-wai/src/Data/Metrics/Servant.hs b/libs/metrics-wai/src/Data/Metrics/Servant.hs index b8ec0984997..6d1df7d26ff 100644 --- a/libs/metrics-wai/src/Data/Metrics/Servant.hs +++ b/libs/metrics-wai/src/Data/Metrics/Servant.hs @@ -77,7 +77,7 @@ conf = Promth.prometheusInstrumentApp = False } -routesToPaths :: forall routes. RoutesToPaths routes => Paths +routesToPaths :: forall routes. (RoutesToPaths routes) => Paths routesToPaths = Paths (meltTree (getRoutes @routes)) class RoutesToPaths routes where @@ -122,19 +122,19 @@ instance getRoutes = getRoutes @rest instance - RoutesToPaths rest => + (RoutesToPaths rest) => RoutesToPaths (QueryParam' mods name a :> rest) where getRoutes = getRoutes @rest -instance RoutesToPaths rest => RoutesToPaths (MultipartForm tag a :> rest) where +instance (RoutesToPaths rest) => RoutesToPaths (MultipartForm tag a :> rest) where getRoutes = getRoutes @rest -instance RoutesToPaths api => RoutesToPaths (QueryFlag a :> api) where +instance (RoutesToPaths api) => RoutesToPaths (QueryFlag a :> api) where getRoutes = getRoutes @api instance - RoutesToPaths rest => + (RoutesToPaths rest) => RoutesToPaths (Description desc :> rest) where getRoutes = getRoutes @rest diff --git a/libs/metrics-wai/src/Data/Metrics/WaiRoute.hs b/libs/metrics-wai/src/Data/Metrics/WaiRoute.hs index cd8a993c2cb..b4ca4c01ded 100644 --- a/libs/metrics-wai/src/Data/Metrics/WaiRoute.hs +++ b/libs/metrics-wai/src/Data/Metrics/WaiRoute.hs @@ -25,5 +25,5 @@ import Data.Metrics.Types import Imports import Network.Wai.Route.Tree as Tree -treeToPaths :: HasCallStack => Tree a -> Paths +treeToPaths :: (HasCallStack) => Tree a -> Paths treeToPaths = either error id . mkTree . fmap (Tree.segments . path) . Tree.toList diff --git a/libs/polysemy-wire-zoo/src/Wire/Sem/Concurrency.hs b/libs/polysemy-wire-zoo/src/Wire/Sem/Concurrency.hs index 29ac503809d..8cdf9f6600a 100644 --- a/libs/polysemy-wire-zoo/src/Wire/Sem/Concurrency.hs +++ b/libs/polysemy-wire-zoo/src/Wire/Sem/Concurrency.hs @@ -40,13 +40,13 @@ data ConcurrencySafety = Safe | Unsafe type Concurrency :: ConcurrencySafety -> (Type -> Type) -> Type -> Type data Concurrency (safe :: ConcurrencySafety) m a where UnsafePooledMapConcurrentlyN :: - Foldable t => + (Foldable t) => Int -> (a -> m b) -> t a -> Concurrency safe m [b] UnsafePooledMapConcurrentlyN_ :: - Foldable t => + (Foldable t) => Int -> (a -> m b) -> t a -> @@ -108,7 +108,7 @@ unsafePooledForConcurrentlyN_ n as f = pooledMapConcurrentlyN :: forall r' r t a b. - r' ~ '[Final IO] => + (r' ~ '[Final IO]) => (Member (Concurrency 'Safe) r, Subsume r' r, Foldable t) => -- | Max. number of threads. Should not be less than 1. Int -> @@ -124,7 +124,7 @@ pooledMapConcurrentlyN n f as = pooledMapConcurrentlyN_ :: forall r' r t a b. - r' ~ '[Final IO] => + (r' ~ '[Final IO]) => (Member (Concurrency 'Safe) r, Subsume r' r, Foldable t) => -- | Max. number of threads. Should not be less than 1. Int -> @@ -140,7 +140,7 @@ pooledMapConcurrentlyN_ n f as = pooledForConcurrentlyN :: forall r' r t a b. - r' ~ '[Final IO] => + (r' ~ '[Final IO]) => (Member (Concurrency 'Safe) r, Subsume r' r, Foldable t) => -- | Max. number of threads. Should not be less than 1. Int -> @@ -156,7 +156,7 @@ pooledForConcurrentlyN n as f = pooledForConcurrentlyN_ :: forall r' r t a b. - r' ~ '[Final IO] => + (r' ~ '[Final IO]) => (Member (Concurrency 'Safe) r, Subsume r' r, Foldable t) => -- | Max. number of threads. Should not be less than 1. Int -> diff --git a/libs/polysemy-wire-zoo/src/Wire/Sem/Concurrency/IO.hs b/libs/polysemy-wire-zoo/src/Wire/Sem/Concurrency/IO.hs index d5887bce411..471a0c75512 100644 --- a/libs/polysemy-wire-zoo/src/Wire/Sem/Concurrency/IO.hs +++ b/libs/polysemy-wire-zoo/src/Wire/Sem/Concurrency/IO.hs @@ -10,7 +10,7 @@ import Wire.Sem.Concurrency (Concurrency (..), ConcurrencySafety (Safe)) -- | Safely perform concurrency that wraps only IO effects. performConcurrency :: - Member (Final IO) r => + (Member (Final IO) r) => Sem (Concurrency 'Safe ': r) a -> Sem r a performConcurrency = unsafelyPerformConcurrency @@ -21,7 +21,7 @@ performConcurrency = unsafelyPerformConcurrency -- obscure bugs. See the notes on 'Concurrency' to get a better understanding -- of what can go wrong here. unsafelyPerformConcurrency :: - Member (Final IO) r => + (Member (Final IO) r) => Sem (Concurrency safe ': r) a -> Sem r a unsafelyPerformConcurrency = interpretFinal @IO $ \case diff --git a/libs/polysemy-wire-zoo/src/Wire/Sem/Delay.hs b/libs/polysemy-wire-zoo/src/Wire/Sem/Delay.hs index 7b1395b8ed0..00e6457d08c 100644 --- a/libs/polysemy-wire-zoo/src/Wire/Sem/Delay.hs +++ b/libs/polysemy-wire-zoo/src/Wire/Sem/Delay.hs @@ -10,7 +10,7 @@ data Delay m a where makeSem ''Delay -runDelay :: Member (Embed IO) r => Sem (Delay ': r) a -> Sem r a +runDelay :: (Member (Embed IO) r) => Sem (Delay ': r) a -> Sem r a runDelay = interpret $ \case Delay i -> threadDelay i diff --git a/libs/polysemy-wire-zoo/src/Wire/Sem/Jwk.hs b/libs/polysemy-wire-zoo/src/Wire/Sem/Jwk.hs index 913e5cbf7b7..6ce9454879f 100644 --- a/libs/polysemy-wire-zoo/src/Wire/Sem/Jwk.hs +++ b/libs/polysemy-wire-zoo/src/Wire/Sem/Jwk.hs @@ -15,7 +15,7 @@ data Jwk m a where makeSem ''Jwk -interpretJwk :: Members '[Embed IO] r => Sem (Jwk ': r) a -> Sem r a +interpretJwk :: (Members '[Embed IO] r) => Sem (Jwk ': r) a -> Sem r a interpretJwk = interpret $ \(Get fp) -> liftIO $ readJwk fp readJwk :: FilePath -> IO (Maybe JWK) diff --git a/libs/polysemy-wire-zoo/src/Wire/Sem/Logger.hs b/libs/polysemy-wire-zoo/src/Wire/Sem/Logger.hs index 8a3f96560c6..ff619d5a1cb 100644 --- a/libs/polysemy-wire-zoo/src/Wire/Sem/Logger.hs +++ b/libs/polysemy-wire-zoo/src/Wire/Sem/Logger.hs @@ -33,22 +33,22 @@ data Logger msg m a where -- TODO(sandy): Inline this definition --- no TH makeSem ''Logger -trace :: Member (Logger msg) r => msg -> Sem r () +trace :: (Member (Logger msg) r) => msg -> Sem r () trace = log Trace -debug :: Member (Logger msg) r => msg -> Sem r () +debug :: (Member (Logger msg) r) => msg -> Sem r () debug = log Debug -info :: Member (Logger msg) r => msg -> Sem r () +info :: (Member (Logger msg) r) => msg -> Sem r () info = log Info -warn :: Member (Logger msg) r => msg -> Sem r () +warn :: (Member (Logger msg) r) => msg -> Sem r () warn = log Warn -err :: Member (Logger msg) r => msg -> Sem r () +err :: (Member (Logger msg) r) => msg -> Sem r () err = log Error -fatal :: Member (Logger msg) r => msg -> Sem r () +fatal :: (Member (Logger msg) r) => msg -> Sem r () fatal = log Fatal -------------------------------------------------------------------------------- @@ -56,7 +56,7 @@ fatal = log Fatal mapLogger :: forall msg msg' r a. - Member (Logger msg') r => + (Member (Logger msg') r) => (msg -> msg') -> Sem (Logger msg ': r) a -> Sem r a diff --git a/libs/polysemy-wire-zoo/src/Wire/Sem/Logger/TinyLog.hs b/libs/polysemy-wire-zoo/src/Wire/Sem/Logger/TinyLog.hs index 76889f09b3a..231485fe45c 100644 --- a/libs/polysemy-wire-zoo/src/Wire/Sem/Logger/TinyLog.hs +++ b/libs/polysemy-wire-zoo/src/Wire/Sem/Logger/TinyLog.hs @@ -38,7 +38,7 @@ import Wire.Sem.Logger import Wire.Sem.Logger.Level loggerToTinyLog :: - Member (Embed IO) r => + (Member (Embed IO) r) => Log.Logger -> Sem (Logger (Log.Msg -> Log.Msg) ': r) a -> Sem r a @@ -48,7 +48,7 @@ loggerToTinyLog tinylog = interpret $ \case -- | Log the request ID along with the message loggerToTinyLogReqId :: - Member (Embed IO) r => + (Member (Embed IO) r) => RequestId -> Log.Logger -> Sem (TinyLog ': r) a -> @@ -58,7 +58,7 @@ loggerToTinyLogReqId r tinylog = . mapLogger (Log.field "request" (unRequestId r) .) . raiseUnder @TinyLog -stringLoggerToTinyLog :: Member (Logger (Log.Msg -> Log.Msg)) r => Sem (Logger String ': r) a -> Sem r a +stringLoggerToTinyLog :: (Member (Logger (Log.Msg -> Log.Msg)) r) => Sem (Logger String ': r) a -> Sem r a stringLoggerToTinyLog = mapLogger @String Log.msg discardTinyLogs :: Sem (Logger (Log.Msg -> Log.Msg) ': r) a -> Sem r a @@ -69,6 +69,6 @@ newtype LogRecorder = LogRecorder {recordedLogs :: IORef [(Level, LByteString)]} newLogRecorder :: IO LogRecorder newLogRecorder = LogRecorder <$> newIORef [] -recordLogs :: Member (Embed IO) r => LogRecorder -> Sem (TinyLog ': r) a -> Sem r a +recordLogs :: (Member (Embed IO) r) => LogRecorder -> Sem (TinyLog ': r) a -> Sem r a recordLogs LogRecorder {..} = interpret $ \(Log lvl msg) -> modifyIORef' recordedLogs (++ [(lvl, Log.render (Log.renderDefault ", ") msg)]) diff --git a/libs/polysemy-wire-zoo/src/Wire/Sem/Now/Input.hs b/libs/polysemy-wire-zoo/src/Wire/Sem/Now/Input.hs index b8c43249f9d..6e3c2dcb688 100644 --- a/libs/polysemy-wire-zoo/src/Wire/Sem/Now/Input.hs +++ b/libs/polysemy-wire-zoo/src/Wire/Sem/Now/Input.hs @@ -27,7 +27,7 @@ import Polysemy.Input import Wire.Sem.Now nowToInput :: - Member (Input UTCTime) r => + (Member (Input UTCTime) r) => Sem (Now ': r) a -> Sem r a nowToInput = interpret $ \case diff --git a/libs/polysemy-wire-zoo/src/Wire/Sem/Now/Spec.hs b/libs/polysemy-wire-zoo/src/Wire/Sem/Now/Spec.hs index 0ded935d5f1..84b789646ba 100644 --- a/libs/polysemy-wire-zoo/src/Wire/Sem/Now/Spec.hs +++ b/libs/polysemy-wire-zoo/src/Wire/Sem/Now/Spec.hs @@ -30,7 +30,7 @@ import Test.QuickCheck import qualified Wire.Sem.Now as E propsForInterpreter :: - PropConstraints r f => + (PropConstraints r f) => String -> (forall a. Sem r a -> IO (f a)) -> Spec @@ -42,15 +42,15 @@ propsForInterpreter interpreter lower = do -- A regular type synonym doesn't work due to dreaded impredicative -- polymorphism. class - (Functor f, Member E.Now r, Member (Input ()) r, forall z. Show z => Show (f z), forall z. Eq z => Eq (f z)) => + (Functor f, Member E.Now r, Member (Input ()) r, forall z. (Show z) => Show (f z), forall z. (Eq z) => Eq (f z)) => PropConstraints r f instance - (Functor f, Member E.Now r, Member (Input ()) r, forall z. Show z => Show (f z), forall z. Eq z => Eq (f z)) => + (Functor f, Member E.Now r, Member (Input ()) r, forall z. (Show z) => Show (f z), forall z. (Eq z) => Eq (f z)) => PropConstraints r f prop_nowNow :: - PropConstraints r f => + (PropConstraints r f) => Maybe (f Bool -> String) -> (forall a. Sem r a -> IO (f a)) -> Property diff --git a/libs/polysemy-wire-zoo/src/Wire/Sem/Random.hs b/libs/polysemy-wire-zoo/src/Wire/Sem/Random.hs index da054b545ed..0d563a187af 100644 --- a/libs/polysemy-wire-zoo/src/Wire/Sem/Random.hs +++ b/libs/polysemy-wire-zoo/src/Wire/Sem/Random.hs @@ -36,6 +36,6 @@ data Random m a where Bytes :: Int -> Random m ByteString Uuid :: Random m UUID ScimTokenId :: Random m ScimTokenId - LiftRandom :: (forall mr. MonadRandom mr => mr a) -> Random m a + LiftRandom :: (forall mr. (MonadRandom mr) => mr a) -> Random m a makeSem ''Random diff --git a/libs/polysemy-wire-zoo/src/Wire/Sem/Random/IO.hs b/libs/polysemy-wire-zoo/src/Wire/Sem/Random/IO.hs index e64815799f4..5095decee8c 100644 --- a/libs/polysemy-wire-zoo/src/Wire/Sem/Random/IO.hs +++ b/libs/polysemy-wire-zoo/src/Wire/Sem/Random/IO.hs @@ -28,7 +28,7 @@ import Polysemy import Wire.Sem.Random (Random (..)) randomToIO :: - Member (Embed IO) r => + (Member (Embed IO) r) => Sem (Random ': r) a -> Sem r a randomToIO = interpret $ \case diff --git a/libs/ropes/src/Ropes/Twilio.hs b/libs/ropes/src/Ropes/Twilio.hs index e9a935b7302..986f364117d 100644 --- a/libs/ropes/src/Ropes/Twilio.hs +++ b/libs/ropes/src/Ropes/Twilio.hs @@ -153,7 +153,7 @@ instance FromJSON PhoneType where -- * Functions -tryTwilio :: MonadIO m => IO a -> ExceptT ErrorResponse m a +tryTwilio :: (MonadIO m) => IO a -> ExceptT ErrorResponse m a tryTwilio = ExceptT . liftIO . try sendMessage :: Credentials -> Manager -> Message -> IO MessageId diff --git a/libs/schema-profunctor/src/Data/Schema.hs b/libs/schema-profunctor/src/Data/Schema.hs index e2dd11a7853..9f6104e07a9 100644 --- a/libs/schema-profunctor/src/Data/Schema.hs +++ b/libs/schema-profunctor/src/Data/Schema.hs @@ -138,7 +138,7 @@ newtype SchemaOut v a b = SchemaOut (a -> Maybe v) -- The following instance is correct because `Ap Maybe v` is a -- near-semiring when v is a monoid -instance Monoid v => Alternative (SchemaOut v a) where +instance (Monoid v) => Alternative (SchemaOut v a) where empty = mempty (<|>) = (<>) @@ -153,7 +153,7 @@ instance Monoid (SchemaOut v a b) where -- -- This is used for schema documentation types, to support different behaviours -- for composing schemas sequentially vs alternatively. -class Monoid m => NearSemiRing m where +class (Monoid m) => NearSemiRing m where zero :: m add :: m -> m -> m @@ -162,7 +162,7 @@ newtype SchemaDoc doc a b = SchemaDoc {getDoc :: doc} deriving (Applicative) via (Const doc) deriving (Profunctor, Choice) via Joker (Const doc) -instance NearSemiRing doc => Alternative (SchemaDoc doc a) where +instance (NearSemiRing doc) => Alternative (SchemaDoc doc a) where empty = zero (<|>) = add @@ -240,11 +240,11 @@ instance (NearSemiRing doc, Monoid v') => Alternative (SchemaP doc v v' a) where -- /Note/: this is a more general instance than the 'Alternative' one, -- since it works for arbitrary v' -instance Semigroup doc => Semigroup (SchemaP doc v v' a b) where +instance (Semigroup doc) => Semigroup (SchemaP doc v v' a b) where SchemaP d1 i1 o1 <> SchemaP d2 i2 o2 = SchemaP (d1 <> d2) (i1 <> i2) (o1 <> o2) -instance Monoid doc => Monoid (SchemaP doc v v' a b) where +instance (Monoid doc) => Monoid (SchemaP doc v v' a b) where mempty = SchemaP mempty mempty mempty instance Profunctor (SchemaP doc v v') where @@ -282,7 +282,7 @@ schemaIn (SchemaP _ (SchemaIn i) _) = i schemaOut :: SchemaP ss v m a b -> a -> Maybe m schemaOut (SchemaP _ _ (SchemaOut o)) = o -class Functor f => FieldFunctor doc f where +class (Functor f) => FieldFunctor doc f where parseFieldF :: (A.Value -> A.Parser a) -> A.Object -> Text -> A.Parser (f a) mkDocF :: doc -> doc @@ -290,14 +290,14 @@ instance FieldFunctor doc Identity where parseFieldF f obj key = Identity <$> A.explicitParseField f obj (Key.fromText key) mkDocF = id -instance HasOpt doc => FieldFunctor doc Maybe where +instance (HasOpt doc) => FieldFunctor doc Maybe where parseFieldF f obj key = A.explicitParseFieldMaybe f obj (Key.fromText key) mkDocF = mkOpt -- | A schema for a one-field JSON object. field :: forall doc' doc a b. - HasField doc' doc => + (HasField doc' doc) => Text -> SchemaP doc' A.Value A.Value a b -> SchemaP doc A.Object [A.Pair] a b @@ -366,7 +366,7 @@ fieldOver l name = fmap runIdentity . fieldOverF l name -- documentation of the field. fieldWithDocModifier :: forall doc' doc a b. - HasField doc' doc => + (HasField doc' doc) => Text -> (doc' -> doc') -> SchemaP doc' A.Value A.Value a b -> @@ -396,7 +396,7 @@ fieldWithDocModifierF :: 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 +(.=) :: (Profunctor p) => (a -> a') -> p a' b -> p a b (.=) = lmap -- | Change the input and output types of a schema via a prism. @@ -408,7 +408,7 @@ tag f = rmap runIdentity . f . rmap Identity -- This can be used to convert a combination of schemas obtained using -- 'field' into a single schema for a JSON object. object :: - HasObject doc doc' => + (HasObject doc doc') => Text -> SchemaP doc A.Object [A.Pair] a b -> SchemaP doc' A.Value A.Value a b @@ -418,7 +418,7 @@ object = objectOver id -- -- Just like 'fieldOver', but for 'object'. objectOver :: - HasObject doc doc' => + (HasObject doc doc') => Lens v v' A.Value A.Object -> Text -> SchemaP doc v' [A.Pair] a b -> @@ -433,7 +433,7 @@ objectOver l name sch = SchemaP (SchemaDoc s) (SchemaIn r) (SchemaOut w) -- | Like 'object', but apply an arbitrary function to the -- documentation of the resulting object. objectWithDocModifier :: - HasObject doc doc' => + (HasObject doc doc') => Text -> (doc' -> doc') -> ObjectSchema doc a -> @@ -446,14 +446,14 @@ objectWithDocModifier name modify sch = over doc modify (object name sch) -- schema. If the inner schema is unnamed, it gets "inlined" in the -- larger scheme definition, and otherwise it gets "referenced". This -- combinator makes it possible to choose one of the two options. -unnamed :: HasObject doc doc' => SchemaP doc' v m a b -> SchemaP doc v m a b +unnamed :: (HasObject doc doc') => SchemaP doc' v m a b -> SchemaP doc v m a b unnamed = over doc unmkObject -- | Attach a name to a schema. -- -- This only affects the documentation portion of a schema, and not -- the parsing or serialisation. -named :: HasObject doc doc' => Text -> SchemaP doc v m a b -> SchemaP doc' v m a b +named :: (HasObject doc doc') => Text -> SchemaP doc v m a b -> SchemaP doc' v m a b named name = over doc (mkObject name) -- | A schema for a JSON array. @@ -524,7 +524,7 @@ setMinItems :: (HasMinItems doc (Maybe Integer)) => Integer -> ValueSchema doc a setMinItems m = doc . minItems ?~ m -- | Ad-hoc class for types corresponding to JSON primitive types. -class A.ToJSON a => With a where +class (A.ToJSON a) => With a where with :: String -> (a -> A.Parser b) -> A.Value -> A.Parser b instance With Text where @@ -574,7 +574,7 @@ enum name sch = SchemaP (SchemaDoc d) (SchemaIn i) (SchemaOut o) -- -- This is most commonly used for optional fields, and it will cause the field -- to be omitted from the output of the serialiser. -maybe_ :: Monoid w => SchemaP d v w a b -> SchemaP d v w (Maybe a) b +maybe_ :: (Monoid w) => SchemaP d v w a b -> SchemaP d v w (Maybe a) b maybe_ = maybeWithDefault mempty -- | A schema for 'Maybe', producing the given default value on serialisation. @@ -649,7 +649,7 @@ jsonValue :: ValueSchema SwaggerDoc A.Value jsonValue = mkSchema mempty pure Just -- | A schema for a null value. -null_ :: Monoid d => ValueSchemaP d () () +null_ :: (Monoid d) => ValueSchemaP d () () null_ = mkSchema mempty i o where i x = guard (x == A.Null) @@ -662,7 +662,7 @@ null_ = mkSchema mempty i o -- -- The serialiser behaves similarly, but in the other direction. nullable :: - Monoid d => + (Monoid d) => ValueSchema d a -> ValueSchema d (Maybe a) nullable s = @@ -687,14 +687,14 @@ instance Applicative WithDeclare where WithDeclare d1 s1 <*> WithDeclare d2 s2 = WithDeclare (d1 >> d2) (s1 s2) -instance Semigroup s => Semigroup (WithDeclare s) where +instance (Semigroup s) => Semigroup (WithDeclare s) where WithDeclare d1 s1 <> WithDeclare d2 s2 = WithDeclare (d1 >> d2) (s1 <> s2) -instance Monoid s => Monoid (WithDeclare s) where +instance (Monoid s) => Monoid (WithDeclare s) where mempty = WithDeclare (pure ()) mempty -instance NearSemiRing s => NearSemiRing (WithDeclare s) where +instance (NearSemiRing s) => NearSemiRing (WithDeclare s) where zero = WithDeclare (pure ()) zero add (WithDeclare d1 s1) (WithDeclare d2 s2) = WithDeclare (d1 >> d2) (add s1 s2) @@ -745,17 +745,17 @@ instance HasName SwaggerDoc where instance HasName NamedSwaggerDoc where getName = S._namedSchemaName . extract -class Monoid doc => HasField ndoc doc | ndoc -> doc where +class (Monoid doc) => HasField ndoc doc | ndoc -> doc where mkField :: Text -> ndoc -> doc -class Monoid doc => HasObject doc ndoc | doc -> ndoc, ndoc -> doc where +class (Monoid doc) => HasObject doc ndoc | doc -> ndoc, ndoc -> doc where mkObject :: Text -> doc -> ndoc unmkObject :: ndoc -> doc -class Monoid doc => HasArray ndoc doc | ndoc -> doc where +class (Monoid doc) => HasArray ndoc doc | ndoc -> doc where mkArray :: ndoc -> doc -class Monoid doc => HasMap ndoc doc | ndoc -> doc where +class (Monoid doc) => HasMap ndoc doc | ndoc -> doc where mkMap :: ndoc -> doc class HasOpt doc where @@ -764,7 +764,7 @@ class HasOpt doc where class HasEnum a doc where mkEnum :: Text -> [A.Value] -> doc -instance HasSchemaRef doc => HasField doc SwaggerDoc where +instance (HasSchemaRef doc) => HasField doc SwaggerDoc where mkField name = fmap f . schemaRef where f ref = @@ -779,7 +779,7 @@ instance HasObject SwaggerDoc NamedSwaggerDoc where unmkObject (WithDeclare d (S.NamedSchema (Just n) s)) = WithDeclare (d *> S.declare [(n, s)]) s -instance HasSchemaRef ndoc => HasArray ndoc SwaggerDoc where +instance (HasSchemaRef ndoc) => HasArray ndoc SwaggerDoc where mkArray = fmap f . schemaRef where f :: S.Referenced S.Schema -> S.Schema @@ -788,7 +788,7 @@ instance HasSchemaRef ndoc => HasArray ndoc SwaggerDoc where & S.type_ ?~ S.OpenApiArray & S.items ?~ S.OpenApiItemsObject ref -instance HasSchemaRef ndoc => HasMap ndoc SwaggerDoc where +instance (HasSchemaRef ndoc) => HasMap ndoc SwaggerDoc where mkMap = fmap f . schemaRef where f :: S.Referenced S.Schema -> S.Schema @@ -846,24 +846,24 @@ class ToSchema a where newtype Schema a = Schema {getSchema :: a} deriving (Generic) -schemaToSwagger :: forall a. ToSchema a => Proxy a -> Declare S.NamedSchema +schemaToSwagger :: forall a. (ToSchema a) => Proxy a -> Declare S.NamedSchema schemaToSwagger _ = runDeclare (schemaDoc (schema @a)) instance (Typeable a, ToSchema a) => S.ToSchema (Schema a) where declareNamedSchema _ = schemaToSwagger (Proxy @a) -- | JSON serialiser for an instance of 'ToSchema'. -schemaToJSON :: forall a. ToSchema a => a -> A.Value +schemaToJSON :: forall a. (ToSchema a) => a -> A.Value schemaToJSON = fromMaybe A.Null . schemaOut (schema @a) -instance ToSchema a => A.ToJSON (Schema a) where +instance (ToSchema a) => A.ToJSON (Schema a) where toJSON = schemaToJSON . getSchema -- | JSON parser for an instance of 'ToSchema'. -schemaParseJSON :: forall a. ToSchema a => A.Value -> A.Parser a +schemaParseJSON :: forall a. (ToSchema a) => A.Value -> A.Parser a schemaParseJSON = schemaIn schema -instance ToSchema a => A.FromJSON (Schema a) where +instance (ToSchema a) => A.FromJSON (Schema a) where parseJSON = fmap Schema . schemaParseJSON instance ToSchema Text where schema = genericToSchema @@ -899,7 +899,7 @@ instance ToSchema Natural where schema = genericToSchema declareSwaggerSchema :: SchemaP (WithDeclare d) v w a b -> Declare d declareSwaggerSchema = runDeclare . schemaDoc -swaggerDoc :: forall a. S.ToSchema a => NamedSwaggerDoc +swaggerDoc :: forall a. (S.ToSchema a) => NamedSwaggerDoc swaggerDoc = unrunDeclare (S.declareNamedSchema (Proxy @a)) genericToSchema :: forall a. (S.ToSchema a, A.ToJSON a, A.FromJSON a) => ValueSchema NamedSwaggerDoc a @@ -920,7 +920,7 @@ instance S.HasSchema SwaggerDoc S.Schema where instance S.HasSchema NamedSwaggerDoc S.Schema where schema = declared . S.schema -instance S.HasSchema d S.Schema => S.HasSchema (SchemaP d v w a b) S.Schema where +instance (S.HasSchema d S.Schema) => S.HasSchema (SchemaP d v w a b) S.Schema where schema = doc . S.schema instance S.HasDescription NamedSwaggerDoc (Maybe Text) where @@ -929,11 +929,11 @@ instance S.HasDescription NamedSwaggerDoc (Maybe Text) where instance S.HasDeprecated NamedSwaggerDoc (Maybe Bool) where deprecated = declared . S.schema . S.deprecated -instance {-# OVERLAPPABLE #-} S.HasDescription s a => S.HasDescription (WithDeclare s) a where +instance {-# OVERLAPPABLE #-} (S.HasDescription s a) => S.HasDescription (WithDeclare s) a where description = declared . S.description -instance {-# OVERLAPPABLE #-} S.HasDeprecated s a => S.HasDeprecated (WithDeclare s) a where +instance {-# OVERLAPPABLE #-} (S.HasDeprecated s a) => S.HasDeprecated (WithDeclare s) a where deprecated = declared . S.deprecated -instance {-# OVERLAPPABLE #-} S.HasExample s a => S.HasExample (WithDeclare s) a where +instance {-# OVERLAPPABLE #-} (S.HasExample s a) => S.HasExample (WithDeclare s) a where example = declared . S.example diff --git a/libs/ssl-util/src/Ssl/Util.hs b/libs/ssl-util/src/Ssl/Util.hs index 9f9d8ece4e4..f0f7ae19902 100644 --- a/libs/ssl-util/src/Ssl/Util.hs +++ b/libs/ssl-util/src/Ssl/Util.hs @@ -156,7 +156,7 @@ verifyFingerprint hash fprs ssl = do -- | Compute a simple (non-standard) fingerprint of an RSA -- public key for use with 'verifyRsaFingerprint' with the given -- 'Digest'. -rsaFingerprint :: RSAKey k => Digest -> k -> IO ByteString +rsaFingerprint :: (RSAKey k) => Digest -> k -> IO ByteString rsaFingerprint d k = fmap (digestLBS d . toLazyByteString) $ do let s = rsaSize k n <- integerToMPI (rsaN k) diff --git a/libs/tasty-cannon/src/Test/Tasty/Cannon.hs b/libs/tasty-cannon/src/Test/Tasty/Cannon.hs index 9775bb718f7..7fb72b5ca33 100644 --- a/libs/tasty-cannon/src/Test/Tasty/Cannon.hs +++ b/libs/tasty-cannon/src/Test/Tasty/Cannon.hs @@ -103,20 +103,20 @@ data WebSocket = WebSocket wsAppThread :: Async () } -connect :: MonadIO m => Cannon -> UserId -> ConnId -> m WebSocket +connect :: (MonadIO m) => Cannon -> UserId -> ConnId -> m WebSocket connect can uid = connectAsMaybeClient can uid Nothing -connectAsClient :: MonadIO m => Cannon -> UserId -> ClientId -> ConnId -> m WebSocket +connectAsClient :: (MonadIO m) => Cannon -> UserId -> ClientId -> ConnId -> m WebSocket connectAsClient can uid client = connectAsMaybeClient can uid (Just client) -connectAsMaybeClient :: MonadIO m => Cannon -> UserId -> Maybe ClientId -> ConnId -> m WebSocket +connectAsMaybeClient :: (MonadIO m) => Cannon -> UserId -> Maybe ClientId -> ConnId -> m WebSocket connectAsMaybeClient can uid client conn = liftIO $ do nchan <- newTChanIO latch <- newEmptyMVar wsapp <- run can uid client conn (clientApp nchan latch) pure $ WebSocket nchan latch wsapp -close :: MonadIO m => WebSocket -> m () +close :: (MonadIO m) => WebSocket -> m () close ws = liftIO $ do putMVar (wsCloseLatch ws) () void $ waitCatch (wsAppThread ws) @@ -166,10 +166,10 @@ bracketAsClientN c us f = go [] us -- Random Connection IDs -connectR :: MonadIO m => Cannon -> UserId -> m WebSocket +connectR :: (MonadIO m) => Cannon -> UserId -> m WebSocket connectR can uid = randomConnId >>= connect can uid -connectAsClientR :: MonadIO m => Cannon -> UserId -> ClientId -> m WebSocket +connectAsClientR :: (MonadIO m) => Cannon -> UserId -> ClientId -> m WebSocket connectAsClientR can uid clientId = randomConnId >>= connectAsClient can uid clientId bracketR :: (MonadIO m, MonadMask m) => Cannon -> UserId -> (WebSocket -> m a) -> m a @@ -271,7 +271,7 @@ instance Show RegistrationTimeout where show (RegistrationTimeout s) = "Failed to find a registration after " ++ show s ++ " retries.\n" -await :: MonadIO m => Timeout -> WebSocket -> m (Maybe Notification) +await :: (MonadIO m) => Timeout -> WebSocket -> m (Maybe Notification) await t = liftIO . timeout t . atomically . readTChan . wsChan -- | 'await' a 'Notification' on the 'WebSocket'. If it satisfies the 'Assertion', return it. @@ -372,7 +372,7 @@ assertNoEvent t ww = do ----------------------------------------------------------------------------- -- Unpacking Notifications -unpackPayload :: FromJSON a => Notification -> List1 a +unpackPayload :: (FromJSON a) => Notification -> List1 a unpackPayload = fmap decodeEvent . ntfPayload where decodeEvent o = case fromJSON (Object o) of @@ -382,7 +382,7 @@ unpackPayload = fmap decodeEvent . ntfPayload ----------------------------------------------------------------------------- -- Randomness -randomConnId :: MonadIO m => m ConnId +randomConnId :: (MonadIO m) => m ConnId randomConnId = liftIO $ do r <- randomIO :: IO Word32 pure . ConnId $ C.pack $ show r @@ -392,7 +392,7 @@ randomConnId = liftIO $ do -- | Start a client thread in 'Async' that opens a web socket to a Cannon, wait -- for the connection to register with Gundeck, and return the 'Async' thread. -run :: MonadIO m => Cannon -> UserId -> Maybe ClientId -> ConnId -> WS.ClientApp () -> m (Async ()) +run :: (MonadIO m) => Cannon -> UserId -> Maybe ClientId -> ConnId -> WS.ClientApp () -> m (Async ()) run cannon@(($ Http.defaultRequest) -> ca) uid client connId app = liftIO $ do latch <- newEmptyMVar wsapp <- diff --git a/libs/types-common-journal/src/Data/Proto.hs b/libs/types-common-journal/src/Data/Proto.hs index b0a7de0c4b8..64fed865650 100644 --- a/libs/types-common-journal/src/Data/Proto.hs +++ b/libs/types-common-journal/src/Data/Proto.hs @@ -20,5 +20,5 @@ module Data.Proto where import Data.Time.Clock.POSIX import Imports -now :: MonadIO m => m Int64 +now :: (MonadIO m) => m Int64 now = liftIO $ round . utcTimeToPOSIXSeconds <$> getCurrentTime diff --git a/libs/types-common/src/Data/CommaSeparatedList.hs b/libs/types-common/src/Data/CommaSeparatedList.hs index 36f072914be..fa4f07396f2 100644 --- a/libs/types-common/src/Data/CommaSeparatedList.hs +++ b/libs/types-common/src/Data/CommaSeparatedList.hs @@ -37,11 +37,11 @@ newtype CommaSeparatedList a = CommaSeparatedList {fromCommaSeparatedList :: [a] deriving (Functor, Foldable, Traversable) deriving newtype (Bounds, Semigroup, Monoid) -instance FromByteString (List a) => FromHttpApiData (CommaSeparatedList a) where +instance (FromByteString (List a)) => FromHttpApiData (CommaSeparatedList a) where parseUrlPiece t = CommaSeparatedList . fromList <$> Bifunctor.first Text.pack (runParser parser $ encodeUtf8 t) -instance ToByteString (List a) => ToHttpApiData (CommaSeparatedList a) where +instance (ToByteString (List a)) => ToHttpApiData (CommaSeparatedList a) where toQueryParam (CommaSeparatedList l) = decodeUtf8With lenientDecode $ toStrict $ toByteString $ builder $ List l instance ToParamSchema (CommaSeparatedList a) where diff --git a/libs/types-common/src/Data/ETag.hs b/libs/types-common/src/Data/ETag.hs index c042a042f43..948435e7c62 100644 --- a/libs/types-common/src/Data/ETag.hs +++ b/libs/types-common/src/Data/ETag.hs @@ -67,7 +67,7 @@ data Digest = MD5 | SHA1 -- of arbitrary types to a 'Builder', concatenating them, and applying the hash -- function on the result. data Opaque (d :: Digest) where - Opaque :: ToByteString a => a -> Opaque d + Opaque :: (ToByteString a) => a -> Opaque d instance ToByteString (Opaque 'MD5) where builder (Opaque x) = @@ -80,11 +80,11 @@ instance ToByteString (Opaque 'SHA1) where instance Semigroup (Opaque d) where Opaque a <> Opaque b = Opaque (builder a <> builder b) -opaqueMD5 :: ToByteString a => a -> Opaque 'MD5 +opaqueMD5 :: (ToByteString a) => a -> Opaque 'MD5 opaqueMD5 = Opaque {-# INLINE opaqueMD5 #-} -opaqueSHA1 :: ToByteString a => a -> Opaque 'SHA1 +opaqueSHA1 :: (ToByteString a) => a -> Opaque 'SHA1 opaqueSHA1 = Opaque {-# INLINE opaqueSHA1 #-} @@ -103,11 +103,11 @@ data ETag a | WeakETag !a deriving (Eq, Show) -instance ToByteString a => ToByteString (ETag a) where +instance (ToByteString a) => ToByteString (ETag a) where builder (StrictETag v) = byteString "\"" <> builder v <> byteString "\"" builder (WeakETag v) = byteString "W/\"" <> builder v <> byteString "\"" -instance FromByteString a => FromByteString (ETag a) where +instance (FromByteString a) => FromByteString (ETag a) where parser = do w <- optional (string "W/") v <- char '"' *> takeWhile (/= '"') <* char '"' @@ -115,7 +115,7 @@ instance FromByteString a => FromByteString (ETag a) where Left e -> fail e Right a -> pure $ maybe (StrictETag a) (const $ WeakETag a) w -instance Semigroup a => Semigroup (ETag a) where +instance (Semigroup a) => Semigroup (ETag a) where StrictETag a <> StrictETag b = StrictETag (a <> b) StrictETag a <> WeakETag b = WeakETag (a <> b) WeakETag a <> StrictETag b = WeakETag (a <> b) diff --git a/libs/types-common/src/Data/Id.hs b/libs/types-common/src/Data/Id.hs index 2f57ba3d920..3ef7152c913 100644 --- a/libs/types-common/src/Data/Id.hs +++ b/libs/types-common/src/Data/Id.hs @@ -235,7 +235,7 @@ instance A.ToJSONKey (Id a) where instance A.FromJSONKey (Id a) where fromJSONKey = A.FromJSONKeyTextParser idFromText -randomId :: MonadIO m => m (Id a) +randomId :: (MonadIO m) => m (Id a) randomId = Id <$> liftIO nextRandom idFromText :: Text -> A.Parser (Id a) @@ -444,7 +444,7 @@ newtype IdObject a = IdObject {fromIdObject :: a} deriving (Eq, Show, Generic) deriving (ToJSON, FromJSON, S.ToSchema) via Schema (IdObject a) -instance ToSchema a => ToSchema (IdObject a) where +instance (ToSchema a) => ToSchema (IdObject a) where schema = idObjectSchema (IdObject <$> fromIdObject .= schema) idObjectSchema :: ValueSchemaP NamedSwaggerDoc a b -> ValueSchemaP NamedSwaggerDoc a b diff --git a/libs/types-common/src/Data/List1.hs b/libs/types-common/src/Data/List1.hs index 8a1d31555d2..c98f0099453 100644 --- a/libs/types-common/src/Data/List1.hs +++ b/libs/types-common/src/Data/List1.hs @@ -64,7 +64,7 @@ head :: List1 a -> a head = N.head . toNonEmpty {-# INLINE head #-} -instance ToSchema a => ToSchema (List1 a) where +instance (ToSchema a) => ToSchema (List1 a) where schema = named "List1" $ toNonEmpty S..= fmap List1 (nonEmptyArray S.schema) diff --git a/libs/types-common/src/Data/Misc.hs b/libs/types-common/src/Data/Misc.hs index 837c24d18c2..fc896fb1e59 100644 --- a/libs/types-common/src/Data/Misc.hs +++ b/libs/types-common/src/Data/Misc.hs @@ -341,9 +341,9 @@ newtype PlainTextPassword' (minLen :: Nat) = PlainTextPassword' {fromPlainTextPassword' :: Range minLen (1024 :: Nat) Text} deriving stock (Eq, Generic) -deriving via (Schema (PlainTextPassword' tag)) instance ToSchema (PlainTextPassword' tag) => FromJSON (PlainTextPassword' tag) +deriving via (Schema (PlainTextPassword' tag)) instance (ToSchema (PlainTextPassword' tag)) => FromJSON (PlainTextPassword' tag) -deriving via (Schema (PlainTextPassword' tag)) instance ToSchema (PlainTextPassword' tag) => ToJSON (PlainTextPassword' tag) +deriving via (Schema (PlainTextPassword' tag)) instance (ToSchema (PlainTextPassword' tag)) => ToJSON (PlainTextPassword' tag) deriving via (Schema (PlainTextPassword' tag)) instance (KnownNat tag, ToSchema (PlainTextPassword' tag)) => S.ToSchema (PlainTextPassword' tag) @@ -368,12 +368,12 @@ newtype FutureWork label payload = FutureWork payload ------------------------------------------------------------------------------- -- | Same as 'read' but works on 'Text' -readT :: Read a => Text -> Maybe a +readT :: (Read a) => Text -> Maybe a readT = readMaybe . Text.unpack {-# INLINE readT #-} -- | Same as 'show' but works on 'Text' -showT :: Show a => a -> Text +showT :: (Show a) => a -> Text showT = Text.pack . show {-# INLINE showT #-} diff --git a/libs/types-common/src/Data/Nonce.hs b/libs/types-common/src/Data/Nonce.hs index 50d84f7c655..ca5c502f1ed 100644 --- a/libs/types-common/src/Data/Nonce.hs +++ b/libs/types-common/src/Data/Nonce.hs @@ -84,7 +84,7 @@ instance FromHttpApiData Nonce where . fromStrict . encodeUtf8 -randomNonce :: MonadIO m => m Nonce +randomNonce :: (MonadIO m) => m Nonce randomNonce = Nonce <$> liftIO nextRandom isValidBase64UrlEncodedUUID :: ByteString -> Bool diff --git a/libs/types-common/src/Data/Qualified.hs b/libs/types-common/src/Data/Qualified.hs index 1c1ba088e10..0d1632ad4b1 100644 --- a/libs/types-common/src/Data/Qualified.hs +++ b/libs/types-common/src/Data/Qualified.hs @@ -131,25 +131,25 @@ foldQualified loc f g q -- Note that the local values are returned as unqualified values, as a (probably -- insignificant) optimisation. Use 'partitionQualifiedAndTag' to get them as -- 'Local' values. -partitionQualified :: Foldable f => Local x -> f (Qualified a) -> ([a], [Remote a]) +partitionQualified :: (Foldable f) => Local x -> f (Qualified a) -> ([a], [Remote a]) partitionQualified loc = foldMap $ foldQualified loc (\l -> ([tUnqualified l], mempty)) (\r -> (mempty, [r])) -partitionQualifiedAndTag :: Foldable f => Local x -> f (Qualified a) -> ([Local a], [Remote a]) +partitionQualifiedAndTag :: (Foldable f) => Local x -> f (Qualified a) -> ([Local a], [Remote a]) partitionQualifiedAndTag loc = first (map (qualifyAs loc)) . partitionQualified loc -- | Index a list of qualified values by domain. -indexQualified :: Foldable f => f (Qualified a) -> Map Domain [a] +indexQualified :: (Foldable f) => f (Qualified a) -> Map Domain [a] indexQualified = foldr add mempty where add :: Qualified a -> Map Domain [a] -> Map Domain [a] add (Qualified x domain) = Map.insertWith (<>) domain [x] -- | Bucket a list of qualified values by domain. -bucketQualified :: Foldable f => f (Qualified a) -> [Qualified [a]] +bucketQualified :: (Foldable f) => f (Qualified a) -> [Qualified [a]] bucketQualified = map (\(d, a) -> Qualified a d) . Map.assocs . indexQualified bucketRemote :: (Functor f, Foldable f) => f (Remote a) -> [Remote [a]] @@ -171,7 +171,7 @@ deprecatedSchema new = . (deprecated ?~ True) qualifiedSchema :: - HasSchemaRef doc => + (HasSchemaRef doc) => Text -> Text -> ValueSchema doc a -> @@ -181,7 +181,7 @@ qualifiedSchema name fieldName sch = qualifiedObjectSchema fieldName sch qualifiedObjectSchema :: - HasSchemaRef d => + (HasSchemaRef d) => Text -> ValueSchema d a -> ObjectSchema SwaggerDoc (Qualified a) @@ -190,16 +190,16 @@ qualifiedObjectSchema fieldName sch = <$> qDomain .= field "domain" schema <*> qUnqualified .= field fieldName sch -instance KnownIdTag t => ToSchema (Qualified (Id t)) where +instance (KnownIdTag t) => ToSchema (Qualified (Id t)) where schema = qualifiedSchema (idTagName (idTagValue @t) <> "Id") "id" schema instance ToSchema (Qualified Handle) where schema = qualifiedSchema "Handle" "handle" schema -instance KnownIdTag t => ToJSON (Qualified (Id t)) where +instance (KnownIdTag t) => ToJSON (Qualified (Id t)) where toJSON = schemaToJSON -instance KnownIdTag t => FromJSON (Qualified (Id t)) where +instance (KnownIdTag t) => FromJSON (Qualified (Id t)) where parseJSON = schemaParseJSON instance (Typeable t, KnownIdTag t) => S.ToSchema (Qualified (Id t)) where @@ -217,5 +217,5 @@ instance S.ToSchema (Qualified Handle) where ---------------------------------------------------------------------- -- ARBITRARY -instance Arbitrary a => Arbitrary (Qualified a) where +instance (Arbitrary a) => Arbitrary (Qualified a) where arbitrary = Qualified <$> arbitrary <*> arbitrary diff --git a/libs/types-common/src/Data/Range.hs b/libs/types-common/src/Data/Range.hs index d7a92f08d11..73cdda9fea7 100644 --- a/libs/types-common/src/Data/Range.hs +++ b/libs/types-common/src/Data/Range.hs @@ -109,7 +109,7 @@ instance (Show a, Num a, Within a n m, KnownNat n, KnownNat m) => Bounded (Range instance NFData (Range n m a) where rnf (Range a) = seq a () -instance ToJSON a => ToJSON (Range n m a) where +instance (ToJSON a) => ToJSON (Range n m a) where toJSON = toJSON . fromRange instance forall a n m. (KnownNat n, KnownNat m, Within a n m, FromJSON a) => FromJSON (Range n m a) where @@ -135,47 +135,48 @@ untypedRangedSchema :: untypedRangedSchema n m sch = (sch `withParser` check) & doc %~ rangedSchemaDocModifier (Proxy @b) n m where check x = - x <$ guard (within x n m) - <|> fail (errorMsg n m "") + x + <$ guard (within x n m) + <|> fail (errorMsg n m "") -class Bounds a => HasRangedSchemaDocModifier d a where +class (Bounds a) => HasRangedSchemaDocModifier d a where rangedSchemaDocModifier :: Proxy a -> Integer -> Integer -> d -> d -listRangedSchemaDocModifier :: S.HasSchema d S.Schema => Integer -> Integer -> d -> d +listRangedSchemaDocModifier :: (S.HasSchema d S.Schema) => Integer -> Integer -> d -> d listRangedSchemaDocModifier n m = S.schema %~ ((S.minItems ?~ n) . (S.maxItems ?~ m)) -stringRangedSchemaDocModifier :: S.HasSchema d S.Schema => Integer -> Integer -> d -> d +stringRangedSchemaDocModifier :: (S.HasSchema d S.Schema) => Integer -> Integer -> d -> d stringRangedSchemaDocModifier n m = S.schema %~ ((S.minLength ?~ n) . (S.maxLength ?~ m)) -numRangedSchemaDocModifier :: S.HasSchema d S.Schema => Integer -> Integer -> d -> d +numRangedSchemaDocModifier :: (S.HasSchema d S.Schema) => Integer -> Integer -> d -> d numRangedSchemaDocModifier n m = S.schema %~ ((S.minimum_ ?~ fromIntegral n) . (S.maximum_ ?~ fromIntegral m)) -instance S.HasSchema d S.Schema => HasRangedSchemaDocModifier d [a] where rangedSchemaDocModifier _ = listRangedSchemaDocModifier +instance (S.HasSchema d S.Schema) => HasRangedSchemaDocModifier d [a] where rangedSchemaDocModifier _ = listRangedSchemaDocModifier -- Sets are similar to lists, so use that as our defininition -instance S.HasSchema d S.Schema => HasRangedSchemaDocModifier d (Set a) where rangedSchemaDocModifier _ = listRangedSchemaDocModifier +instance (S.HasSchema d S.Schema) => HasRangedSchemaDocModifier d (Set a) where rangedSchemaDocModifier _ = listRangedSchemaDocModifier -instance S.HasSchema d S.Schema => HasRangedSchemaDocModifier d Text where rangedSchemaDocModifier _ = stringRangedSchemaDocModifier +instance (S.HasSchema d S.Schema) => HasRangedSchemaDocModifier d Text where rangedSchemaDocModifier _ = stringRangedSchemaDocModifier -instance S.HasSchema d S.Schema => HasRangedSchemaDocModifier d String where rangedSchemaDocModifier _ = stringRangedSchemaDocModifier +instance (S.HasSchema d S.Schema) => HasRangedSchemaDocModifier d String where rangedSchemaDocModifier _ = stringRangedSchemaDocModifier -instance S.HasSchema d S.Schema => HasRangedSchemaDocModifier d (AsciiText c) where rangedSchemaDocModifier _ = stringRangedSchemaDocModifier +instance (S.HasSchema d S.Schema) => HasRangedSchemaDocModifier d (AsciiText c) where rangedSchemaDocModifier _ = stringRangedSchemaDocModifier -instance S.HasSchema d S.Schema => HasRangedSchemaDocModifier d Int where rangedSchemaDocModifier _ = numRangedSchemaDocModifier +instance (S.HasSchema d S.Schema) => HasRangedSchemaDocModifier d Int where rangedSchemaDocModifier _ = numRangedSchemaDocModifier -instance S.HasSchema d S.Schema => HasRangedSchemaDocModifier d Int32 where rangedSchemaDocModifier _ = numRangedSchemaDocModifier +instance (S.HasSchema d S.Schema) => HasRangedSchemaDocModifier d Int32 where rangedSchemaDocModifier _ = numRangedSchemaDocModifier -instance S.HasSchema d S.Schema => HasRangedSchemaDocModifier d Integer where rangedSchemaDocModifier _ = numRangedSchemaDocModifier +instance (S.HasSchema d S.Schema) => HasRangedSchemaDocModifier d Integer where rangedSchemaDocModifier _ = numRangedSchemaDocModifier -instance S.HasSchema d S.Schema => HasRangedSchemaDocModifier d Word where rangedSchemaDocModifier _ = numRangedSchemaDocModifier +instance (S.HasSchema d S.Schema) => HasRangedSchemaDocModifier d Word where rangedSchemaDocModifier _ = numRangedSchemaDocModifier -instance S.HasSchema d S.Schema => HasRangedSchemaDocModifier d Word8 where rangedSchemaDocModifier _ = numRangedSchemaDocModifier +instance (S.HasSchema d S.Schema) => HasRangedSchemaDocModifier d Word8 where rangedSchemaDocModifier _ = numRangedSchemaDocModifier -instance S.HasSchema d S.Schema => HasRangedSchemaDocModifier d Word16 where rangedSchemaDocModifier _ = numRangedSchemaDocModifier +instance (S.HasSchema d S.Schema) => HasRangedSchemaDocModifier d Word16 where rangedSchemaDocModifier _ = numRangedSchemaDocModifier -instance S.HasSchema d S.Schema => HasRangedSchemaDocModifier d Word32 where rangedSchemaDocModifier _ = numRangedSchemaDocModifier +instance (S.HasSchema d S.Schema) => HasRangedSchemaDocModifier d Word32 where rangedSchemaDocModifier _ = numRangedSchemaDocModifier -instance S.HasSchema d S.Schema => HasRangedSchemaDocModifier d Word64 where rangedSchemaDocModifier _ = numRangedSchemaDocModifier +instance (S.HasSchema d S.Schema) => HasRangedSchemaDocModifier d Word64 where rangedSchemaDocModifier _ = numRangedSchemaDocModifier instance (KnownNat n, KnownNat m, Within a n m, ToSchema a, HasRangedSchemaDocModifier NamedSwaggerDoc a) => ToSchema (Range n m a) where schema = fromRange .= rangedSchema schema @@ -246,7 +247,7 @@ instance (KnownNat n, KnownNat m, Within a n m, FromHttpApiData a) => FromHttpAp type Within a (n :: Nat) (m :: Nat) = (Bounds a, n <= m) -mk :: Bounds a => a -> Nat -> Nat -> Maybe (Range n m a) +mk :: (Bounds a) => a -> Nat -> Nat -> Maybe (Range n m a) mk a n m = if within a (toInteger n) (toInteger m) then Just (Range a) @@ -263,7 +264,7 @@ errorMsg n m = . shows m . showString "]" -checkedEitherMsg :: forall a n m. (KnownNat n, KnownNat m) => Within a n m => String -> a -> Either String (Range n m a) +checkedEitherMsg :: forall a n m. (KnownNat n, KnownNat m) => (Within a n m) => String -> a -> Either String (Range n m a) checkedEitherMsg msg x = do let sn = natVal (Proxy @n) sm = natVal (Proxy @m) @@ -271,7 +272,7 @@ checkedEitherMsg msg x = do Nothing -> Left $ showString msg . showString ": " . errorMsg sn sm $ "" Just r -> Right r -checkedEither :: forall a n m. (KnownNat n, KnownNat m) => Within a n m => a -> Either String (Range n m a) +checkedEither :: forall a n m. (KnownNat n, KnownNat m) => (Within a n m) => a -> Either String (Range n m a) checkedEither x = do let sn = natVal (Proxy @n) sm = natVal (Proxy @m) @@ -300,10 +301,10 @@ unsafeRange x = fromMaybe msg (checked x) rcast :: (n <= m, m <= m', n >= n') => Range n m a -> Range n' m' a rcast (Range a) = Range a -rnil :: Monoid a => Range 0 0 a +rnil :: (Monoid a) => Range 0 0 a rnil = Range mempty -rcons, (<|) :: n <= m => a -> Range n m [a] -> Range n (m + 1) [a] +rcons, (<|) :: (n <= m) => a -> Range n m [a] -> Range n (m + 1) [a] rcons a (Range aa) = Range (a : aa) infixr 5 <| @@ -397,7 +398,7 @@ instance Bounds (HashMap k a) where instance Bounds (HashSet a) where within x y z = rangeCheck (length (take (fromIntegral z + 1) (HashSet.toList x))) y z -instance Bounds a => Bounds (Maybe a) where +instance (Bounds a) => Bounds (Maybe a) where within Nothing _ _ = True within (Just x) y z = within x y z @@ -420,7 +421,7 @@ instance (KnownNat n, KnownNat m, Within a n m, FromByteString a) => FromByteStr where msg = fail (errorMsg (natVal (Proxy @n)) (natVal (Proxy @m)) "") -instance ToByteString a => ToByteString (Range n m a) where +instance (ToByteString a) => ToByteString (Range n m a) where builder = builder . fromRange ---------------------------------------------------------------------------- @@ -430,7 +431,7 @@ instance ToByteString a => ToByteString (Range n m a) where newtype Ranged m n a = Ranged {fromRanged :: a} deriving stock (Show) -instance Arbitrary (Range m n a) => Arbitrary (Ranged m n a) where +instance (Arbitrary (Range m n a)) => Arbitrary (Ranged m n a) where arbitrary = Ranged . fromRange <$> arbitrary @(Range m n a) instance diff --git a/libs/types-common/src/Data/SizedHashMap.hs b/libs/types-common/src/Data/SizedHashMap.hs index 81494390103..b7070a6b2fc 100644 --- a/libs/types-common/src/Data/SizedHashMap.hs +++ b/libs/types-common/src/Data/SizedHashMap.hs @@ -44,7 +44,7 @@ size (SizedHashMap s _) = s empty :: forall k v. SizedHashMap k v empty = SizedHashMap 0 M.empty -insert :: forall k v. Hashable k => k -> v -> SizedHashMap k v -> SizedHashMap k v +insert :: forall k v. (Hashable k) => k -> v -> SizedHashMap k v -> SizedHashMap k v insert k v (SizedHashMap n hm) = SizedHashMap n' hm' where n' = if M.member k hm then n else n + 1 @@ -59,10 +59,10 @@ elems (SizedHashMap _ hm) = M.elems hm toList :: forall k v. SizedHashMap k v -> [(k, v)] toList (SizedHashMap _ hm) = M.toList hm -lookup :: forall k v. Hashable k => k -> SizedHashMap k v -> Maybe v +lookup :: forall k v. (Hashable k) => k -> SizedHashMap k v -> Maybe v lookup k (SizedHashMap _ hm) = M.lookup k hm -delete :: forall k v. Hashable k => k -> SizedHashMap k v -> SizedHashMap k v +delete :: forall k v. (Hashable k) => k -> SizedHashMap k v -> SizedHashMap k v delete k (SizedHashMap n hm) = SizedHashMap n' hm' where n' = if M.member k hm then n - 1 else n diff --git a/libs/types-common/src/Data/Text/Ascii.hs b/libs/types-common/src/Data/Text/Ascii.hs index 0fac4b07e2f..aed072030c0 100644 --- a/libs/types-common/src/Data/Text/Ascii.hs +++ b/libs/types-common/src/Data/Text/Ascii.hs @@ -138,36 +138,36 @@ class AsciiChars c where -- | Note: Assumes UTF8 encoding. If the bytestring is known to -- be in a different encoding, 'validate' the text after decoding it with -- the correct encoding instead of using this instance. -instance AsciiChars c => FromByteString (AsciiText c) where +instance (AsciiChars c) => FromByteString (AsciiText c) where parser = parseBytes validate -- | Note: 'fromString' is a partial function that will 'error' when given -- a string containing characters not in the set @c@. It is only intended to be used -- via the @OverloadedStrings@ extension, i.e. for known ASCII string literals. -instance AsciiChars c => IsString (AsciiText c) where +instance (AsciiChars c) => IsString (AsciiText c) where fromString = unsafeString validate -instance AsciiChars c => ToSchema (AsciiText c) where +instance (AsciiChars c) => ToSchema (AsciiText c) where schema = toText .= parsedText "ASCII" validate -instance AsciiChars c => ToJSON (AsciiText c) where +instance (AsciiChars c) => ToJSON (AsciiText c) where toJSON = schemaToJSON -instance AsciiChars c => FromJSON (AsciiText c) where +instance (AsciiChars c) => FromJSON (AsciiText c) where parseJSON = schemaParseJSON instance (Typeable c, AsciiChars c) => S.ToSchema (AsciiText c) where declareNamedSchema = schemaToSwagger -instance AsciiChars c => Cql (AsciiText c) where +instance (AsciiChars c) => Cql (AsciiText c) where ctype = Tagged AsciiColumn toCql = CqlAscii . toText fromCql = fmap (unsafeFromText . fromAscii) . fromCql -fromAsciiChars :: AsciiChars c => [AsciiChar c] -> AsciiText c +fromAsciiChars :: (AsciiChars c) => [AsciiChar c] -> AsciiText c fromAsciiChars = fromString . map toChar -fromChar :: AsciiChars c => c -> Char -> Maybe (AsciiChar c) +fromChar :: (AsciiChars c) => c -> Char -> Maybe (AsciiChar c) fromChar c char | contains c char = Just (AsciiChar char) | otherwise = Nothing @@ -379,13 +379,13 @@ widenChar (AsciiChar t) = AsciiChar t -- | Construct 'AsciiText' from a known ASCII 'Text'. -- This is a total function but unsafe because the text is not checked -- for non-ASCII characters. -unsafeFromText :: AsciiChars c => Text -> AsciiText c +unsafeFromText :: (AsciiChars c) => Text -> AsciiText c unsafeFromText = AsciiText -- | Construct 'AsciiText' from a known ASCII 'ByteString'. -- This is a total function but unsafe because the bytestring is not checked -- for non-ASCII characters. -unsafeFromByteString :: AsciiChars c => ByteString -> AsciiText c +unsafeFromByteString :: (AsciiChars c) => ByteString -> AsciiText c unsafeFromByteString = AsciiText . decodeLatin1 -------------------------------------------------------------------------------- diff --git a/libs/types-common/src/Data/UUID/Tagged.hs b/libs/types-common/src/Data/UUID/Tagged.hs index 5f573d38dfb..fa6eb11ce5f 100644 --- a/libs/types-common/src/Data/UUID/Tagged.hs +++ b/libs/types-common/src/Data/UUID/Tagged.hs @@ -58,7 +58,7 @@ data V5 instance Version V5 where versionValue = 5 -mk :: forall v. Version v => D.UUID -> UUID v +mk :: forall v. (Version v) => D.UUID -> UUID v mk u = UUID $ case D.toWords u of (x0, x1, x2, x3) -> diff --git a/libs/types-common/src/Util/Options.hs b/libs/types-common/src/Util/Options.hs index f9beac14583..2d46e74097a 100644 --- a/libs/types-common/src/Util/Options.hs +++ b/libs/types-common/src/Util/Options.hs @@ -102,7 +102,7 @@ loadSecret (FilePathSecrets p) = do -- instead of the command line. getOptions :: forall a. - FromJSON a => + (FromJSON a) => -- | Program description String -> -- | CLI parser for the options (if there is no config) diff --git a/libs/types-common/src/Wire/Arbitrary.hs b/libs/types-common/src/Wire/Arbitrary.hs index 59c4504eedf..516ea477dd2 100644 --- a/libs/types-common/src/Wire/Arbitrary.hs +++ b/libs/types-common/src/Wire/Arbitrary.hs @@ -88,10 +88,10 @@ customSizedOpts = nonEmptyListOf' :: Gen a -> Gen (NonEmpty a) nonEmptyListOf' g = (:|) <$> g <*> listOf' g -setOf' :: Ord a => Gen a -> Gen (Set a) +setOf' :: (Ord a) => Gen a -> Gen (Set a) setOf' g = Set.fromList <$> Generic.listOf' g -mapOf' :: Ord k => Gen k -> Gen v -> Gen (Map k v) +mapOf' :: (Ord k) => Gen k -> Gen v -> Gen (Map k v) mapOf' genK genV = Map.fromList <$> Generic.listOf' (liftA2 (,) genK genV) -------------------------------------------------------------------------------- @@ -116,7 +116,7 @@ deriving via (GenericUniform CountryCode) instance Arbitrary CountryCode -- we cannot rely on swagger-ui to generate nice examples. So far, this is only -- required for maps as swagger2 doesn't have a good way to specify the type of -- keys. -generateExample :: Arbitrary a => a +generateExample :: (Arbitrary a) => a generateExample = let (MkGen f) = arbitrary in f (mkQCGen 42) 42 diff --git a/libs/types-common/test/Test/Properties.hs b/libs/types-common/test/Test/Properties.hs index fbd1de60122..e8ce0320de7 100644 --- a/libs/types-common/test/Test/Properties.hs +++ b/libs/types-common/test/Test/Properties.hs @@ -137,7 +137,7 @@ tests = (BS.fromByteString' . cs . BS.toByteString') t === Just t, -- - let toUTCTimeMillisSlow :: HasCallStack => UTCTime -> Maybe UTCTime + let toUTCTimeMillisSlow :: (HasCallStack) => UTCTime -> Maybe UTCTime toUTCTimeMillisSlow t = parseExact formatRounded where parseExact = parseTimeM True defaultTimeLocale "%FT%T%QZ" diff --git a/libs/wai-utilities/src/Network/Wai/Utilities/Error.hs b/libs/wai-utilities/src/Network/Wai/Utilities/Error.hs index ba7bdcf90fd..aea3d8b41f3 100644 --- a/libs/wai-utilities/src/Network/Wai/Utilities/Error.hs +++ b/libs/wai-utilities/src/Network/Wai/Utilities/Error.hs @@ -98,5 +98,5 @@ instance FromJSON Error where -- FIXME: This should not live here. infixl 5 !>> -(!>>) :: Monad m => ExceptT a m r -> (a -> b) -> ExceptT b m r +(!>>) :: (Monad m) => ExceptT a m r -> (a -> b) -> ExceptT b m r (!>>) = flip fmapLT diff --git a/libs/wai-utilities/src/Network/Wai/Utilities/Response.hs b/libs/wai-utilities/src/Network/Wai/Utilities/Response.hs index 3b82467372c..ce838ff5463 100644 --- a/libs/wai-utilities/src/Network/Wai/Utilities/Response.hs +++ b/libs/wai-utilities/src/Network/Wai/Utilities/Response.hs @@ -39,7 +39,7 @@ plain = responseLBS status200 [plainContent] plainContent :: Header plainContent = (hContentType, "text/plain; charset=UTF-8") -json :: ToJSON a => a -> Response +json :: (ToJSON a) => a -> Response json = responseLBS status200 [jsonContent] . encode jsonContent :: Header diff --git a/libs/wai-utilities/src/Network/Wai/Utilities/Server.hs b/libs/wai-utilities/src/Network/Wai/Utilities/Server.hs index 95657f59dd5..1a8ae5a68b9 100644 --- a/libs/wai-utilities/src/Network/Wai/Utilities/Server.hs +++ b/libs/wai-utilities/src/Network/Wai/Utilities/Server.hs @@ -104,7 +104,7 @@ data Server = Server defaultServer :: String -> Word16 -> Logger -> Server defaultServer h p l = Server h p l Nothing -newSettings :: MonadIO m => Server -> m Settings +newSettings :: (MonadIO m) => Server -> m Settings newSettings (Server h p l t) = do pure $ setHost (fromString h) @@ -160,7 +160,7 @@ runSettingsWithCleanup cleanup s app (fromMaybe defaultShutdownTime -> secs) = d defaultShutdownTime :: Int defaultShutdownTime = 30 -compile :: Monad m => Routes a m b -> Tree (App m) +compile :: (Monad m) => Routes a m b -> Tree (App m) compile routes = Route.prepare (Route.renderer predicateError >> routes) where predicateError e = pure (encode $ Wai.mkError (P.status e) "client-error" (format e), [jsonContent]) @@ -186,7 +186,7 @@ compile routes = Route.prepare (Route.renderer predicateError >> routes) messageStr (Just t) = char7 ':' <> char7 ' ' <> byteString t messageStr Nothing = mempty -route :: MonadIO m => Tree (App m) -> Request -> Continue IO -> m ResponseReceived +route :: (MonadIO m) => Tree (App m) -> Request -> Continue IO -> m ResponseReceived route rt rq k = Route.routeWith (Route.Config $ errorRs' noEndpoint) rt rq (liftIO . k) where noEndpoint = Wai.mkError status404 "no-endpoint" "The requested endpoint does not exist" @@ -238,7 +238,7 @@ catchErrorsWithRequestId getRequestId l app req k = -- | Standard handlers for turning exceptions into appropriate -- 'Error' responses. -errorHandlers :: Applicative m => [Handler m (Either Wai.Error JSONResponse)] +errorHandlers :: (Applicative m) => [Handler m (Either Wai.Error JSONResponse)] errorHandlers = -- a Wai.Error can be converted to a JSONResponse, but doing so here would -- prevent us from logging the error cleanly later @@ -379,7 +379,7 @@ lazyResponseBody rs = case responseToStream rs of -- | Send an 'Error' response. onError :: - MonadIO m => + (MonadIO m) => Logger -> Maybe ByteString -> Request -> @@ -426,7 +426,7 @@ logError' g mr e = liftIO $ doLog g (logErrorMsgWithRequest mr e) | statusCode (Error.code e) >= 500 = Log.err | otherwise = Log.debug -logJSONResponse :: MonadIO m => Logger -> Maybe ByteString -> JSONResponse -> m () +logJSONResponse :: (MonadIO m) => Logger -> Maybe ByteString -> JSONResponse -> m () logJSONResponse g mReqId e = do let r = fromMaybe "N/A" mReqId liftIO $ diff --git a/libs/wai-utilities/src/Network/Wai/Utilities/ZAuth.hs b/libs/wai-utilities/src/Network/Wai/Utilities/ZAuth.hs index c70d65f7a67..5733203a0bd 100644 --- a/libs/wai-utilities/src/Network/Wai/Utilities/ZAuth.hs +++ b/libs/wai-utilities/src/Network/Wai/Utilities/ZAuth.hs @@ -66,11 +66,11 @@ instance FromByteString ZAuthType where _ -> fail $ "Invalid ZAuth type: " ++ show t -- | A token type is present if the request was authenticated. -zauthType :: HasHeaders r => Predicate r Error ZAuthType +zauthType :: (HasHeaders r) => Predicate r Error ZAuthType zauthType = zheader "Z-Type" -- | Require a specific token type to be used. -zauth :: HasHeaders r => ZAuthType -> Predicate r Error () +zauth :: (HasHeaders r) => ZAuthType -> Predicate r Error () zauth t = do r <- zauthType pure $ case r of @@ -79,24 +79,24 @@ zauth t = do -- | A zauth user ID is present if 'zauthType' is either 'ZAuthAccess' -- or 'ZAuthUser'. -zauthUserId :: HasHeaders r => Predicate r Error UserId +zauthUserId :: (HasHeaders r) => Predicate r Error UserId zauthUserId = zheader "Z-User" -- | A zauth connection ID is present if 'zauthType' is 'ZAuthAccess'. -zauthConnId :: HasHeaders r => Predicate r Error ConnId +zauthConnId :: (HasHeaders r) => Predicate r Error ConnId zauthConnId = zheader "Z-Connection" -- | A zauth bot ID is present if 'zauthType' is 'ZAuthBot'. -zauthBotId :: HasHeaders r => Predicate r Error BotId +zauthBotId :: (HasHeaders r) => Predicate r Error BotId zauthBotId = zheader "Z-Bot" -- | A zauth conversation ID is present if 'zauthType' is 'ZAuthBot'. -zauthConvId :: HasHeaders r => Predicate r Error ConvId +zauthConvId :: (HasHeaders r) => Predicate r Error ConvId zauthConvId = zheader "Z-Conversation" -- | A provider ID is present if 'zauthType' is either 'ZAuthBot' -- or 'ZAuthProvider'. -zauthProviderId :: HasHeaders r => Predicate r Error ProviderId +zauthProviderId :: (HasHeaders r) => Predicate r Error ProviderId zauthProviderId = zheader "Z-Provider" -- Extra Predicate Combinators ------------------------------------------------ diff --git a/libs/wire-api-federation/src/Wire/API/Federation/API.hs b/libs/wire-api-federation/src/Wire/API/Federation/API.hs index 89ba99b4e6a..bf33723b172 100644 --- a/libs/wire-api-federation/src/Wire/API/Federation/API.hs +++ b/libs/wire-api-federation/src/Wire/API/Federation/API.hs @@ -79,13 +79,13 @@ type HasFedEndpoint comp api name = (HasUnsafeFedEndpoint comp api name) -- you to forget about some federated calls. type HasUnsafeFedEndpoint comp api name = 'Just api ~ LookupEndpoint (FedApi comp) name -nameVal :: forall {k} (name :: k). IsNamed name => Text +nameVal :: forall {k} (name :: k). (IsNamed name) => Text nameVal = nameVal' @k @name class IsNamed (name :: k) where nameVal' :: Text -instance KnownSymbol name => IsNamed (name :: Symbol) where +instance (KnownSymbol name) => IsNamed (name :: Symbol) where nameVal' = Text.pack (symbolVal (Proxy @name)) instance (IsNamed name, SingI v) => IsNamed (Versioned (v :: Version) name) where @@ -136,7 +136,7 @@ fedClientIn :: fedClientIn = clientIn (Proxy @api) (Proxy @m) sendBundle :: - KnownComponent c => + (KnownComponent c) => PayloadBundle c -> FedQueueClient c () sendBundle bundle = do diff --git a/libs/wire-api-federation/src/Wire/API/Federation/BackendNotifications.hs b/libs/wire-api-federation/src/Wire/API/Federation/BackendNotifications.hs index 43849c716da..2e3f4b8d488 100644 --- a/libs/wire-api-federation/src/Wire/API/Federation/BackendNotifications.hs +++ b/libs/wire-api-federation/src/Wire/API/Federation/BackendNotifications.hs @@ -140,7 +140,7 @@ sendNotification env component path body = case someComponent component of withoutFirstSlash (Text.stripPrefix "/" -> Just t) = t withoutFirstSlash t = t - go :: forall c. KnownComponent c => Proxy c -> IO (Either FederatorClientError ()) + go :: forall c. (KnownComponent c) => Proxy c -> IO (Either FederatorClientError ()) go _ = lowerCodensity . runExceptT diff --git a/libs/wire-api-federation/src/Wire/API/Federation/Client.hs b/libs/wire-api-federation/src/Wire/API/Federation/Client.hs index 37444a6a49e..2f6fcde3051 100644 --- a/libs/wire-api-federation/src/Wire/API/Federation/Client.hs +++ b/libs/wire-api-federation/src/Wire/API/Federation/Client.hs @@ -167,7 +167,7 @@ consumeStreamingResponseWith k resp = do responseBody = result } -instance KnownComponent c => RunClient (FederatorClient c) where +instance (KnownComponent c) => RunClient (FederatorClient c) where runRequestAcceptStatus expectedStatuses req = do let successfulStatus status = maybe @@ -198,7 +198,7 @@ instance KnownComponent c => RunClient (FederatorClient c) where throwClientError = throwError . FederatorClientServantError -instance KnownComponent c => RunStreamingClient (FederatorClient c) where +instance (KnownComponent c) => RunStreamingClient (FederatorClient c) where withStreamingRequest = withHTTP2StreamingRequest HTTP.statusIsSuccessful streamingResponseStrictBody :: StreamingResponse -> IO Builder @@ -211,7 +211,7 @@ streamingResponseStrictBody = -- Perform a streaming request to the local federator. withHTTP2StreamingRequest :: forall c a. - KnownComponent c => + (KnownComponent c) => (HTTP.Status -> Bool) -> Request -> (StreamingResponse -> IO a) -> @@ -245,8 +245,10 @@ withHTTP2StreamingRequest successfulStatus req handleResponse = do (lazyByteString body) let Endpoint (Text.encodeUtf8 -> hostname) (fromIntegral -> port) = ceFederator env resp <- - either throwError pure <=< liftCodensity $ - Codensity $ \k -> + either throwError pure + <=< liftCodensity + $ Codensity + $ \k -> E.catches (withNewHttpRequest (False, hostname, port) req' (consumeStreamingResponseWith (k . Right))) [ E.Handler $ k . Left . FederatorClientHTTP2Error, @@ -365,7 +367,8 @@ versionNegotiation localVersions = case Set.lookupMax (Set.intersection remoteVersions localVersions) of Just v -> pure v Nothing -> - E.throw . FederatorClientVersionNegotiationError $ - if Set.lookupMax localVersions > Set.lookupMax remoteVersions + E.throw + . FederatorClientVersionNegotiationError + $ if Set.lookupMax localVersions > Set.lookupMax remoteVersions then RemoteTooOld else RemoteTooNew diff --git a/libs/wire-api-federation/src/Wire/API/Federation/Component.hs b/libs/wire-api-federation/src/Wire/API/Federation/Component.hs index 1a5b91e6bd3..aef5cc95980 100644 --- a/libs/wire-api-federation/src/Wire/API/Federation/Component.hs +++ b/libs/wire-api-federation/src/Wire/API/Federation/Component.hs @@ -49,7 +49,7 @@ instance KnownComponent 'Cargohold where componentVal = Cargohold data SomeComponent where - SomeComponent :: KnownComponent c => Proxy c -> SomeComponent + SomeComponent :: (KnownComponent c) => Proxy c -> SomeComponent someComponent :: Component -> SomeComponent someComponent Brig = SomeComponent (Proxy @'Brig) diff --git a/libs/wire-api-federation/src/Wire/API/Federation/Domain.hs b/libs/wire-api-federation/src/Wire/API/Federation/Domain.hs index 5a8e8a5bb16..e9d128fe670 100644 --- a/libs/wire-api-federation/src/Wire/API/Federation/Domain.hs +++ b/libs/wire-api-federation/src/Wire/API/Federation/Domain.hs @@ -37,19 +37,19 @@ type OriginDomainHeaderName = "Wire-Origin-Domain" :: Symbol data OriginDomainHeader -instance RoutesToPaths api => RoutesToPaths (OriginDomainHeader :> api) where +instance (RoutesToPaths api) => RoutesToPaths (OriginDomainHeader :> api) where getRoutes = getRoutes @api type instance SpecialiseToVersion v (OriginDomainHeader :> api) = OriginDomainHeader :> SpecialiseToVersion v api -instance HasClient m api => HasClient m (OriginDomainHeader :> api) where +instance (HasClient m api) => HasClient m (OriginDomainHeader :> api) where type Client m (OriginDomainHeader :> api) = Client m api clientWithRoute pm _ req = clientWithRoute pm (Proxy @api) req hoistClientMonad pm _ = hoistClientMonad pm (Proxy @api) -instance HasClientAlgebra m api => HasClientAlgebra m (OriginDomainHeader :> api) where +instance (HasClientAlgebra m api) => HasClientAlgebra m (OriginDomainHeader :> api) where joinClient = joinClient @m @api bindClient = bindClient @m @api @@ -65,7 +65,7 @@ instance route _pa = route (Proxy @(OriginDomainHeaderHasServer :> api)) hoistServerWithContext _ pc nt s = hoistServerWithContext (Proxy :: Proxy api) pc nt . s -originDomainHeaderName :: IsString a => a +originDomainHeaderName :: (IsString a) => a originDomainHeaderName = fromString $ symbolVal (Proxy @OriginDomainHeaderName) instance (HasOpenApi api) => HasOpenApi (OriginDomainHeader :> api) where diff --git a/libs/wire-api-federation/src/Wire/API/Federation/Endpoint.hs b/libs/wire-api-federation/src/Wire/API/Federation/Endpoint.hs index f24085139cb..910a6c2d4b1 100644 --- a/libs/wire-api-federation/src/Wire/API/Federation/Endpoint.hs +++ b/libs/wire-api-federation/src/Wire/API/Federation/Endpoint.hs @@ -33,7 +33,7 @@ import Wire.API.Routes.Named data Versioned v name -instance {-# OVERLAPPING #-} RenderableSymbol a => RenderableSymbol (Versioned v a) where +instance {-# OVERLAPPING #-} (RenderableSymbol a) => RenderableSymbol (Versioned v a) where renderSymbol = renderSymbol @a type family FedPath (name :: k) :: Symbol diff --git a/libs/wire-api-federation/src/Wire/API/Federation/HasNotificationEndpoint.hs b/libs/wire-api-federation/src/Wire/API/Federation/HasNotificationEndpoint.hs index 7fba640ee90..cbc16a0d769 100644 --- a/libs/wire-api-federation/src/Wire/API/Federation/HasNotificationEndpoint.hs +++ b/libs/wire-api-federation/src/Wire/API/Federation/HasNotificationEndpoint.hs @@ -59,7 +59,7 @@ type HasFedPath t = KnownSymbol (NotificationPath t) type HasVersionRange t = MkVersionRange (NotificationMods t) -fedPath :: forall t. HasFedPath t => String +fedPath :: forall t. (HasFedPath t) => String fedPath = symbolVal (Proxy @(NotificationPath t)) -- | Build a version range using any 'Until' and 'From' combinators present in @@ -84,9 +84,9 @@ instance where mkVersionRange = mkVersionRange @mods <> rangeUntilVersion (demote @v) -instance {-# OVERLAPPABLE #-} MkVersionRange mods => MkVersionRange (m ': mods) where +instance {-# OVERLAPPABLE #-} (MkVersionRange mods) => MkVersionRange (m ': mods) where mkVersionRange = mkVersionRange @mods -- | The federation API version range this endpoint is supported in. -versionRange :: forall t. HasVersionRange t => VersionRange +versionRange :: forall t. (HasVersionRange t) => VersionRange versionRange = mkVersionRange @(NotificationMods t) diff --git a/libs/wire-api-federation/src/Wire/API/Federation/Version.hs b/libs/wire-api-federation/src/Wire/API/Federation/Version.hs index 06089028de5..c6f14413058 100644 --- a/libs/wire-api-federation/src/Wire/API/Federation/Version.hs +++ b/libs/wire-api-federation/src/Wire/API/Federation/Version.hs @@ -176,14 +176,14 @@ enumVersionRange = -- remote versions are given as integers as the range of versions supported by -- the remote backend can include a version unknown to the local backend. If -- there is no version in common, the return value is 'Nothing'. -latestCommonVersion :: Foldable f => VersionRange -> f Int -> Maybe Version +latestCommonVersion :: (Foldable f) => VersionRange -> f Int -> Maybe Version latestCommonVersion localVersions = safeMaximum . filter (inVersionRange localVersions) . mapMaybe intToVersion . toList -safeMaximum :: Ord a => [a] -> Maybe a +safeMaximum :: (Ord a) => [a] -> Maybe a safeMaximum [] = Nothing safeMaximum as = Just (maximum as) diff --git a/libs/wire-api-federation/test/Test/Wire/API/Federation/Golden/Runner.hs b/libs/wire-api-federation/test/Test/Wire/API/Federation/Golden/Runner.hs index 5d7d956cb02..ba2c5e02e54 100644 --- a/libs/wire-api-federation/test/Test/Wire/API/Federation/Golden/Runner.hs +++ b/libs/wire-api-federation/test/Test/Wire/API/Federation/Golden/Runner.hs @@ -79,7 +79,7 @@ testFromJSONFailure path = do Right x -> assertFailure $ show (typeRep @a) <> ": FromJSON of " <> path <> ": expected failure, got " <> show x Left _ -> pure () -assertRight :: Show a => Either a b -> IO b +assertRight :: (Show a) => Either a b -> IO b assertRight = \case Left a -> assertFailure $ "Expected Right, got Left: " <> show a diff --git a/libs/wire-api/default.nix b/libs/wire-api/default.nix index 8ca3c6f5b24..8996b4081db 100644 --- a/libs/wire-api/default.nix +++ b/libs/wire-api/default.nix @@ -77,6 +77,7 @@ , saml2-web-sso , schema-profunctor , scientific +, semigroupoids , servant , servant-client , servant-client-core @@ -182,6 +183,7 @@ mkDerivation { saml2-web-sso schema-profunctor scientific + semigroupoids servant servant-client servant-client-core diff --git a/libs/wire-api/src/Wire/API/Asset.hs b/libs/wire-api/src/Wire/API/Asset.hs index 4148a1d4832..d2a53bad442 100644 --- a/libs/wire-api/src/Wire/API/Asset.hs +++ b/libs/wire-api/src/Wire/API/Asset.hs @@ -105,14 +105,14 @@ data Asset' key = Asset } deriving stock (Eq, Show, Generic, Functor) -deriving via Schema (Asset' key) instance ToSchema (Asset' key) => (ToJSON (Asset' key)) +deriving via Schema (Asset' key) instance (ToSchema (Asset' key)) => (ToJSON (Asset' key)) -deriving via Schema (Asset' key) instance ToSchema (Asset' key) => (FromJSON (Asset' key)) +deriving via Schema (Asset' key) instance (ToSchema (Asset' key)) => (FromJSON (Asset' key)) deriving via Schema (Asset' key) instance (Typeable key, ToSchema (Asset' key)) => (S.ToSchema (Asset' key)) -- Generate expiry time with millisecond precision -instance Arbitrary key => Arbitrary (Asset' key) where +instance (Arbitrary key) => Arbitrary (Asset' key) where arbitrary = Asset <$> arbitrary <*> (fmap milli <$> arbitrary) <*> arbitrary where milli = fromUTCTimeMillis . toUTCTimeMillis diff --git a/libs/wire-api/src/Wire/API/Call/Config.hs b/libs/wire-api/src/Wire/API/Call/Config.hs index a4eb530ae5c..e28294c9652 100644 --- a/libs/wire-api/src/Wire/API/Call/Config.hs +++ b/libs/wire-api/src/Wire/API/Call/Config.hs @@ -497,7 +497,7 @@ instance BC.ToByteString SFTUsername where <> shortByteString ".r=" <> byteString (view (re utf8) (_suRandom su)) where - boolToWord :: Num a => Bool -> a + boolToWord :: (Num a) => Bool -> a boolToWord False = 0 boolToWord True = 1 diff --git a/libs/wire-api/src/Wire/API/Conversation.hs b/libs/wire-api/src/Wire/API/Conversation.hs index 1165445df2f..0aa78bd25c6 100644 --- a/libs/wire-api/src/Wire/API/Conversation.hs +++ b/libs/wire-api/src/Wire/API/Conversation.hs @@ -268,7 +268,7 @@ cnvReceiptMode = cnvmReceiptMode . cnvMetadata instance ToSchema Conversation where schema = conversationSchema Nothing -instance SingI v => ToSchema (Versioned v Conversation) where +instance (SingI v) => ToSchema (Versioned v Conversation) where schema = Versioned <$> unVersioned .= conversationSchema (Just (demote @v)) conversationObjectSchema :: Maybe Version -> ObjectSchema SwaggerDoc Conversation @@ -305,7 +305,7 @@ data CreateGroupConversation = CreateGroupConversation instance ToSchema CreateGroupConversation where schema = createGroupConversationSchema Nothing -instance SingI v => ToSchema (Versioned v CreateGroupConversation) where +instance (SingI v) => ToSchema (Versioned v CreateGroupConversation) where schema = Versioned <$> unVersioned .= createGroupConversationSchema (Just (demote @v)) createGroupConversationSchema :: Maybe Version -> ValueSchema NamedSwaggerDoc CreateGroupConversation @@ -321,7 +321,7 @@ createGroupConversationSchema v = toFlatList :: Map Domain (Set a) -> [Qualified a] toFlatList m = (\(d, s) -> flip Qualified d <$> Set.toList s) =<< Map.assocs m - fromFlatList :: Ord a => [Qualified a] -> Map Domain (Set a) + fromFlatList :: (Ord a) => [Qualified a] -> Map Domain (Set a) fromFlatList = fmap Set.fromList . indexQualified -- | Limited view of a 'Conversation'. Is used to inform users with an invite @@ -375,7 +375,7 @@ instance ToSchema (Versioned 'V2 (ConversationList Conversation)) where conversationListSchema :: forall a. - ConversationListItem a => + (ConversationListItem a) => ValueSchema NamedSwaggerDoc a -> ValueSchema NamedSwaggerDoc (ConversationList a) conversationListSchema sch = @@ -449,7 +449,7 @@ conversationsResponseSchema v = instance ToSchema ConversationsResponse where schema = conversationsResponseSchema Nothing -instance SingI v => ToSchema (Versioned v ConversationsResponse) where +instance (SingI v) => ToSchema (Versioned v ConversationsResponse) where schema = Versioned <$> unVersioned .= conversationsResponseSchema (Just (demote @v)) -------------------------------------------------------------------------------- @@ -553,7 +553,7 @@ toAccessRoleLegacy :: Set AccessRole -> AccessRoleLegacy toAccessRoleLegacy accessRoles = do fromMaybe NonActivatedAccessRole $ find (allMember accessRoles . fromAccessRoleLegacy) [minBound ..] where - allMember :: Ord a => Set a -> Set a -> Bool + allMember :: (Ord a) => Set a -> Set a -> Bool allMember rhs lhs = all (`Set.member` lhs) rhs instance ToSchema AccessRole where @@ -764,7 +764,7 @@ instance ToSchema ConvTeamInfo where (description ?~ managedDesc) (c (False :: Bool)) where - c :: ToJSON a => a -> ValueSchema SwaggerDoc () + c :: (ToJSON a) => a -> ValueSchema SwaggerDoc () c val = mkSchema mempty (const (pure ())) (const (pure (toJSON val))) -------------------------------------------------------------------------------- diff --git a/libs/wire-api/src/Wire/API/Conversation/Member.hs b/libs/wire-api/src/Wire/API/Conversation/Member.hs index f07f619b3e5..1443e158af8 100644 --- a/libs/wire-api/src/Wire/API/Conversation/Member.hs +++ b/libs/wire-api/src/Wire/API/Conversation/Member.hs @@ -131,7 +131,7 @@ instance ToSchema Member where <*> memHiddenRef .= optField "hidden_ref" (maybeWithDefault A.Null schema) <*> memConvRoleName .= (fromMaybe roleNameWireAdmin <$> optField "conversation_role" schema) where - c :: ToJSON a => a -> ValueSchema SwaggerDoc () + c :: (ToJSON a) => a -> ValueSchema SwaggerDoc () c val = mkSchema mempty (const (pure ())) (const (pure (toJSON val))) -- | The semantics of the possible different values is entirely up to clients, diff --git a/libs/wire-api/src/Wire/API/Deprecated.hs b/libs/wire-api/src/Wire/API/Deprecated.hs index c68120be996..6a584f5582a 100644 --- a/libs/wire-api/src/Wire/API/Deprecated.hs +++ b/libs/wire-api/src/Wire/API/Deprecated.hs @@ -35,23 +35,23 @@ data Deprecated deriving (Typeable) -- All of these instances are very similar to the instances -- for Summary. These don't impact the API directly, but are -- for marking the deprecated flag in the openapi output. -instance HasLink sub => HasLink (Deprecated :> sub :: Type) where +instance (HasLink sub) => HasLink (Deprecated :> sub :: Type) where type MkLink (Deprecated :> sub) a = MkLink sub a toLink = let simpleToLink toA _ = toLink toA (Proxy :: Proxy sub) in simpleToLink -instance HasOpenApi api => HasOpenApi (Deprecated :> api :: Type) where +instance (HasOpenApi api) => HasOpenApi (Deprecated :> api :: Type) where toOpenApi _ = toOpenApi (Proxy @api) & allOperations . deprecated ?~ True -instance HasServer api ctx => HasServer (Deprecated :> api) ctx where +instance (HasServer api ctx) => HasServer (Deprecated :> api) ctx where type ServerT (Deprecated :> api) m = ServerT api m route _ = route $ Proxy @api hoistServerWithContext _ pc nt s = hoistServerWithContext (Proxy @api) pc nt s -instance HasClient m api => HasClient m (Deprecated :> api) where +instance (HasClient m api) => HasClient m (Deprecated :> api) where type Client m (Deprecated :> api) = Client m api clientWithRoute pm _ = clientWithRoute pm (Proxy :: Proxy api) hoistClientMonad pm _ f cl = hoistClientMonad pm (Proxy :: Proxy api) f cl diff --git a/libs/wire-api/src/Wire/API/Error.hs b/libs/wire-api/src/Wire/API/Error.hs index 7f6dab367dd..275d554a139 100644 --- a/libs/wire-api/src/Wire/API/Error.hs +++ b/libs/wire-api/src/Wire/API/Error.hs @@ -137,7 +137,7 @@ mkDynError c l msg = (Text.pack (symbolVal l)) (Text.pack (symbolVal msg)) -dynError :: forall e. KnownError e => DynError +dynError :: forall e. (KnownError e) => DynError dynError = dynError' $ seSing @e staticErrorSchema :: SStaticError e -> ValueSchema NamedSwaggerDoc (SStaticError e) @@ -159,17 +159,17 @@ staticErrorSchema e@(SStaticError c l m) = codeSchema :: ValueSchema SwaggerDoc Natural codeSchema = unnamed $ enum @Natural "Status" (element code code) -instance KnownError e => ToSchema (SStaticError e) where +instance (KnownError e) => ToSchema (SStaticError e) where schema = staticErrorSchema seSing data CanThrow e data CanThrowMany e -instance RoutesToPaths api => RoutesToPaths (CanThrow err :> api) where +instance (RoutesToPaths api) => RoutesToPaths (CanThrow err :> api) where getRoutes = getRoutes @api -instance RoutesToPaths api => RoutesToPaths (CanThrowMany errs :> api) where +instance (RoutesToPaths api) => RoutesToPaths (CanThrowMany errs :> api) where getRoutes = getRoutes @api type instance @@ -194,7 +194,7 @@ instance where toOpenApi _ = addToOpenApi @e (toOpenApi (Proxy @api)) -instance HasClient m api => HasClient m (CanThrow e :> api) where +instance (HasClient m api) => HasClient m (CanThrow e :> api) where type Client m (CanThrow e :> api) = Client m api clientWithRoute pm _ = clientWithRoute pm $ Proxy @api hoistClientMonad pm _ = hoistClientMonad pm (Proxy @api) @@ -203,7 +203,7 @@ type instance SpecialiseToVersion v (CanThrowMany es :> api) = CanThrowMany es :> SpecialiseToVersion v api -instance HasOpenApi api => HasOpenApi (CanThrowMany '() :> api) where +instance (HasOpenApi api) => HasOpenApi (CanThrowMany '() :> api) where toOpenApi _ = toOpenApi (Proxy @api) instance @@ -243,7 +243,7 @@ addErrorResponseToSwagger code resp = . S.responses . at code %~ Just - . addRef + . addRef where addRef :: Maybe (S.Referenced S.Response) -> S.Referenced S.Response addRef Nothing = S.Inline resp @@ -280,7 +280,7 @@ mapErrorS :: mapErrorS = mapError (Tagged @e' . unTagged) mapToRuntimeError :: - forall e e' r a. Member (Error e') r => e' -> Sem (ErrorS e ': r) a -> Sem r a + forall e e' r a. (Member (Error e') r) => e' -> Sem (ErrorS e ': r) a -> Sem r a mapToRuntimeError e' = mapError (const e') mapToDynamicError :: @@ -290,10 +290,10 @@ mapToDynamicError :: Sem r a mapToDynamicError = mapToRuntimeError (dynError @(MapError e)) -errorToWai :: forall e. KnownError (MapError e) => Wai.Error +errorToWai :: forall e. (KnownError (MapError e)) => Wai.Error errorToWai = dynErrorToWai (dynError @(MapError e)) -errorToResponse :: forall e. KnownError (MapError e) => JSONResponse +errorToResponse :: forall e. (KnownError (MapError e)) => JSONResponse errorToResponse = toResponse (dynError @(MapError e)) class APIError e where @@ -336,7 +336,7 @@ instance responseRender = responseRender @cs @(RespondWithStaticError (MapError e)) responseUnrender = responseUnrender @cs @(RespondWithStaticError (MapError e)) -instance KnownError (MapError e) => AsConstructor '[] (ErrorResponse e) where +instance (KnownError (MapError e)) => AsConstructor '[] (ErrorResponse e) where toConstructor _ = Nil fromConstructor _ = dynError @(MapError e) diff --git a/libs/wire-api/src/Wire/API/Error/Empty.hs b/libs/wire-api/src/Wire/API/Error/Empty.hs index 290c75c978d..8e25c71e210 100644 --- a/libs/wire-api/src/Wire/API/Error/Empty.hs +++ b/libs/wire-api/src/Wire/API/Error/Empty.hs @@ -33,7 +33,7 @@ data EmptyErrorForLegacyReasons s desc type instance ResponseType (EmptyErrorForLegacyReasons s desc) = () instance - KnownStatus s => + (KnownStatus s) => IsResponse cs (EmptyErrorForLegacyReasons s desc) where type ResponseStatus (EmptyErrorForLegacyReasons s desc) = s @@ -52,7 +52,7 @@ instance responseUnrender _ output = guard (responseStatusCode output == statusVal (Proxy @s)) instance - KnownSymbol desc => + (KnownSymbol desc) => IsSwaggerResponse (EmptyErrorForLegacyReasons s desc) where responseSwagger = diff --git a/libs/wire-api/src/Wire/API/Error/Galley.hs b/libs/wire-api/src/Wire/API/Error/Galley.hs index 44722937b45..ed4d3a0e226 100644 --- a/libs/wire-api/src/Wire/API/Error/Galley.hs +++ b/libs/wire-api/src/Wire/API/Error/Galley.hs @@ -151,7 +151,7 @@ $(genSingletons [''GalleyError]) instance (Typeable (MapError e), KnownError (MapError e)) => IsSwaggerError (e :: GalleyError) where addToOpenApi = addStaticErrorToSwagger @(MapError e) -instance KnownError (MapError e) => APIError (Tagged (e :: GalleyError) ()) where +instance (KnownError (MapError e)) => APIError (Tagged (e :: GalleyError) ()) where toResponse _ = toResponse $ dynError @(MapError e) -- | Convenience synonym for an operation denied error with an unspecified permission. @@ -353,7 +353,7 @@ authenticationErrorToDyn ReAuthFailed = dynError @(MapError 'ReAuthFailed) authenticationErrorToDyn VerificationCodeAuthFailed = dynError @(MapError 'VerificationCodeAuthFailed) authenticationErrorToDyn VerificationCodeRequired = dynError @(MapError 'VerificationCodeRequired) -instance Member (Error DynError) r => ServerEffect (Error AuthenticationError) r where +instance (Member (Error DynError) r) => ServerEffect (Error AuthenticationError) r where interpretServerEffect = mapError authenticationErrorToDyn -------------------------------------------------------------------------------- @@ -402,7 +402,7 @@ type instance MapError 'MLSE2EIDMissingCrlProxy = 'StaticError 400 "mls-e2eid-mi type instance ErrorEffect TeamFeatureError = Error TeamFeatureError -instance Member (Error DynError) r => ServerEffect (Error TeamFeatureError) r where +instance (Member (Error DynError) r) => ServerEffect (Error TeamFeatureError) r where interpretServerEffect = mapError $ \case AppLockInactivityTimeoutTooLow -> dynError @(MapError 'AppLockInactivityTimeoutTooLow) LegalHoldFeatureFlagNotEnabled -> dynError @(MapError 'LegalHoldFeatureFlagNotEnabled) @@ -435,7 +435,7 @@ instance IsSwaggerError MLSProposalFailure where \for more details on the possible error responses of each type of \ \proposal." -instance Member (Error JSONResponse) r => ServerEffect (Error MLSProposalFailure) r where +instance (Member (Error JSONResponse) r) => ServerEffect (Error MLSProposalFailure) r where interpretServerEffect = mapError pfInner -------------------------------------------------------------------------------- @@ -460,7 +460,7 @@ nonFederatingBackendsStatus = HTTP.status409 nonFederatingBackendsToList :: NonFederatingBackends -> [Domain] nonFederatingBackendsToList (NonFederatingBackends a b) = [a, b] -nonFederatingBackendsFromList :: MonadFail m => [Domain] -> m NonFederatingBackends +nonFederatingBackendsFromList :: (MonadFail m) => [Domain] -> m NonFederatingBackends nonFederatingBackendsFromList [a, b] = pure (NonFederatingBackends a b) nonFederatingBackendsFromList domains = fail $ @@ -487,7 +487,7 @@ instance IsSwaggerError NonFederatingBackends where type instance ErrorEffect NonFederatingBackends = Error NonFederatingBackends -instance Member (Error JSONResponse) r => ServerEffect (Error NonFederatingBackends) r where +instance (Member (Error JSONResponse) r) => ServerEffect (Error NonFederatingBackends) r where interpretServerEffect = mapError toResponse -------------------------------------------------------------------------------- @@ -531,7 +531,7 @@ instance IsSwaggerError UnreachableBackends where type instance ErrorEffect UnreachableBackends = Error UnreachableBackends -instance Member (Error JSONResponse) r => ServerEffect (Error UnreachableBackends) r where +instance (Member (Error JSONResponse) r) => ServerEffect (Error UnreachableBackends) r where interpretServerEffect = mapError toResponse unreachableUsersToUnreachableBackends :: UnreachableUsers -> UnreachableBackends @@ -557,5 +557,5 @@ instance APIError UnreachableBackendsLegacy where type instance ErrorEffect UnreachableBackendsLegacy = Error UnreachableBackendsLegacy -instance Member (Error JSONResponse) r => ServerEffect (Error UnreachableBackendsLegacy) r where +instance (Member (Error JSONResponse) r) => ServerEffect (Error UnreachableBackendsLegacy) r where interpretServerEffect = mapError toResponse diff --git a/libs/wire-api/src/Wire/API/Event/Team.hs b/libs/wire-api/src/Wire/API/Event/Team.hs index d5dac32eb39..bbeb15ebe10 100644 --- a/libs/wire-api/src/Wire/API/Event/Team.hs +++ b/libs/wire-api/src/Wire/API/Event/Team.hs @@ -167,8 +167,10 @@ instance ToJSON EventData where toJSON (EdMemberJoin usr) = A.object ["user" A..= usr] toJSON (EdMemberUpdate usr mPerm) = A.object $ - "user" A..= usr - # "permissions" A..= mPerm + "user" + A..= usr + # "permissions" + A..= mPerm # [] toJSON (EdMemberLeave usr) = A.object ["user" A..= usr] toJSON (EdConvCreate cnv) = A.object ["conv" A..= cnv] diff --git a/libs/wire-api/src/Wire/API/MLS/CipherSuite.hs b/libs/wire-api/src/Wire/API/MLS/CipherSuite.hs index 0a92ca9886e..a286a02d0a1 100644 --- a/libs/wire-api/src/Wire/API/MLS/CipherSuite.hs +++ b/libs/wire-api/src/Wire/API/MLS/CipherSuite.hs @@ -173,7 +173,7 @@ tagCipherSuite MLS_256_DHKEMP521_AES256GCM_SHA512_P521 = CipherSuite 0x5 tagCipherSuite MLS_128_X25519Kyber768Draft00_AES128GCM_SHA256_Ed25519 = CipherSuite 0xf031 data SomeHashAlgorithm where - SomeHashAlgorithm :: HashAlgorithm a => a -> SomeHashAlgorithm + SomeHashAlgorithm :: (HashAlgorithm a) => a -> SomeHashAlgorithm csHashAlgorithm :: CipherSuiteTag -> SomeHashAlgorithm csHashAlgorithm MLS_128_DHKEMX25519_AES128GCM_SHA256_Ed25519 = SomeHashAlgorithm SHA256 @@ -294,7 +294,7 @@ data SignatureSchemeTag deriving (Arbitrary) via GenericUniform SignatureSchemeTag class IsSignatureScheme (ss :: SignatureSchemeTag) where - sign :: MonadRandom m => KeyPair ss -> ByteString -> m ByteString + sign :: (MonadRandom m) => KeyPair ss -> ByteString -> m ByteString instance IsSignatureScheme 'Ed25519 where sign (priv, pub) = pure . BA.convert . Ed25519.sign priv pub @@ -352,7 +352,7 @@ signatureSchemeFromName name = getAlt $ flip foldMap [minBound .. maxBound] $ \s -> guard (signatureSchemeName s == name) $> s -parseSignatureScheme :: MonadFail f => Text -> f SignatureSchemeTag +parseSignatureScheme :: (MonadFail f) => Text -> f SignatureSchemeTag parseSignatureScheme name = maybe (fail ("Unsupported signature scheme " <> T.unpack name)) diff --git a/libs/wire-api/src/Wire/API/MLS/CommitBundle.hs b/libs/wire-api/src/Wire/API/MLS/CommitBundle.hs index ccfe3006284..2307f8ac38b 100644 --- a/libs/wire-api/src/Wire/API/MLS/CommitBundle.hs +++ b/libs/wire-api/src/Wire/API/MLS/CommitBundle.hs @@ -41,14 +41,14 @@ data CommitBundleF f = CommitBundleF deriving instance Show (CommitBundleF []) -instance Alternative f => Semigroup (CommitBundleF f) where +instance (Alternative f) => Semigroup (CommitBundleF f) where cb1 <> cb2 = CommitBundleF (cb1.commitMsg <|> cb2.commitMsg) (cb1.welcome <|> cb2.welcome) (cb1.groupInfo <|> cb2.groupInfo) -instance Alternative f => Monoid (CommitBundleF f) where +instance (Alternative f) => Monoid (CommitBundleF f) where mempty = CommitBundleF empty empty empty checkCommitBundleF :: CommitBundleF [] -> Either Text CommitBundle @@ -68,7 +68,7 @@ checkCommitBundleF cb = checkOpt _ [x] = pure (Just x) checkOpt name _ = Left ("Redundant occurrence of " <> name) -findMessageInStream :: Alternative f => RawMLS Message -> Either Text (CommitBundleF f) +findMessageInStream :: (Alternative f) => RawMLS Message -> Either Text (CommitBundleF f) findMessageInStream msg = case msg.value.content of MessagePublic mp -> case mp.content.value.content of FramedContentCommit _ -> pure (CommitBundleF (pure msg) empty empty) @@ -77,7 +77,7 @@ findMessageInStream msg = case msg.value.content of MessageGroupInfo gi -> pure (CommitBundleF empty empty (pure gi)) _ -> Left "unexpected message type" -findMessagesInStream :: Alternative f => [RawMLS Message] -> Either Text (CommitBundleF f) +findMessagesInStream :: (Alternative f) => [RawMLS Message] -> Either Text (CommitBundleF f) findMessagesInStream = getAp . foldMap (Ap . findMessageInStream) instance ParseMLS CommitBundle where diff --git a/libs/wire-api/src/Wire/API/MLS/ECDSA.hs b/libs/wire-api/src/Wire/API/MLS/ECDSA.hs index 11d197c0369..addaab7b64c 100644 --- a/libs/wire-api/src/Wire/API/MLS/ECDSA.hs +++ b/libs/wire-api/src/Wire/API/MLS/ECDSA.hs @@ -30,7 +30,7 @@ import Wire.API.MLS.Serialisation -- | Decode an ECDSA signature. decodeSignature :: forall curve. - EllipticCurveECDSA curve => + (EllipticCurveECDSA curve) => Proxy curve -> ByteString -> Maybe (Signature curve) @@ -43,7 +43,7 @@ decodeSignature curve bs = do -- Encode an ECDSA signature. encodeSignature :: forall curve. - EllipticCurveECDSA curve => + (EllipticCurveECDSA curve) => Proxy curve -> Signature curve -> ByteString diff --git a/libs/wire-api/src/Wire/API/MLS/Epoch.hs b/libs/wire-api/src/Wire/API/MLS/Epoch.hs index 117e26abd28..c820310a4ed 100644 --- a/libs/wire-api/src/Wire/API/MLS/Epoch.hs +++ b/libs/wire-api/src/Wire/API/MLS/Epoch.hs @@ -38,5 +38,5 @@ instance ParseMLS Epoch where instance SerialiseMLS Epoch where serialiseMLS (Epoch n) = put n -addToEpoch :: Integral a => a -> Epoch -> Epoch +addToEpoch :: (Integral a) => a -> Epoch -> Epoch addToEpoch n (Epoch e) = Epoch (e + fromIntegral n) diff --git a/libs/wire-api/src/Wire/API/MLS/Keys.hs b/libs/wire-api/src/Wire/API/MLS/Keys.hs index 92afc2df664..545a9c1c5cf 100644 --- a/libs/wire-api/src/Wire/API/MLS/Keys.hs +++ b/libs/wire-api/src/Wire/API/MLS/Keys.hs @@ -35,7 +35,7 @@ data MLSKeysByPurpose a = MLSKeysByPurpose deriving (Eq, Show, Functor, Foldable, Traversable) deriving (FromJSON, ToJSON, S.ToSchema) via Schema (MLSKeysByPurpose a) -instance ToSchema a => ToSchema (MLSKeysByPurpose a) where +instance (ToSchema a) => ToSchema (MLSKeysByPurpose a) where schema = object "MLSKeysByPurpose" $ MLSKeysByPurpose @@ -50,7 +50,7 @@ data MLSKeys a = MLSKeys deriving (Eq, Show) deriving (FromJSON, ToJSON, S.ToSchema) via Schema (MLSKeys a) -instance ToSchema a => ToSchema (MLSKeys a) where +instance (ToSchema a) => ToSchema (MLSKeys a) where schema = object "MLSKeys" $ MLSKeys diff --git a/libs/wire-api/src/Wire/API/MLS/Serialisation.hs b/libs/wire-api/src/Wire/API/MLS/Serialisation.hs index 7ae47e8493a..618d26201bf 100644 --- a/libs/wire-api/src/Wire/API/MLS/Serialisation.hs +++ b/libs/wire-api/src/Wire/API/MLS/Serialisation.hs @@ -233,17 +233,17 @@ instance SerialiseMLS Word32 where serialiseMLS = put instance SerialiseMLS Word64 where serialiseMLS = put -- | Encode an MLS value to a lazy bytestring. -encodeMLS :: SerialiseMLS a => a -> LByteString +encodeMLS :: (SerialiseMLS a) => a -> LByteString encodeMLS = runPut . serialiseMLS -encodeMLS' :: SerialiseMLS a => a -> ByteString +encodeMLS' :: (SerialiseMLS a) => a -> ByteString encodeMLS' = LBS.toStrict . encodeMLS -- | Decode an MLS value from a lazy bytestring. Return an error message in case of failure. -decodeMLS :: ParseMLS a => LByteString -> Either Text a +decodeMLS :: (ParseMLS a) => LByteString -> Either Text a decodeMLS = decodeMLSWith parseMLS -decodeMLS' :: ParseMLS a => ByteString -> Either Text a +decodeMLS' :: (ParseMLS a) => ByteString -> Either Text a decodeMLS' = decodeMLS . LBS.fromStrict -- | Decode an MLS value from a lazy bytestring given a custom parser. @@ -298,10 +298,10 @@ rawMLSFromText p txt = do value <- first Text.unpack (p mlsData) pure $ RawMLS mlsData value -instance S.ToSchema a => S.ToSchema (RawMLS a) where +instance (S.ToSchema a) => S.ToSchema (RawMLS a) where declareNamedSchema _ = S.declareNamedSchema (Proxy @a) -instance ParseMLS a => FromJSON (RawMLS a) where +instance (ParseMLS a) => FromJSON (RawMLS a) where parseJSON = Aeson.withText "Base64 MLS object" $ either fail pure . rawMLSFromText decodeMLS' @@ -318,16 +318,16 @@ parseRawMLS p = do -- construct RawMLS value pure $ RawMLS raw x -instance ParseMLS a => ParseMLS (RawMLS a) where +instance (ParseMLS a) => ParseMLS (RawMLS a) where parseMLS = parseRawMLS parseMLS instance SerialiseMLS (RawMLS a) where serialiseMLS = putByteString . raw -mkRawMLS :: SerialiseMLS a => a -> RawMLS a +mkRawMLS :: (SerialiseMLS a) => a -> RawMLS a mkRawMLS x = RawMLS (LBS.toStrict (runPut (serialiseMLS x))) x -traceMLS :: Show a => String -> Get a -> Get a +traceMLS :: (Show a) => String -> Get a -> Get a traceMLS l g = do begin <- bytesRead r <- g diff --git a/libs/wire-api/src/Wire/API/MLS/Servant.hs b/libs/wire-api/src/Wire/API/MLS/Servant.hs index 4807d82d930..e1061779bc8 100644 --- a/libs/wire-api/src/Wire/API/MLS/Servant.hs +++ b/libs/wire-api/src/Wire/API/MLS/Servant.hs @@ -30,10 +30,10 @@ data MLS instance Accept MLS where contentType _ = "message" // "mls" -instance {-# OVERLAPPABLE #-} ParseMLS a => MimeUnrender MLS a where +instance {-# OVERLAPPABLE #-} (ParseMLS a) => MimeUnrender MLS a where mimeUnrender _ = mimeUnrenderMLSWith parseMLS -instance {-# OVERLAPPABLE #-} SerialiseMLS a => MimeRender MLS a where +instance {-# OVERLAPPABLE #-} (SerialiseMLS a) => MimeRender MLS a where mimeRender _ = encodeMLS mimeUnrenderMLSWith :: Get a -> LByteString -> Either String a diff --git a/libs/wire-api/src/Wire/API/MakesFederatedCall.hs b/libs/wire-api/src/Wire/API/MakesFederatedCall.hs index 5b9875db078..2a59e5648fb 100644 --- a/libs/wire-api/src/Wire/API/MakesFederatedCall.hs +++ b/libs/wire-api/src/Wire/API/MakesFederatedCall.hs @@ -50,7 +50,7 @@ import GHC.TypeLits import Imports import Servant.API import Servant.API.Extended (ReqBodyCustomError') -import Servant.API.Extended.RawM (RawM) +import Servant.API.Extended.RawM qualified as RawM import Servant.Client import Servant.Multipart import Servant.OpenApi @@ -93,7 +93,7 @@ import Wire.Arbitrary (GenericUniform (..)) -- The @x@ parameter here is intentionally ambiguous, existing as a unique -- skolem to prevent GHC from caching the results of solving -- 'ToHasAnnotations'. Callers needn't worry about it. -exposeAnnotations :: ToHasAnnotations x => a -> a +exposeAnnotations :: (ToHasAnnotations x) => a -> a exposeAnnotations = id data Component @@ -161,11 +161,11 @@ instance (HasServer api ctx) => HasServer (MakesFederatedCall comp name :> api : route _ ctx f = route (Proxy @api) ctx $ fmap ($ synthesizeCallsFed @comp @name) f hoistServerWithContext _ ctx f s = hoistServerWithContext (Proxy @api) ctx f . s -instance HasLink api => HasLink (MakesFederatedCall comp name :> api :: Type) where +instance (HasLink api) => HasLink (MakesFederatedCall comp name :> api :: Type) where type MkLink (MakesFederatedCall comp name :> api) x = MkLink api x toLink f _ l = toLink f (Proxy @api) l -instance RoutesToPaths api => RoutesToPaths (MakesFederatedCall comp name :> api :: Type) where +instance (RoutesToPaths api) => RoutesToPaths (MakesFederatedCall comp name :> api :: Type) where getRoutes = getRoutes @api -- | Get a symbol representation of our component. @@ -185,7 +185,9 @@ instance (HasOpenApi api, KnownSymbol name, KnownSymbol (ShowComponent comp)) => toOpenApi (Proxy @api) -- Append federated call line to the description of routes -- that perform calls to federation members. - & S.allOperations . S.description %~ pure . maybe call (\d -> d <> "
" <> call) + & S.allOperations + . S.description + %~ pure . maybe call (\d -> d <> "
" <> call) where call :: Text call = @@ -194,7 +196,7 @@ instance (HasOpenApi api, KnownSymbol name, KnownSymbol (ShowComponent comp)) => <> T.pack " on " <> T.pack (symbolVal $ Proxy @name) -instance HasClient m api => HasClient m (MakesFederatedCall comp name :> api :: Type) where +instance (HasClient m api) => HasClient m (MakesFederatedCall comp name :> api :: Type) where type Client m (MakesFederatedCall comp name :> api) = Client m api clientWithRoute p _ = clientWithRoute p $ Proxy @api hoistClientMonad p _ f c = hoistClientMonad p (Proxy @api) f c @@ -208,7 +210,7 @@ class SolveCallsFed c r a where -- This function should always be called with an argument of -- 'exposeAnnotations'. See the documentation there for more information on -- why. - callsFed :: (c => r) -> a + callsFed :: ((c) => r) -> a instance (c ~ ((k, d) :: Constraint), SolveCallsFed d r a) => SolveCallsFed c r (Dict k -> a) where callsFed f Dict = callsFed @d @r @a f @@ -221,7 +223,7 @@ instance {-# OVERLAPPABLE #-} (c ~ (() :: Constraint), r ~ a) => SolveCallsFed c -- -- This is unsafe in the sense that it will drop the 'CallsFed' constraint, and -- thus might mean a federated call gets forgotten in the documentation. -unsafeCallsFed :: forall (comp :: Component) (name :: Symbol) r. (CallsFed comp name => r) -> r +unsafeCallsFed :: forall (comp :: Component) (name :: Symbol) r. ((CallsFed comp name) => r) -> r unsafeCallsFed f = withDict (synthesizeCallsFed @comp @name) f data FedCallFrom' f = FedCallFrom @@ -298,22 +300,22 @@ instance (HasFeds rest, KnownSymbol (ShowComponent comp), KnownSymbol name) => H modify $ \s -> s {fedCalls = fedCalls s <> Calls call} getFedCalls $ Proxy @rest -instance ReflectMethod method => HasFeds (MultiVerb method cs as r) where +instance (ReflectMethod method) => HasFeds (MultiVerb method cs as r) where getFedCalls _ = do modify $ \s -> s {method = getMethod @method} gets pure -instance ReflectMethod method => HasFeds (Verb method status cts a) where +instance (ReflectMethod method) => HasFeds (Verb method status cts a) where getFedCalls _ = do modify $ \s -> s {method = getMethod @method} gets pure -instance ReflectMethod method => HasFeds (NoContentVerb method) where +instance (ReflectMethod method) => HasFeds (NoContentVerb method) where getFedCalls _ = do modify $ \s -> s {method = getMethod @method} gets pure -instance ReflectMethod method => HasFeds (Stream method status framing ct a) where +instance (ReflectMethod method) => HasFeds (Stream method status framing ct a) where getFedCalls _ = do modify $ \s -> s {method = getMethod @method} gets pure @@ -339,10 +341,10 @@ instance HasFeds EmptyAPI where instance HasFeds Raw where getFedCalls _ = gets pure -instance HasFeds RawM where +instance HasFeds RawM.RawM where getFedCalls _ = gets pure -getMethod :: forall method. ReflectMethod method => Maybe String +getMethod :: forall method. (ReflectMethod method) => Maybe String getMethod = pure . fmap toLower . unpack . reflectMethod $ Proxy @method appendName :: String -> FedCallFrom -> FedCallFrom @@ -352,59 +354,59 @@ appendName toAppend s = s {name = pure $ maybe toAppend (<> toAppend) $ name s} instance (RenderableSymbol name, HasFeds rest) => HasFeds (Named name rest) where getFedCalls _ = getFedCalls $ Proxy @rest -instance HasFeds rest => HasFeds (Header' mods name a :> rest) where +instance (HasFeds rest) => HasFeds (Header' mods name a :> rest) where getFedCalls _ = getFedCalls $ Proxy @rest -instance HasFeds rest => HasFeds (ReqBody' mods cts a :> rest) where +instance (HasFeds rest) => HasFeds (ReqBody' mods cts a :> rest) where getFedCalls _ = getFedCalls $ Proxy @rest -instance HasFeds rest => HasFeds (StreamBody' opts framing ct a :> rest) where +instance (HasFeds rest) => HasFeds (StreamBody' opts framing ct a :> rest) where getFedCalls _ = getFedCalls $ Proxy @rest -instance HasFeds rest => HasFeds (Summary summary :> rest) where +instance (HasFeds rest) => HasFeds (Summary summary :> rest) where getFedCalls _ = getFedCalls $ Proxy @rest -instance HasFeds rest => HasFeds (QueryParam' mods name a :> rest) where +instance (HasFeds rest) => HasFeds (QueryParam' mods name a :> rest) where getFedCalls _ = getFedCalls $ Proxy @rest -instance HasFeds rest => HasFeds (MultipartForm tag a :> rest) where +instance (HasFeds rest) => HasFeds (MultipartForm tag a :> rest) where getFedCalls _ = getFedCalls $ Proxy @rest -instance HasFeds rest => HasFeds (QueryFlag a :> rest) where +instance (HasFeds rest) => HasFeds (QueryFlag a :> rest) where getFedCalls _ = getFedCalls $ Proxy @rest -instance HasFeds rest => HasFeds (Description desc :> rest) where +instance (HasFeds rest) => HasFeds (Description desc :> rest) where getFedCalls _ = getFedCalls $ Proxy @rest -instance HasFeds rest => HasFeds (Deprecated :> rest) where +instance (HasFeds rest) => HasFeds (Deprecated :> rest) where getFedCalls _ = getFedCalls $ Proxy @rest -instance HasFeds rest => HasFeds (CanThrow e :> rest) where +instance (HasFeds rest) => HasFeds (CanThrow e :> rest) where getFedCalls _ = getFedCalls $ Proxy @rest -instance HasFeds rest => HasFeds (CanThrowMany es :> rest) where +instance (HasFeds rest) => HasFeds (CanThrowMany es :> rest) where getFedCalls _ = getFedCalls $ Proxy @rest -instance HasFeds rest => HasFeds (Bearer a :> rest) where +instance (HasFeds rest) => HasFeds (Bearer a :> rest) where getFedCalls _ = getFedCalls $ Proxy @rest -instance HasFeds rest => HasFeds (Cookies cs :> rest) where +instance (HasFeds rest) => HasFeds (Cookies cs :> rest) where getFedCalls _ = getFedCalls $ Proxy @rest -instance HasFeds rest => HasFeds (ZHostOpt :> rest) where +instance (HasFeds rest) => HasFeds (ZHostOpt :> rest) where getFedCalls _ = getFedCalls $ Proxy @rest -instance HasFeds rest => HasFeds (ZAuthServant ztype opts :> rest) where +instance (HasFeds rest) => HasFeds (ZAuthServant ztype opts :> rest) where getFedCalls _ = getFedCalls $ Proxy @rest -instance HasFeds rest => HasFeds (ReqBodyCustomError' mods cts tag a :> rest) where +instance (HasFeds rest) => HasFeds (ReqBodyCustomError' mods cts tag a :> rest) where getFedCalls _ = getFedCalls $ Proxy @rest -instance HasFeds rest => HasFeds (DescriptionOAuthScope scope :> rest) where +instance (HasFeds rest) => HasFeds (DescriptionOAuthScope scope :> rest) where getFedCalls _ = getFedCalls $ Proxy @rest -instance HasFeds rest => HasFeds (OmitDocs :> rest) where +instance (HasFeds rest) => HasFeds (OmitDocs :> rest) where getFedCalls _ = getFedCalls $ Proxy @rest -instance HasFeds rest => HasFeds (VersionedReqBody v cts a :> rest) where +instance (HasFeds rest) => HasFeds (VersionedReqBody v cts a :> rest) where getFedCalls _ = getFedCalls $ Proxy @rest diff --git a/libs/wire-api/src/Wire/API/Message.hs b/libs/wire-api/src/Wire/API/Message.hs index 6b117791bc3..85cdda18909 100644 --- a/libs/wire-api/src/Wire/API/Message.hs +++ b/libs/wire-api/src/Wire/API/Message.hs @@ -451,7 +451,7 @@ clientMismatchStrategyToProtolens = \case & Proto.Otr.userIds .~ map qualifiedUserIdToProtolens (toList users) ) -protolensToSetQualifiedUserIds :: ProtoLens.HasField s "userIds" [Proto.Otr.QualifiedUserId] => s -> Either String (Set (Qualified UserId)) +protolensToSetQualifiedUserIds :: (ProtoLens.HasField s "userIds" [Proto.Otr.QualifiedUserId]) => s -> Either String (Set (Qualified UserId)) protolensToSetQualifiedUserIds = fmap Set.fromList . mapM protolensToQualifiedUserId . view Proto.Otr.userIds protolensToQualifiedUserId :: Proto.Otr.QualifiedUserId -> Either String (Qualified UserId) diff --git a/libs/wire-api/src/Wire/API/Message/Proto.hs b/libs/wire-api/src/Wire/API/Message/Proto.hs index b2b6f1a3832..d20ecd75ab6 100644 --- a/libs/wire-api/src/Wire/API/Message/Proto.hs +++ b/libs/wire-api/src/Wire/API/Message/Proto.hs @@ -68,7 +68,7 @@ instance Decode UserId fromUserId :: Id.UserId -> UserId fromUserId u = UserId {_user = putField u} -userId :: Functor f => (Id.UserId -> f Id.UserId) -> UserId -> f UserId +userId :: (Functor f) => (Id.UserId -> f Id.UserId) -> UserId -> f UserId userId f c = (\x -> c {_user = x}) <$> field f (_user c) -------------------------------------------------------------------------------- @@ -86,7 +86,7 @@ instance Decode ClientId newClientId :: Word64 -> ClientId newClientId c = ClientId {_client = putField c} -clientId :: Functor f => (Word64 -> f Word64) -> ClientId -> f ClientId +clientId :: (Functor f) => (Word64 -> f Word64) -> ClientId -> f ClientId clientId f c = (\x -> c {_client = x}) <$> field f (_client c) toClientId :: ClientId -> Id.ClientId @@ -115,10 +115,10 @@ clientEntry c t = _clientVal = putField t } -clientEntryId :: Functor f => (ClientId -> f ClientId) -> ClientEntry -> f ClientEntry +clientEntryId :: (Functor f) => (ClientId -> f ClientId) -> ClientEntry -> f ClientEntry clientEntryId f c = (\x -> c {_clientId = x}) <$> field f (_clientId c) -clientEntryMessage :: Functor f => (ByteString -> f ByteString) -> ClientEntry -> f ClientEntry +clientEntryMessage :: (Functor f) => (ByteString -> f ByteString) -> ClientEntry -> f ClientEntry clientEntryMessage f c = (\x -> c {_clientVal = x}) <$> field f (_clientVal c) -------------------------------------------------------------------------------- @@ -141,10 +141,10 @@ userEntry u c = _userVal = putField c } -userEntryId :: Functor f => (UserId -> f UserId) -> UserEntry -> f UserEntry +userEntryId :: (Functor f) => (UserId -> f UserId) -> UserEntry -> f UserEntry userEntryId f c = (\x -> c {_userId = x}) <$> field f (_userId c) -userEntryClients :: Functor f => ([ClientEntry] -> f [ClientEntry]) -> UserEntry -> f UserEntry +userEntryClients :: (Functor f) => ([ClientEntry] -> f [ClientEntry]) -> UserEntry -> f UserEntry userEntryClients f c = (\x -> c {_userVal = x}) <$> field f (_userVal c) -------------------------------------------------------------------------------- @@ -199,27 +199,27 @@ newOtrMessage c us = _newOtrReportMissing = putField [] } -newOtrMessageSender :: Functor f => (ClientId -> f ClientId) -> NewOtrMessage -> f NewOtrMessage +newOtrMessageSender :: (Functor f) => (ClientId -> f ClientId) -> NewOtrMessage -> f NewOtrMessage newOtrMessageSender f c = (\x -> c {_newOtrSender = x}) <$> field f (_newOtrSender c) -newOtrMessageRecipients :: Functor f => ([UserEntry] -> f [UserEntry]) -> NewOtrMessage -> f NewOtrMessage +newOtrMessageRecipients :: (Functor f) => ([UserEntry] -> f [UserEntry]) -> NewOtrMessage -> f NewOtrMessage newOtrMessageRecipients f c = (\x -> c {_newOtrRecipients = x}) <$> field f (_newOtrRecipients c) -newOtrMessageNativePush :: Functor f => (Bool -> f Bool) -> NewOtrMessage -> f NewOtrMessage +newOtrMessageNativePush :: (Functor f) => (Bool -> f Bool) -> NewOtrMessage -> f NewOtrMessage newOtrMessageNativePush f c = let g x = Just <$> f (fromMaybe True x) in (\x -> c {_newOtrNativePush = x}) <$> field g (_newOtrNativePush c) -newOtrMessageTransient :: Functor f => (Bool -> f Bool) -> NewOtrMessage -> f NewOtrMessage +newOtrMessageTransient :: (Functor f) => (Bool -> f Bool) -> NewOtrMessage -> f NewOtrMessage newOtrMessageTransient f c = let g x = Just <$> f (fromMaybe False x) in (\x -> c {_newOtrTransient = x}) <$> field g (_newOtrTransient c) -newOtrMessageData :: Functor f => (Maybe ByteString -> f (Maybe ByteString)) -> NewOtrMessage -> f NewOtrMessage +newOtrMessageData :: (Functor f) => (Maybe ByteString -> f (Maybe ByteString)) -> NewOtrMessage -> f NewOtrMessage newOtrMessageData f c = (\x -> c {_newOtrData = x}) <$> field f (_newOtrData c) -newOtrMessageNativePriority :: Functor f => (Maybe Priority -> f (Maybe Priority)) -> NewOtrMessage -> f NewOtrMessage +newOtrMessageNativePriority :: (Functor f) => (Maybe Priority -> f (Maybe Priority)) -> NewOtrMessage -> f NewOtrMessage newOtrMessageNativePriority f c = (\x -> c {_newOtrNativePriority = x}) <$> field f (_newOtrNativePriority c) -newOtrMessageReportMissing :: Functor f => ([UserId] -> f [UserId]) -> NewOtrMessage -> f NewOtrMessage +newOtrMessageReportMissing :: (Functor f) => ([UserId] -> f [UserId]) -> NewOtrMessage -> f NewOtrMessage newOtrMessageReportMissing f c = (\x -> c {_newOtrReportMissing = x}) <$> field f (_newOtrReportMissing c) diff --git a/libs/wire-api/src/Wire/API/OAuth.hs b/libs/wire-api/src/Wire/API/OAuth.hs index dfbd5987201..89c28f98370 100644 --- a/libs/wire-api/src/Wire/API/OAuth.hs +++ b/libs/wire-api/src/Wire/API/OAuth.hs @@ -19,7 +19,6 @@ module Wire.API.OAuth where import Cassandra hiding (Set) import Control.Lens (preview, view, (%~), (?~)) -import Control.Monad.Except import Crypto.Hash as Crypto import Crypto.JWT hiding (Context, params, uri, verify) import Data.Aeson.KeyMap qualified as M @@ -110,8 +109,10 @@ instance ToSchema OAuthClientConfig where schema = object "OAuthClientConfig" $ OAuthClientConfig - <$> applicationName .= fieldWithDocModifier "application_name" applicationNameDescription schema - <*> (.redirectUrl) .= fieldWithDocModifier "redirect_url" redirectUrlDescription schema + <$> applicationName + .= fieldWithDocModifier "application_name" applicationNameDescription schema + <*> (.redirectUrl) + .= fieldWithDocModifier "redirect_url" redirectUrlDescription schema where applicationNameDescription = description ?~ "The name of the application. This will be shown to the user when they are asked to authorize the application. The name must be between " <> minL <> " and " <> maxL <> " characters long." redirectUrlDescription = description ?~ "The URL to redirect to after the user has authorized the application." @@ -147,8 +148,10 @@ instance ToSchema OAuthClientCredentials where schema = object "OAuthClientCredentials" $ OAuthClientCredentials - <$> (.clientId) .= fieldWithDocModifier "client_id" clientIdDescription schema - <*> (.clientSecret) .= fieldWithDocModifier "client_secret" clientSecretDescription schema + <$> (.clientId) + .= fieldWithDocModifier "client_id" clientIdDescription schema + <*> (.clientSecret) + .= fieldWithDocModifier "client_secret" clientSecretDescription schema where clientIdDescription = description ?~ "The ID of the application." clientSecretDescription = description ?~ "The secret of the application." @@ -166,9 +169,12 @@ instance ToSchema OAuthClient where schema = object "OAuthClient" $ OAuthClient - <$> (.clientId) .= field "client_id" schema - <*> (.name) .= field "application_name" schema - <*> (.redirectUrl) .= field "redirect_url" schema + <$> (.clientId) + .= field "client_id" schema + <*> (.name) + .= field "application_name" schema + <*> (.redirectUrl) + .= field "redirect_url" schema data OAuthResponseType = OAuthResponseTypeCode deriving (Eq, Show, Generic) @@ -244,7 +250,8 @@ instance ToSchema OAuthScopes where oauthScopeParser :: Text -> A.Parser (Set OAuthScope) oauthScopeParser scope = pure $ - (not . T.null) `filter` T.splitOn " " scope + (not . T.null) + `filter` T.splitOn " " scope & maybe Set.empty Set.fromList . mapM (fromByteString' . fromStrict . TE.encodeUtf8) @@ -321,13 +328,20 @@ instance ToSchema CreateOAuthAuthorizationCodeRequest where schema = object "CreateOAuthAuthorizationCodeRequest" $ CreateOAuthAuthorizationCodeRequest - <$> (.clientId) .= fieldWithDocModifier "client_id" clientIdDescription schema - <*> (.scope) .= fieldWithDocModifier "scope" scopeDescription schema - <*> (.responseType) .= fieldWithDocModifier "response_type" responseTypeDescription schema - <*> (.redirectUri) .= fieldWithDocModifier "redirect_uri" redirectUriDescription schema - <*> (.state) .= fieldWithDocModifier "state" stateDescription schema - <*> (.codeChallengeMethod) .= fieldWithDocModifier "code_challenge_method" codeChallengeMethodDescription schema - <*> (.codeChallenge) .= fieldWithDocModifier "code_challenge" codeChallengeDescription schema + <$> (.clientId) + .= fieldWithDocModifier "client_id" clientIdDescription schema + <*> (.scope) + .= fieldWithDocModifier "scope" scopeDescription schema + <*> (.responseType) + .= fieldWithDocModifier "response_type" responseTypeDescription schema + <*> (.redirectUri) + .= fieldWithDocModifier "redirect_uri" redirectUriDescription schema + <*> (.state) + .= fieldWithDocModifier "state" stateDescription schema + <*> (.codeChallengeMethod) + .= fieldWithDocModifier "code_challenge_method" codeChallengeMethodDescription schema + <*> (.codeChallenge) + .= fieldWithDocModifier "code_challenge" codeChallengeDescription schema where clientIdDescription = description ?~ "The ID of the OAuth client" scopeDescription = description ?~ "The scopes which are requested to get authorization for, separated by a space" @@ -405,11 +419,16 @@ instance ToSchema OAuthAccessTokenRequest where schema = object "OAuthAccessTokenRequest" $ OAuthAccessTokenRequest - <$> (.grantType) .= fieldWithDocModifier "grant_type" grantTypeDescription schema - <*> (.clientId) .= fieldWithDocModifier "client_id" clientIdDescription schema - <*> (.codeVerifier) .= fieldWithDocModifier "code_verifier" codeVerifierDescription schema - <*> (.code) .= fieldWithDocModifier "code" codeDescription schema - <*> (.redirectUri) .= fieldWithDocModifier "redirect_uri" redirectUrlDescription schema + <$> (.grantType) + .= fieldWithDocModifier "grant_type" grantTypeDescription schema + <*> (.clientId) + .= fieldWithDocModifier "client_id" clientIdDescription schema + <*> (.codeVerifier) + .= fieldWithDocModifier "code_verifier" codeVerifierDescription schema + <*> (.code) + .= fieldWithDocModifier "code" codeDescription schema + <*> (.redirectUri) + .= fieldWithDocModifier "redirect_uri" redirectUrlDescription schema where grantTypeDescription = description ?~ "Indicates which authorization flow to use. Use `authorization_code` for authorization code flow." clientIdDescription = description ?~ "The ID of the OAuth client" @@ -499,10 +518,14 @@ instance ToSchema OAuthAccessTokenResponse where schema = object "OAuthAccessTokenResponse" $ OAuthAccessTokenResponse - <$> accessToken .= fieldWithDocModifier "access_token" accessTokenDescription schema - <*> tokenType .= fieldWithDocModifier "token_type" tokenTypeDescription schema - <*> expiresIn .= fieldWithDocModifier "expires_in" expiresInDescription (fromIntegral <$> roundDiffTime .= schema) - <*> (.refreshToken) .= fieldWithDocModifier "refresh_token" refreshTokenDescription schema + <$> accessToken + .= fieldWithDocModifier "access_token" accessTokenDescription schema + <*> tokenType + .= fieldWithDocModifier "token_type" tokenTypeDescription schema + <*> expiresIn + .= fieldWithDocModifier "expires_in" expiresInDescription (fromIntegral <$> roundDiffTime .= schema) + <*> (.refreshToken) + .= fieldWithDocModifier "refresh_token" refreshTokenDescription schema where roundDiffTime :: NominalDiffTime -> Int32 roundDiffTime = round @@ -521,7 +544,8 @@ instance A.FromJSON OAuthClaimsSet where parseJSON = A.withObject "OAuthClaimsSet" $ \o -> OAuthClaimsSet <$> A.parseJSON (A.Object o) - <*> o A..: "scope" + <*> o + A..: "scope" instance A.ToJSON OAuthClaimsSet where toJSON s = @@ -530,11 +554,12 @@ instance A.ToJSON OAuthClaimsSet where ins k v (A.Object o) = A.Object $ M.insert k (A.toJSON v) o ins _ _ a = a -hcsSub :: HasClaimsSet hcs => hcs -> Maybe (Id a) +hcsSub :: (HasClaimsSet hcs) => hcs -> Maybe (Id a) hcsSub = view claimSub >=> preview string - >=> either (const Nothing) pure . parseIdFromText + >=> either (const Nothing) pure + . parseIdFromText -- | Verify a JWT and return the claims set. Use this function if you have a custom claims set. verify :: JWK -> SignedJWT -> IO (Either JWTError OAuthClaimsSet) @@ -570,9 +595,12 @@ instance ToSchema OAuthRefreshAccessTokenRequest where schema = object "OAuthRefreshAccessTokenRequest" $ OAuthRefreshAccessTokenRequest - <$> (.grantType) .= fieldWithDocModifier "grant_type" grantTypeDescription schema - <*> (.clientId) .= fieldWithDocModifier "client_id" clientIdDescription schema - <*> (.refreshToken) .= fieldWithDocModifier "refresh_token" refreshTokenDescription schema + <$> (.grantType) + .= fieldWithDocModifier "grant_type" grantTypeDescription schema + <*> (.clientId) + .= fieldWithDocModifier "client_id" clientIdDescription schema + <*> (.refreshToken) + .= fieldWithDocModifier "refresh_token" refreshTokenDescription schema where grantTypeDescription = description ?~ "The grant type. Must be `refresh_token`" clientIdDescription = description ?~ "The OAuth client's ID" @@ -614,8 +642,10 @@ instance ToSchema OAuthRevokeRefreshTokenRequest where schema = object "OAuthRevokeRefreshTokenRequest" $ OAuthRevokeRefreshTokenRequest - <$> (.clientId) .= fieldWithDocModifier "client_id" clientIdDescription schema - <*> (.refreshToken) .= fieldWithDocModifier "refresh_token" refreshTokenDescription schema + <$> (.clientId) + .= fieldWithDocModifier "client_id" clientIdDescription schema + <*> (.refreshToken) + .= fieldWithDocModifier "refresh_token" refreshTokenDescription schema where clientIdDescription = description ?~ "The OAuth client's ID" refreshTokenDescription = description ?~ "The refresh token" @@ -632,8 +662,10 @@ instance ToSchema OAuthApplication where schema = object "OAuthApplication" $ OAuthApplication - <$> applicationId .= fieldWithDocModifier "id" idDescription schema - <*> (.name) .= fieldWithDocModifier "name" nameDescription schema + <$> applicationId + .= fieldWithDocModifier "id" idDescription schema + <*> (.name) + .= fieldWithDocModifier "name" nameDescription schema where idDescription = description ?~ "The OAuth client's ID" nameDescription = description ?~ "The OAuth client's name" @@ -701,9 +733,11 @@ instance Cql OAuthScope where ctype = Tagged TextColumn toCql = CqlText . TE.decodeUtf8With lenientDecode . toByteString' fromCql (CqlText t) = - maybe (Left "invalid oauth scope") Right $ - fromByteString' . fromStrict . TE.encodeUtf8 $ - t + maybe (Left "invalid oauth scope") Right + $ fromByteString' + . fromStrict + . TE.encodeUtf8 + $ t fromCql _ = Left "OAuthScope: Text expected" instance Cql OAuthCodeChallenge where diff --git a/libs/wire-api/src/Wire/API/Password.hs b/libs/wire-api/src/Wire/API/Password.hs index f9188b6dcfb..b1e9e8f531a 100644 --- a/libs/wire-api/src/Wire/API/Password.hs +++ b/libs/wire-api/src/Wire/API/Password.hs @@ -124,16 +124,16 @@ fromScrypt scryptParams = -- | Generate a strong, random plaintext password of length 16 -- containing only alphanumeric characters, '+' and '/'. -genPassword :: MonadIO m => m PlainTextPassword8 +genPassword :: (MonadIO m) => m PlainTextPassword8 genPassword = liftIO . fmap (plainTextPassword8Unsafe . Text.decodeUtf8 . B64.encode) $ randBytes 12 -- | Stretch a plaintext password so that it can be safely stored. -mkSafePassword :: MonadIO m => PlainTextPassword' t -> m Password +mkSafePassword :: (MonadIO m) => PlainTextPassword' t -> m Password mkSafePassword = fmap Password . hashPasswordScrypt . Text.encodeUtf8 . fromPlainTextPassword -mkSafePasswordArgon2id :: MonadIO m => PlainTextPassword' t -> m Password +mkSafePasswordArgon2id :: (MonadIO m) => PlainTextPassword' t -> m Password mkSafePasswordArgon2id = fmap Password . hashPasswordArgon2id . Text.encodeUtf8 . fromPlainTextPassword -- | Verify a plaintext password from user input against a stretched @@ -147,7 +147,7 @@ verifyPasswordWithStatus plain opaque = expected = fromPassword opaque in checkPassword actual expected -hashPasswordArgon2id :: MonadIO m => ByteString -> m Text +hashPasswordArgon2id :: (MonadIO m) => ByteString -> m Text hashPasswordArgon2id pwd = do salt <- newSalt $ fromIntegral defaultParams.saltLength let key = hashPasswordWithOptions defaultOptions pwd salt @@ -171,7 +171,7 @@ hashPasswordArgon2id pwd = do where encodeWithoutPadding = Text.dropWhileEnd (== '=') . Text.decodeUtf8 . B64.encode -hashPasswordScrypt :: MonadIO m => ByteString -> m Text +hashPasswordScrypt :: (MonadIO m) => ByteString -> m Text hashPasswordScrypt password = do salt <- newSalt $ fromIntegral defaultParams.saltLength let key = hashPasswordWithParams defaultParams password salt @@ -198,7 +198,7 @@ checkPassword actual expected = in (hashedKeyS `constEq` producedKeyS, PasswordStatusNeedsUpdate) Nothing -> (False, PasswordStatusNeedsUpdate) -newSalt :: MonadIO m => Int -> m ByteString +newSalt :: (MonadIO m) => Int -> m ByteString newSalt i = liftIO $ getRandomBytes i {-# INLINE newSalt #-} diff --git a/libs/wire-api/src/Wire/API/Provider/External.hs b/libs/wire-api/src/Wire/API/Provider/External.hs index 246b6aa5317..402812f1285 100644 --- a/libs/wire-api/src/Wire/API/Provider/External.hs +++ b/libs/wire-api/src/Wire/API/Provider/External.hs @@ -67,12 +67,18 @@ instance FromJSON NewBotRequest where instance ToJSON NewBotRequest where toJSON n = object $ - "id" .= newBotId n - # "client" .= newBotClient n - # "origin" .= newBotOrigin n - # "conversation" .= newBotConv n - # "token" .= newBotToken n - # "locale" .= newBotLocale n + "id" + .= newBotId n + # "client" + .= newBotClient n + # "origin" + .= newBotOrigin n + # "conversation" + .= newBotConv n + # "token" + .= newBotToken n + # "locale" + .= newBotLocale n # [] -------------------------------------------------------------------------------- @@ -103,9 +109,14 @@ instance FromJSON NewBotResponse where instance ToJSON NewBotResponse where toJSON r = object $ - "prekeys" .= rsNewBotPrekeys r - # "last_prekey" .= rsNewBotLastPrekey r - # "name" .= rsNewBotName r - # "accent_id" .= rsNewBotColour r - # "assets" .= rsNewBotAssets r + "prekeys" + .= rsNewBotPrekeys r + # "last_prekey" + .= rsNewBotLastPrekey r + # "name" + .= rsNewBotName r + # "accent_id" + .= rsNewBotColour r + # "assets" + .= rsNewBotAssets r # [] diff --git a/libs/wire-api/src/Wire/API/Provider/Service/Tag.hs b/libs/wire-api/src/Wire/API/Provider/Service/Tag.hs index 1df9b6a14bc..ec44311dece 100644 --- a/libs/wire-api/src/Wire/API/Provider/Service/Tag.hs +++ b/libs/wire-api/src/Wire/API/Provider/Service/Tag.hs @@ -238,7 +238,7 @@ instance (KnownNat n, KnownNat m, m <= n) => FromByteString (QueryAnyTags m n) w rs <- either fail pure (Range.checkedEither (Set.fromList ts)) pure $! QueryAnyTags rs -runPartial :: IsString i => Bool -> IResult i b -> Either Text b +runPartial :: (IsString i) => Bool -> IResult i b -> Either Text b runPartial alreadyRun result = case result of Fail _ _ e -> Left $ Text.pack e Partial f -> diff --git a/libs/wire-api/src/Wire/API/Routes/API.hs b/libs/wire-api/src/Wire/API/Routes/API.hs index 23ac38e6fed..ed77df72ba3 100644 --- a/libs/wire-api/src/Wire/API/Routes/API.hs +++ b/libs/wire-api/src/Wire/API/Routes/API.hs @@ -47,7 +47,7 @@ class ServiceAPI service (v :: Version) where type ServiceAPIRoutes service type SpecialisedAPIRoutes v service :: Type type SpecialisedAPIRoutes v service = SpecialiseToVersion v (ServiceAPIRoutes service) - serviceSwagger :: HasOpenApi (SpecialisedAPIRoutes v service) => S.OpenApi + serviceSwagger :: (HasOpenApi (SpecialisedAPIRoutes v service)) => S.OpenApi serviceSwagger = toOpenApi (Proxy @(SpecialisedAPIRoutes v service)) instance ServiceAPI VersionAPITag v where @@ -86,7 +86,7 @@ infixr 3 <@> -- type argument. hoistServerWithDomain :: forall api m n. - HasServer api '[Domain] => + (HasServer api '[Domain]) => (forall x. m x -> n x) -> ServerT api m -> ServerT api n @@ -94,7 +94,7 @@ hoistServerWithDomain = hoistServerWithContext (Proxy @api) (Proxy @'[Domain]) hoistAPIHandler :: forall api r n. - HasServer api '[Domain] => + (HasServer api '[Domain]) => (forall x. Sem r x -> n x) -> API api r -> ServerT api n diff --git a/libs/wire-api/src/Wire/API/Routes/Bearer.hs b/libs/wire-api/src/Wire/API/Routes/Bearer.hs index 64a1baed79f..d215630f62f 100644 --- a/libs/wire-api/src/Wire/API/Routes/Bearer.hs +++ b/libs/wire-api/src/Wire/API/Routes/Bearer.hs @@ -30,7 +30,7 @@ import Wire.API.Routes.Version newtype Bearer a = Bearer {unBearer :: a} -instance FromHttpApiData a => FromHttpApiData (Bearer a) where +instance (FromHttpApiData a) => FromHttpApiData (Bearer a) where parseHeader h = case BS.splitAt 7 h of ("Bearer ", suffix) -> Bearer <$> parseHeader suffix _ -> Left "Invalid authorization scheme" @@ -47,12 +47,12 @@ type instance SpecialiseToVersion v (Bearer a :> api) = Bearer a :> SpecialiseToVersion v api -instance HasOpenApi api => HasOpenApi (Bearer a :> api) where +instance (HasOpenApi api) => HasOpenApi (Bearer a :> api) where toOpenApi _ = toOpenApi (Proxy @api) & security <>~ [SecurityRequirement $ InsOrdHashMap.singleton "ZAuth" []] -instance RoutesToPaths api => RoutesToPaths (Bearer a :> api) where +instance (RoutesToPaths api) => RoutesToPaths (Bearer a :> api) where getRoutes = getRoutes @api instance diff --git a/libs/wire-api/src/Wire/API/Routes/ClientAlgebra.hs b/libs/wire-api/src/Wire/API/Routes/ClientAlgebra.hs index abc2b28e283..bae5c5bbc74 100644 --- a/libs/wire-api/src/Wire/API/Routes/ClientAlgebra.hs +++ b/libs/wire-api/src/Wire/API/Routes/ClientAlgebra.hs @@ -34,14 +34,14 @@ import Wire.API.Routes.MultiVerb -- type, and @m R@ is always an algebra over @m@. -- -- Minimal definition: 'joinClient' | 'bindClient'. -class HasClient m api => HasClientAlgebra m api where +class (HasClient m api) => HasClientAlgebra m api where joinClient :: m (Client m api) -> Client m api joinClient x = bindClient @m @api x id bindClient :: m a -> (a -> Client m api) -> Client m api bindClient x f = joinClient @m @api (fmap f x) -instance HasClient m (Verb method s cs a) => HasClientAlgebra m (Verb method s cs a) where +instance (HasClient m (Verb method s cs a)) => HasClientAlgebra m (Verb method s cs a) where joinClient = join bindClient = (>>=) diff --git a/libs/wire-api/src/Wire/API/Routes/Cookies.hs b/libs/wire-api/src/Wire/API/Routes/Cookies.hs index 2449f074c76..24629d0f12f 100644 --- a/libs/wire-api/src/Wire/API/Routes/Cookies.hs +++ b/libs/wire-api/src/Wire/API/Routes/Cookies.hs @@ -63,7 +63,7 @@ type instance SpecialiseToVersion v (Cookies cs :> api) = Cookies cs :> SpecialiseToVersion v api -instance HasOpenApi api => HasOpenApi (Cookies cs :> api) where +instance (HasOpenApi api) => HasOpenApi (Cookies cs :> api) where toOpenApi _ = toOpenApi (Proxy @api) class CookieArgs (cs :: [Type]) where @@ -103,7 +103,7 @@ instance mkCookieMap :: [(ByteString, ByteString)] -> CookieMap mkCookieMap = foldr (\(k, v) -> M.insertWith (<>) k (pure v)) mempty -instance CookieArgs cs => FromHttpApiData (CookieTuple cs) where +instance (CookieArgs cs) => FromHttpApiData (CookieTuple cs) where parseHeader = mkTuple . mkCookieMap . parseCookies parseUrlPiece = parseHeader . T.encodeUtf8 @@ -126,5 +126,5 @@ instance ) hoistServerWithContext _ ctx f = mapArgs @cs (hoistServerWithContext (Proxy @api) ctx f) -instance RoutesToPaths api => RoutesToPaths (Cookies cs :> api) where +instance (RoutesToPaths api) => RoutesToPaths (Cookies cs :> api) where getRoutes = getRoutes @api diff --git a/libs/wire-api/src/Wire/API/Routes/MultiTablePaging.hs b/libs/wire-api/src/Wire/API/Routes/MultiTablePaging.hs index 0fc48cdaf06..2cdfaf692c9 100644 --- a/libs/wire-api/src/Wire/API/Routes/MultiTablePaging.hs +++ b/libs/wire-api/src/Wire/API/Routes/MultiTablePaging.hs @@ -67,12 +67,12 @@ type RequestSchemaConstraint name tables max def = (KnownNat max, KnownNat def, deriving via Schema (GetMultiTablePageRequest name tables max def) instance - RequestSchemaConstraint name tables max def => ToJSON (GetMultiTablePageRequest name tables max def) + (RequestSchemaConstraint name tables max def) => ToJSON (GetMultiTablePageRequest name tables max def) deriving via Schema (GetMultiTablePageRequest name tables max def) instance - RequestSchemaConstraint name tables max def => FromJSON (GetMultiTablePageRequest name tables max def) + (RequestSchemaConstraint name tables max def) => FromJSON (GetMultiTablePageRequest name tables max def) deriving via Schema (GetMultiTablePageRequest name tables max def) @@ -82,7 +82,7 @@ deriving via ) => S.ToSchema (GetMultiTablePageRequest name tables max def) -instance RequestSchemaConstraint name tables max def => ToSchema (GetMultiTablePageRequest name tables max def) where +instance (RequestSchemaConstraint name tables max def) => ToSchema (GetMultiTablePageRequest name tables max def) where schema = let addPagingStateDoc = description @@ -96,10 +96,10 @@ instance RequestSchemaConstraint name tables max def => ToSchema (GetMultiTableP <$> gmtprSize .= (fromMaybe (toRange (Proxy @def)) <$> optFieldWithDocModifier "size" addSizeDoc schema) <*> gmtprState .= maybe_ (optFieldWithDocModifier "paging_state" addPagingStateDoc schema) -textFromNat :: forall n. KnownNat n => Text +textFromNat :: forall n. (KnownNat n) => Text textFromNat = Text.pack . show . natVal $ Proxy @n -textFromSymbol :: forall s. KnownSymbol s => Text +textFromSymbol :: forall s. (KnownSymbol s) => Text textFromSymbol = Text.pack . symbolVal $ Proxy @s -- | The result of a multi-table paginated query. Contains the list of results, @@ -117,13 +117,13 @@ type PageSchemaConstraints name resultsKey tables a = (KnownSymbol resultsKey, K deriving via (Schema (MultiTablePage name resultsKey tables a)) instance - PageSchemaConstraints name resultsKey tables a => + (PageSchemaConstraints name resultsKey tables a) => ToJSON (MultiTablePage name resultsKey tables a) deriving via (Schema (MultiTablePage name resultsKey tables a)) instance - PageSchemaConstraints name resultsKey tables a => + (PageSchemaConstraints name resultsKey tables a) => FromJSON (MultiTablePage name resultsKey tables a) deriving via diff --git a/libs/wire-api/src/Wire/API/Routes/MultiTablePaging/State.hs b/libs/wire-api/src/Wire/API/Routes/MultiTablePaging/State.hs index 1fae94b78b4..e14c63c1332 100644 --- a/libs/wire-api/src/Wire/API/Routes/MultiTablePaging/State.hs +++ b/libs/wire-api/src/Wire/API/Routes/MultiTablePaging/State.hs @@ -45,25 +45,25 @@ data MultiTablePagingState (name :: Symbol) tables = MultiTablePagingState deriving stock (Show, Eq) deriving (ToJSON, FromJSON, S.ToSchema) via Schema (MultiTablePagingState name tables) -encodePagingState :: PagingTable tables => MultiTablePagingState name tables -> ByteString +encodePagingState :: (PagingTable tables) => MultiTablePagingState name tables -> ByteString encodePagingState (MultiTablePagingState table state) = let encodedTable = encodePagingTable table encodedState = fromMaybe "" state in BS.cons encodedTable encodedState -parsePagingState :: PagingTable tables => ByteString -> Either String (MultiTablePagingState name tables) +parsePagingState :: (PagingTable tables) => ByteString -> Either String (MultiTablePagingState name tables) parsePagingState = AB.parseOnly pagingStateParser -pagingStateParser :: PagingTable tables => AB.Parser (MultiTablePagingState name tables) +pagingStateParser :: (PagingTable tables) => AB.Parser (MultiTablePagingState name tables) pagingStateParser = do table <- AB.anyWord8 >>= decodePagingTable state <- (AB.endOfInput $> Nothing) <|> (Just <$> AB.takeByteString <* AB.endOfInput) pure $ MultiTablePagingState table state -instance PagingTable tables => ToHttpApiData (MultiTablePagingState name tables) where +instance (PagingTable tables) => ToHttpApiData (MultiTablePagingState name tables) where toQueryParam = (Text.decodeUtf8 . Base64Url.encode) . encodePagingState -instance PagingTable tables => FromHttpApiData (MultiTablePagingState name tables) where +instance (PagingTable tables) => FromHttpApiData (MultiTablePagingState name tables) where parseQueryParam = mapLeft Text.pack . (parsePagingState <=< (Base64Url.decode . Text.encodeUtf8)) @@ -74,7 +74,7 @@ instance PagingTable tables => FromHttpApiData (MultiTablePagingState name table class PagingTable t where -- Using 'Word8' because 256 tables ought to be enough. encodePagingTable :: t -> Word8 - decodePagingTable :: MonadFail m => Word8 -> m t + decodePagingTable :: (MonadFail m) => Word8 -> m t instance (PagingTable tables, KnownSymbol name) => ToSchema (MultiTablePagingState name tables) where schema = diff --git a/libs/wire-api/src/Wire/API/Routes/MultiVerb.hs b/libs/wire-api/src/Wire/API/Routes/MultiVerb.hs index 7c4e6dcd5ab..0ee626b9d98 100644 --- a/libs/wire-api/src/Wire/API/Routes/MultiVerb.hs +++ b/libs/wire-api/src/Wire/API/Routes/MultiVerb.hs @@ -155,7 +155,7 @@ class IsSwaggerResponse a where type family ResponseType a :: Type -class IsWaiBody (ResponseBody a) => IsResponse cs a where +class (IsWaiBody (ResponseBody a)) => IsResponse cs a where type ResponseStatus a :: Nat type ResponseBody a :: Type @@ -238,7 +238,7 @@ instance either UnrenderError UnrenderSuccess $ mimeUnrender (Proxy @ct) (responseBody output) -instance KnownStatus s => IsResponse cs (RespondAs '() s desc ()) where +instance (KnownStatus s) => IsResponse cs (RespondAs '() s desc ()) where type ResponseStatus (RespondAs '() s desc ()) = s type ResponseBody (RespondAs '() s desc ()) = () @@ -290,7 +290,7 @@ instance guard (responseStatusCode resp == statusVal (Proxy @s)) pure $ responseBody resp -instance KnownSymbol desc => IsSwaggerResponse (RespondStreaming s desc framing ct) where +instance (KnownSymbol desc) => IsSwaggerResponse (RespondStreaming s desc framing ct) where responseSwagger = pure $ mempty @@ -333,7 +333,7 @@ instance ServantHeaders '[] '[] where constructHeaders Nil = [] extractHeaders _ = Just Nil -headerName :: forall name. KnownSymbol name => HTTP.HeaderName +headerName :: forall name. (KnownSymbol name) => HTTP.HeaderName headerName = CI.mk . Text.encodeUtf8 @@ -378,7 +378,7 @@ instance where constructHeader x = [(headerName @name, toHeader x)] -instance ServantHeader h name x => ServantHeader (OptHeader h) name (Maybe x) where +instance (ServantHeader h name x) => ServantHeader (OptHeader h) name (Maybe x) where constructHeader = foldMap (constructHeader @h) instance @@ -391,7 +391,7 @@ instance desc = Text.pack (symbolVal (Proxy @desc)) sch = pure $ Inline $ S.toParamSchema (Proxy @a) -instance ToResponseHeader h => ToResponseHeader (OptHeader h) where +instance (ToResponseHeader h) => ToResponseHeader (OptHeader h) where toResponseHeader _ = toResponseHeader (Proxy @h) type instance ResponseType (WithHeaders hs a r) = a @@ -535,7 +535,7 @@ class AsUnion (as :: [Type]) (r :: Type) where -- | Unions can be used directly as handler return types using this trivial -- instance. -instance rs ~ ResponseTypes as => AsUnion as (Union rs) where +instance (rs ~ ResponseTypes as) => AsUnion as (Union rs) where toUnion = id fromUnion = id @@ -553,7 +553,7 @@ class InjectAfter as bs where instance InjectAfter '[] bs where injectAfter = id -instance InjectAfter as bs => InjectAfter (a ': as) bs where +instance (InjectAfter as bs) => InjectAfter (a ': as) bs where injectAfter = S . injectAfter @as @bs class InjectBefore as bs where @@ -562,7 +562,7 @@ class InjectBefore as bs where instance InjectBefore '[] bs where injectBefore x = case x of {} -instance InjectBefore as bs => InjectBefore (a ': as) bs where +instance (InjectBefore as bs) => InjectBefore (a ': as) bs where injectBefore (Z x) = Z x injectBefore (S x) = S (injectBefore @as @bs x) @@ -584,7 +584,7 @@ class EitherFromUnion as bs where instance EitherFromUnion '[] bs where eitherFromUnion _ g = Right . g -instance EitherFromUnion as bs => EitherFromUnion (a ': as) bs where +instance (EitherFromUnion as bs) => EitherFromUnion (a ': as) bs where eitherFromUnion f _ (Z x) = Left (f (Z x)) eitherFromUnion f g (S x) = eitherFromUnion @as @bs (f . S) g x @@ -598,7 +598,7 @@ maybeToUnion _ Nothing = injectAfter @as @'[()] (Z (I ())) maybeFromUnion :: forall as a. - EitherFromUnion as '[()] => + (EitherFromUnion as '[()]) => (Union as -> a) -> (Union (as .++ '[()]) -> Maybe a) maybeFromUnion f = leftToMaybe . eitherFromUnion @as @'[()] f (const (Z (I ()))) @@ -767,11 +767,11 @@ instance -- pick out an element from the map, if any exist. -- These will all have the same schemas, and we are reapplying the content types. foldMap (\c -> InsOrdHashMap.fromList $ (,c) <$> cs) - . listToMaybe - . toList + . listToMaybe + . toList refResps = S.Inline . addMime <$> resps -class Typeable a => IsWaiBody a where +class (Typeable a) => IsWaiBody a where responseToWai :: ResponseF a -> Wai.Response instance IsWaiBody LByteString where @@ -799,9 +799,9 @@ instance IsWaiBody (SourceIO ByteString) where (\chunk -> output (byteString chunk) *> flush) (responseBody r) -data SomeResponse = forall a. IsWaiBody a => SomeResponse (ResponseF a) +data SomeResponse = forall a. (IsWaiBody a) => SomeResponse (ResponseF a) -addContentType :: forall ct a. Accept ct => ResponseF a -> ResponseF a +addContentType :: forall ct a. (Accept ct) => ResponseF a -> ResponseF a addContentType = addContentType' (contentType (Proxy @ct)) addContentType' :: M.MediaType -> ResponseF a -> ResponseF a @@ -828,7 +828,7 @@ fromSomeResponse (SomeResponse Response {..}) = do class HasAcceptCheck cs where acceptCheck' :: Proxy cs -> AcceptHeader -> DelayedIO () -instance AllMime cs => HasAcceptCheck cs where +instance (AllMime cs) => HasAcceptCheck cs where acceptCheck' = acceptCheck instance HasAcceptCheck '() where @@ -869,7 +869,7 @@ instance method = reflectMethod (Proxy @method) -- taken from Servant.Client.Core.HasClient -getResponseContentType :: RunClient m => Response -> m M.MediaType +getResponseContentType :: (RunClient m) => Response -> m M.MediaType getResponseContentType response = case lookup "Content-Type" (toList (responseHeaders response)) of Nothing -> pure $ "application" M.// "octet-stream" diff --git a/libs/wire-api/src/Wire/API/Routes/Named.hs b/libs/wire-api/src/Wire/API/Routes/Named.hs index 71e0ec307cb..d7aad87521a 100644 --- a/libs/wire-api/src/Wire/API/Routes/Named.hs +++ b/libs/wire-api/src/Wire/API/Routes/Named.hs @@ -42,7 +42,7 @@ newtype Named name x = Named {unnamed :: x} class RenderableSymbol a where renderSymbol :: Text -instance {-# OVERLAPPABLE #-} KnownSymbol a => RenderableSymbol a where +instance {-# OVERLAPPABLE #-} (KnownSymbol a) => RenderableSymbol a where renderSymbol = T.pack . show $ symbolVal (Proxy @a) instance {-# OVERLAPPING #-} (RenderableSymbol a, RenderableSymbol b) => RenderableSymbol '(a, b) where @@ -59,21 +59,21 @@ instance (HasOpenApi api, RenderableSymbol name) => HasOpenApi (Named name api) <> renderSymbol @name <> "]" -instance HasServer api ctx => HasServer (Named name api) ctx where +instance (HasServer api ctx) => HasServer (Named name api) ctx where type ServerT (Named name api) m = Named name (ServerT api m) route _ ctx action = route (Proxy @api) ctx (fmap unnamed action) hoistServerWithContext _ ctx f = fmap (hoistServerWithContext (Proxy @api) ctx f) -instance HasLink endpoint => HasLink (Named name endpoint) where +instance (HasLink endpoint) => HasLink (Named name endpoint) where type MkLink (Named name endpoint) a = MkLink endpoint a toLink toA _ = toLink toA (Proxy @endpoint) -instance RoutesToPaths api => RoutesToPaths (Named name api) where +instance (RoutesToPaths api) => RoutesToPaths (Named name api) where getRoutes = getRoutes @api -instance HasClient m api => HasClient m (Named n api) where +instance (HasClient m api) => HasClient m (Named n api) where type Client m (Named n api) = Client m api clientWithRoute pm _ req = clientWithRoute pm (Proxy @api) req hoistClientMonad pm _ f = hoistClientMonad pm (Proxy @api) f diff --git a/libs/wire-api/src/Wire/API/Routes/Public.hs b/libs/wire-api/src/Wire/API/Routes/Public.hs index 73b6de1b3f6..44cb71c638e 100644 --- a/libs/wire-api/src/Wire/API/Routes/Public.hs +++ b/libs/wire-api/src/Wire/API/Routes/Public.hs @@ -115,7 +115,7 @@ class instance HasTokenType 'ZLocalAuthUser -instance HasContextEntry ctx Domain => IsZType 'ZLocalAuthUser ctx where +instance (HasContextEntry ctx Domain) => IsZType 'ZLocalAuthUser ctx where type ZHeader 'ZLocalAuthUser = "Z-User" type ZParam 'ZLocalAuthUser = UserId type ZQualifiedParam 'ZLocalAuthUser = Local UserId @@ -228,7 +228,7 @@ type ZHostValue = Text type ZOptHostHeader = Header' '[Servant.Optional, Strict] "Z-Host" ZHostValue -instance HasOpenApi api => HasOpenApi (ZHostOpt :> api) where +instance (HasOpenApi api) => HasOpenApi (ZHostOpt :> api) where toOpenApi _ = toOpenApi (Proxy @api) type instance SpecialiseToVersion v (ZHostOpt :> api) = ZHostOpt :> SpecialiseToVersion v api @@ -249,19 +249,19 @@ type instance SpecialiseToVersion v (ZAuthServant t opts :> api) = ZAuthServant t opts :> SpecialiseToVersion v api -instance HasOpenApi api => HasOpenApi (ZAuthServant 'ZAuthUser _opts :> api) where +instance (HasOpenApi api) => HasOpenApi (ZAuthServant 'ZAuthUser _opts :> api) where toOpenApi _ = addZAuthSwagger (toOpenApi (Proxy @api)) -instance HasOpenApi api => HasOpenApi (ZAuthServant 'ZLocalAuthUser opts :> api) where +instance (HasOpenApi api) => HasOpenApi (ZAuthServant 'ZLocalAuthUser opts :> api) where toOpenApi _ = addZAuthSwagger (toOpenApi (Proxy @api)) -instance HasLink endpoint => HasLink (ZAuthServant usr opts :> endpoint) where +instance (HasLink endpoint) => HasLink (ZAuthServant usr opts :> endpoint) where type MkLink (ZAuthServant _ _ :> endpoint) a = MkLink endpoint a toLink toA _ = toLink toA (Proxy @endpoint) instance {-# OVERLAPPABLE #-} - HasOpenApi api => + (HasOpenApi api) => HasOpenApi (ZAuthServant ztype _opts :> api) where toOpenApi _ = toOpenApi (Proxy @api) @@ -319,10 +319,10 @@ instance hoistServerWithContext _ pc nt s = hoistServerWithContext (Proxy :: Proxy api) pc nt . s -instance RoutesToPaths api => RoutesToPaths (ZAuthServant ztype opts :> api) where +instance (RoutesToPaths api) => RoutesToPaths (ZAuthServant ztype opts :> api) where getRoutes = getRoutes @api -instance RoutesToPaths api => RoutesToPaths (ZHostOpt :> api) where +instance (RoutesToPaths api) => RoutesToPaths (ZHostOpt :> api) where getRoutes = getRoutes @api -- FUTUREWORK: Make a PR to the servant-swagger package with this instance @@ -341,19 +341,19 @@ instance where toOpenApi _ = addScopeDescription @scope (toOpenApi (Proxy @api)) -addScopeDescription :: forall scope. OAuth.IsOAuthScope scope => OpenApi -> OpenApi +addScopeDescription :: forall scope. (OAuth.IsOAuthScope scope) => OpenApi -> OpenApi addScopeDescription = allOperations . description %~ Just - . ( <> - "\nOAuth scope: `" - <> ( decodeUtf8With lenientDecode . toStrict . toByteString $ - OAuth.toOAuthScope @scope - ) - <> "`" - ) - . fold + . ( <> + "\nOAuth scope: `" + <> ( decodeUtf8With lenientDecode . toStrict . toByteString $ + OAuth.toOAuthScope @scope + ) + <> "`" + ) + . fold instance (HasServer api ctx) => HasServer (DescriptionOAuthScope scope :> api) ctx where type ServerT (DescriptionOAuthScope scope :> api) m = ServerT api m @@ -361,5 +361,5 @@ instance (HasServer api ctx) => HasServer (DescriptionOAuthScope scope :> api) c route _ = route (Proxy @api) hoistServerWithContext _ = hoistServerWithContext (Proxy @api) -instance RoutesToPaths api => RoutesToPaths (DescriptionOAuthScope scope :> api) where +instance (RoutesToPaths api) => RoutesToPaths (DescriptionOAuthScope scope :> api) where getRoutes = getRoutes @api diff --git a/libs/wire-api/src/Wire/API/Routes/Public/Cargohold.hs b/libs/wire-api/src/Wire/API/Routes/Public/Cargohold.hs index a1dc8001504..d9c7ca0ed3e 100644 --- a/libs/wire-api/src/Wire/API/Routes/Public/Cargohold.hs +++ b/libs/wire-api/src/Wire/API/Routes/Public/Cargohold.hs @@ -59,12 +59,12 @@ type instance SpecialiseToVersion v ((tag :: PrincipalTag) :> api) = SpecialiseToVersion v (ApplyPrincipalPath tag api) -instance HasServer (ApplyPrincipalPath tag api) ctx => HasServer (tag :> api) ctx where +instance (HasServer (ApplyPrincipalPath tag api) ctx) => HasServer (tag :> api) ctx where type ServerT (tag :> api) m = ServerT (ApplyPrincipalPath tag api) m route _ = route (Proxy @(ApplyPrincipalPath tag api)) hoistServerWithContext _ = hoistServerWithContext (Proxy @(ApplyPrincipalPath tag api)) -instance RoutesToPaths (ApplyPrincipalPath tag api) => RoutesToPaths (tag :> api) where +instance (RoutesToPaths (ApplyPrincipalPath tag api)) => RoutesToPaths (tag :> api) where getRoutes = getRoutes @(ApplyPrincipalPath tag api) type AssetLocationHeader r = diff --git a/libs/wire-api/src/Wire/API/Routes/Public/Galley/Messaging.hs b/libs/wire-api/src/Wire/API/Routes/Public/Galley/Messaging.hs index e079e33110d..d4b81661b79 100644 --- a/libs/wire-api/src/Wire/API/Routes/Public/Galley/Messaging.hs +++ b/libs/wire-api/src/Wire/API/Routes/Public/Galley/Messaging.hs @@ -131,7 +131,7 @@ data MessageNotSent a via (GenericAsUnion (MessageNotSentResponses a) (MessageNotSent a)) deriving anyclass (GSOP.Generic) -instance S.ToSchema a => S.ToSchema (MessageNotSent a) +instance (S.ToSchema a) => S.ToSchema (MessageNotSent a) type MessageNotSentResponses a = '[ ErrorResponse 'ConvNotFound, diff --git a/libs/wire-api/src/Wire/API/Routes/Public/Proxy.hs b/libs/wire-api/src/Wire/API/Routes/Public/Proxy.hs index 4fa0e100c83..aaf0874111e 100644 --- a/libs/wire-api/src/Wire/API/Routes/Public/Proxy.hs +++ b/libs/wire-api/src/Wire/API/Routes/Public/Proxy.hs @@ -17,7 +17,7 @@ module Wire.API.Routes.Public.Proxy where -import Servant +import Servant hiding (RawM) import Servant.API.Extended.RawM (RawM) import Wire.API.Routes.API import Wire.API.Routes.Named diff --git a/libs/wire-api/src/Wire/API/Routes/Public/Spar.hs b/libs/wire-api/src/Wire/API/Routes/Public/Spar.hs index 107ed1de9a5..e1f92b07998 100644 --- a/libs/wire-api/src/Wire/API/Routes/Public/Spar.hs +++ b/libs/wire-api/src/Wire/API/Routes/Public/Spar.hs @@ -167,8 +167,8 @@ data ScimSite tag route = ScimSite users :: route :- Header "Authorization" (Scim.Auth.AuthData tag) - :> "Users" - :> ToServantApi (Scim.User.UserSite tag) + :> "Users" + :> ToServantApi (Scim.User.UserSite tag) } deriving (Generic) diff --git a/libs/wire-api/src/Wire/API/Routes/SpecialiseToVersion.hs b/libs/wire-api/src/Wire/API/Routes/SpecialiseToVersion.hs index ac3b766e052..a2f29573f43 100644 --- a/libs/wire-api/src/Wire/API/Routes/SpecialiseToVersion.hs +++ b/libs/wire-api/src/Wire/API/Routes/SpecialiseToVersion.hs @@ -21,7 +21,7 @@ module Wire.API.Routes.SpecialiseToVersion where import Data.Singletons.Base.TH import GHC.TypeLits import Servant -import Servant.API.Extended.RawM +import Servant.API.Extended.RawM qualified as RawM import Wire.API.Deprecated import Wire.API.MakesFederatedCall import Wire.API.Routes.MultiVerb @@ -66,7 +66,7 @@ type instance SpecialiseToVersion v (MultiVerb m t r x) = MultiVerb m t r x -type instance SpecialiseToVersion v RawM = RawM +type instance SpecialiseToVersion v RawM.RawM = RawM.RawM type instance SpecialiseToVersion v (ReqBody t x :> api) = diff --git a/libs/wire-api/src/Wire/API/Routes/Version.hs b/libs/wire-api/src/Wire/API/Routes/Version.hs index f672efe25b7..2256e54ac69 100644 --- a/libs/wire-api/src/Wire/API/Routes/Version.hs +++ b/libs/wire-api/src/Wire/API/Routes/Version.hs @@ -68,7 +68,7 @@ import Data.Text.Encoding as Text import GHC.TypeLits import Imports hiding ((\\)) import Servant -import Servant.API.Extended.RawM +import Servant.API.Extended.RawM qualified as RawM import Wire.API.Deprecated import Wire.API.Routes.MultiVerb import Wire.API.Routes.Named hiding (unnamed) @@ -94,7 +94,7 @@ data Version = V0 | V1 | V2 | V3 | V4 | V5 | V6 -- which will cause `` and `fromEnum V` to diverge. `Enum` should not be understood as -- a bijection between meaningful integers and versions, but merely as a convenient way to say -- `allVersions = [minBound..]`. -versionInt :: Integral i => Version -> i +versionInt :: (Integral i) => Version -> i versionInt V0 = 0 versionInt V1 = 1 versionInt V2 = 2 @@ -123,8 +123,9 @@ instance ToSchema Version where instance FromHttpApiData Version where parseQueryParam v = note ("Unknown version: " <> v) $ getAlt $ - flip foldMap [minBound ..] $ \s -> - guard (versionText s == v) $> s + flip foldMap [minBound ..] $ + \s -> + guard (versionText s == v) $> s instance ToHttpApiData Version where toHeader = versionByteString @@ -175,7 +176,8 @@ instance ToSchema VersionInfo where schema = objectWithDocModifier "VersionInfo" (S.schema . S.example ?~ toJSON example) $ VersionInfo - <$> vinfoSupported .= vinfoObjectSchema schema + <$> vinfoSupported + .= vinfoObjectSchema schema <*> vinfoDevelopment .= field "development" (array schema) <*> vinfoFederation .= field "federation" schema <*> vinfoDomain .= field "domain" schema @@ -289,7 +291,7 @@ type instance SpecialiseToVersion v (MultiVerb m t r x) = MultiVerb m t r x -type instance SpecialiseToVersion v RawM = RawM +type instance SpecialiseToVersion v RawM.RawM = RawM.RawM type instance SpecialiseToVersion v (ReqBody t x :> api) = diff --git a/libs/wire-api/src/Wire/API/Routes/Versioned.hs b/libs/wire-api/src/Wire/API/Routes/Versioned.hs index 7707e3441e6..405ec783e00 100644 --- a/libs/wire-api/src/Wire/API/Routes/Versioned.hs +++ b/libs/wire-api/src/Wire/API/Routes/Versioned.hs @@ -39,7 +39,7 @@ data VersionedReqBody' v (mods :: [Type]) (ct :: [Type]) (a :: Type) type VersionedReqBody v = VersionedReqBody' v '[Required, Strict] -instance RoutesToPaths rest => RoutesToPaths (VersionedReqBody' v mods ct a :> rest) where +instance (RoutesToPaths rest) => RoutesToPaths (VersionedReqBody' v mods ct a :> rest) where getRoutes = getRoutes @rest instance @@ -78,7 +78,7 @@ data VersionedRespond v (s :: Nat) (desc :: Symbol) (a :: Type) type instance ResponseType (VersionedRespond v s desc a) = a instance - IsResponse cs (Respond s desc (Versioned v a)) => + (IsResponse cs (Respond s desc (Versioned v a))) => IsResponse cs (VersionedRespond v s desc a) where type ResponseStatus (VersionedRespond v s desc a) = ResponseStatus (Respond s desc a) @@ -106,9 +106,9 @@ newtype Versioned (v :: Version) a = Versioned {unVersioned :: a} instance Functor (Versioned v) where fmap f (Versioned a) = Versioned (f a) -deriving via Schema (Versioned v a) instance ToSchema (Versioned v a) => FromJSON (Versioned v a) +deriving via Schema (Versioned v a) instance (ToSchema (Versioned v a)) => FromJSON (Versioned v a) -deriving via Schema (Versioned v a) instance ToSchema (Versioned v a) => ToJSON (Versioned v a) +deriving via Schema (Versioned v a) instance (ToSchema (Versioned v a)) => ToJSON (Versioned v a) -- add version suffix to swagger schema to prevent collisions instance (SingI v, ToSchema (Versioned v a), Typeable a, Typeable v) => S.ToSchema (Versioned v a) where diff --git a/libs/wire-api/src/Wire/API/ServantProto.hs b/libs/wire-api/src/Wire/API/ServantProto.hs index 6e2dbd6140b..aba4621c91f 100644 --- a/libs/wire-api/src/Wire/API/ServantProto.hs +++ b/libs/wire-api/src/Wire/API/ServantProto.hs @@ -43,7 +43,7 @@ class ToProto a where instance Accept Proto where contentTypes _ = ("application" // "x-protobuf") :| [] -instance FromProto a => MimeUnrender Proto a where +instance (FromProto a) => MimeUnrender Proto a where mimeUnrender _ bs = fromProto (LBS.toStrict bs) -- | This wrapper can be used to get the raw protobuf representation of a type. @@ -54,8 +54,8 @@ data RawProto a = RawProto rpValue :: a } -instance FromProto a => FromProto (RawProto a) where +instance (FromProto a) => FromProto (RawProto a) where fromProto x = fmap (RawProto x) (fromProto x) -instance ToSchema a => ToSchema (RawProto a) where +instance (ToSchema a) => ToSchema (RawProto a) where declareNamedSchema _ = declareNamedSchema (Proxy @a) diff --git a/libs/wire-api/src/Wire/API/SwaggerServant.hs b/libs/wire-api/src/Wire/API/SwaggerServant.hs index 5c3918cf39c..8ea0729a504 100644 --- a/libs/wire-api/src/Wire/API/SwaggerServant.hs +++ b/libs/wire-api/src/Wire/API/SwaggerServant.hs @@ -37,12 +37,12 @@ data OmitDocs instance HasOpenApi (OmitDocs :> a) where toOpenApi _ = mempty -instance HasServer api ctx => HasServer (OmitDocs :> api) ctx where +instance (HasServer api ctx) => HasServer (OmitDocs :> api) ctx where type ServerT (OmitDocs :> api) m = ServerT api m route _ = route (Proxy :: Proxy api) hoistServerWithContext _ pc nt s = hoistServerWithContext (Proxy :: Proxy api) pc nt s -instance RoutesToPaths api => RoutesToPaths (OmitDocs :> api) where +instance (RoutesToPaths api) => RoutesToPaths (OmitDocs :> api) where getRoutes = getRoutes @api diff --git a/libs/wire-api/src/Wire/API/Team/Conversation.hs b/libs/wire-api/src/Wire/API/Team/Conversation.hs index 3822a614923..877ca425df3 100644 --- a/libs/wire-api/src/Wire/API/Team/Conversation.hs +++ b/libs/wire-api/src/Wire/API/Team/Conversation.hs @@ -68,7 +68,7 @@ instance ToSchema TeamConversation where (description ?~ managedDesc) (c (False :: Bool)) where - c :: A.ToJSON a => a -> ValueSchema SwaggerDoc () + c :: (A.ToJSON a) => a -> ValueSchema SwaggerDoc () c val = mkSchema mempty (const (pure ())) (const (pure (A.toJSON val))) newTeamConversation :: ConvId -> TeamConversation diff --git a/libs/wire-api/src/Wire/API/Team/Export.hs b/libs/wire-api/src/Wire/API/Team/Export.hs index 1f1d4b1462a..636950095bf 100644 --- a/libs/wire-api/src/Wire/API/Team/Export.hs +++ b/libs/wire-api/src/Wire/API/Team/Export.hs @@ -72,7 +72,7 @@ instance ToNamedRecord TeamExportUser where ("num_devices", secureCsvFieldToByteString (tExportNumDevices row)) ] -secureCsvFieldToByteString :: forall a. ToByteString a => a -> ByteString +secureCsvFieldToByteString :: forall a. (ToByteString a) => a -> ByteString secureCsvFieldToByteString = quoted . toByteString' instance DefaultOrdered TeamExportUser where @@ -98,7 +98,7 @@ allowEmpty :: (ByteString -> Parser a) -> ByteString -> Parser (Maybe a) allowEmpty _ "" = pure Nothing allowEmpty p str = Just <$> p str -parseByteString :: forall a. FromByteString a => ByteString -> Parser a +parseByteString :: forall a. (FromByteString a) => ByteString -> Parser a parseByteString bstr = case parseOnly (parser @a) (C.fromStrict (unquoted bstr)) of Left err -> fail err diff --git a/libs/wire-api/src/Wire/API/Team/Feature.hs b/libs/wire-api/src/Wire/API/Team/Feature.hs index 2376634db08..f2fec9ce3d6 100644 --- a/libs/wire-api/src/Wire/API/Team/Feature.hs +++ b/libs/wire-api/src/Wire/API/Team/Feature.hs @@ -223,10 +223,10 @@ class FeatureTrivialConfig cfg where class HasDeprecatedFeatureName cfg where type DeprecatedFeatureName cfg :: Symbol -featureName :: forall cfg. KnownSymbol (FeatureSymbol cfg) => Text +featureName :: forall cfg. (KnownSymbol (FeatureSymbol cfg)) => Text featureName = T.pack $ symbolVal (Proxy @(FeatureSymbol cfg)) -featureNameBS :: forall cfg. KnownSymbol (FeatureSymbol cfg) => ByteString +featureNameBS :: forall cfg. (KnownSymbol (FeatureSymbol cfg)) => ByteString featureNameBS = UTF8.fromString $ symbolVal (Proxy @(FeatureSymbol cfg)) ---------------------------------------------------------------------- @@ -268,10 +268,10 @@ setLockStatus ls (WithStatusBase s _ c ttl) = WithStatusBase s (Identity ls) c t setConfig :: cfg -> WithStatus cfg -> WithStatus cfg setConfig = setConfig' -setConfig' :: forall (m :: Type -> Type) (cfg :: Type). Applicative m => cfg -> WithStatusBase m cfg -> WithStatusBase m cfg +setConfig' :: forall (m :: Type -> Type) (cfg :: Type). (Applicative m) => cfg -> WithStatusBase m cfg -> WithStatusBase m cfg setConfig' c (WithStatusBase s ls _ ttl) = WithStatusBase s ls (pure c) ttl -setTTL :: forall (m :: Type -> Type) (cfg :: Type). Applicative m => FeatureTTL -> WithStatusBase m cfg -> WithStatusBase m cfg +setTTL :: forall (m :: Type -> Type) (cfg :: Type). (Applicative m) => FeatureTTL -> WithStatusBase m cfg -> WithStatusBase m cfg setTTL ttl (WithStatusBase s ls c _) = WithStatusBase s ls c (pure ttl) setWsTTL :: FeatureTTL -> WithStatus cfg -> WithStatus cfg @@ -339,7 +339,7 @@ withStatus' = WithStatusBase -- | The ToJSON implementation of `WithStatusPatch` will encode the trivial config as `"config": {}` -- when the value is a `Just`, if it's `Nothing` it will be omitted, which is the important part. -instance ToSchema cfg => ToSchema (WithStatusPatch cfg) where +instance (ToSchema cfg) => ToSchema (WithStatusPatch cfg) where schema = object name $ WithStatusBase @@ -373,7 +373,7 @@ data WithStatusNoLock (cfg :: Type) = WithStatusNoLock deriving stock (Eq, Show, Generic, Typeable, Functor) deriving (ToJSON, FromJSON, S.ToSchema) via (Schema (WithStatusNoLock cfg)) -instance Arbitrary cfg => Arbitrary (WithStatusNoLock cfg) where +instance (Arbitrary cfg) => Arbitrary (WithStatusNoLock cfg) where arbitrary = WithStatusNoLock <$> arbitrary <*> arbitrary <*> arbitrary forgetLock :: WithStatus a -> WithStatusNoLock a @@ -1215,7 +1215,7 @@ instance Cass.Cql FeatureStatus where toCql FeatureStatusDisabled = Cass.CqlInt 0 toCql FeatureStatusEnabled = Cass.CqlInt 1 -defFeatureStatusNoLock :: IsFeatureConfig cfg => WithStatusNoLock cfg +defFeatureStatusNoLock :: (IsFeatureConfig cfg) => WithStatusNoLock cfg defFeatureStatusNoLock = forgetLock defFeatureStatus data AllFeatureConfigs = AllFeatureConfigs diff --git a/libs/wire-api/src/Wire/API/Team/HardTruncationLimit.hs b/libs/wire-api/src/Wire/API/Team/HardTruncationLimit.hs index 0ec378cc1bd..47845ffc6a7 100644 --- a/libs/wire-api/src/Wire/API/Team/HardTruncationLimit.hs +++ b/libs/wire-api/src/Wire/API/Team/HardTruncationLimit.hs @@ -6,5 +6,5 @@ import Imports type HardTruncationLimit = (2000 :: Nat) -hardTruncationLimit :: Integral a => a +hardTruncationLimit :: (Integral a) => a hardTruncationLimit = fromIntegral $ natVal (Proxy @HardTruncationLimit) diff --git a/libs/wire-api/src/Wire/API/Team/LegalHold.hs b/libs/wire-api/src/Wire/API/Team/LegalHold.hs index e25f3ec7577..c0bfa22047c 100644 --- a/libs/wire-api/src/Wire/API/Team/LegalHold.hs +++ b/libs/wire-api/src/Wire/API/Team/LegalHold.hs @@ -94,7 +94,8 @@ instance ToSchema LHServiceStatus where instance ToSchema ViewLegalHoldService where schema = object "ViewLegalHoldService" $ - toOutput .= recordSchema + toOutput + .= recordSchema `withParser` validateViewLegalHoldService where toOutput :: ViewLegalHoldService -> (LHServiceStatus, Maybe ViewLegalHoldServiceInfo) diff --git a/libs/wire-api/src/Wire/API/Team/LegalHold/External.hs b/libs/wire-api/src/Wire/API/Team/LegalHold/External.hs index 8dc5fd14366..a38b8ee5096 100644 --- a/libs/wire-api/src/Wire/API/Team/LegalHold/External.hs +++ b/libs/wire-api/src/Wire/API/Team/LegalHold/External.hs @@ -64,8 +64,10 @@ instance ToSchema RequestNewLegalHoldClient where instance ToJSON RequestNewLegalHoldClient where toJSON (RequestNewLegalHoldClient userId teamId) = object $ - "user_id" .= userId - # "team_id" .= teamId + "user_id" + .= userId + # "team_id" + .= teamId # [] instance FromJSON RequestNewLegalHoldClient where @@ -96,8 +98,10 @@ instance ToSchema NewLegalHoldClient where instance ToJSON NewLegalHoldClient where toJSON c = object $ - "prekeys" .= newLegalHoldClientPrekeys c - # "last_prekey" .= newLegalHoldClientLastKey c + "prekeys" + .= newLegalHoldClientPrekeys c + # "last_prekey" + .= newLegalHoldClientLastKey c # [] instance FromJSON NewLegalHoldClient where @@ -123,10 +127,14 @@ data LegalHoldServiceConfirm = LegalHoldServiceConfirm instance ToJSON LegalHoldServiceConfirm where toJSON (LegalHoldServiceConfirm clientId userId teamId refreshToken) = object $ - "client_id" .= clientId - # "user_id" .= userId - # "team_id" .= teamId - # "refresh_token" .= refreshToken + "client_id" + .= clientId + # "user_id" + .= userId + # "team_id" + .= teamId + # "refresh_token" + .= refreshToken # [] instance FromJSON LegalHoldServiceConfirm where @@ -151,8 +159,10 @@ data LegalHoldServiceRemove = LegalHoldServiceRemove instance ToJSON LegalHoldServiceRemove where toJSON (LegalHoldServiceRemove userId teamId) = object $ - "user_id" .= userId - # "team_id" .= teamId + "user_id" + .= userId + # "team_id" + .= teamId # [] instance FromJSON LegalHoldServiceRemove where diff --git a/libs/wire-api/src/Wire/API/Team/LegalHold/Internal.hs b/libs/wire-api/src/Wire/API/Team/LegalHold/Internal.hs index e706f472fc6..7b269033d94 100644 --- a/libs/wire-api/src/Wire/API/Team/LegalHold/Internal.hs +++ b/libs/wire-api/src/Wire/API/Team/LegalHold/Internal.hs @@ -49,11 +49,16 @@ data LegalHoldService = LegalHoldService instance ToJSON LegalHoldService where toJSON s = object $ - "team_id" .= legalHoldServiceTeam s - # "base_url" .= legalHoldServiceUrl s - # "fingerprint" .= legalHoldServiceFingerprint s - # "auth_token" .= legalHoldServiceToken s - # "public_key" .= legalHoldServiceKey s + "team_id" + .= legalHoldServiceTeam s + # "base_url" + .= legalHoldServiceUrl s + # "fingerprint" + .= legalHoldServiceFingerprint s + # "auth_token" + .= legalHoldServiceToken s + # "public_key" + .= legalHoldServiceKey s # [] instance FromJSON LegalHoldService where diff --git a/libs/wire-api/src/Wire/API/Team/Member.hs b/libs/wire-api/src/Wire/API/Team/Member.hs index 28c72a3808b..812c63c000d 100644 --- a/libs/wire-api/src/Wire/API/Team/Member.hs +++ b/libs/wire-api/src/Wire/API/Team/Member.hs @@ -117,11 +117,11 @@ data TeamMember' (tag :: PermissionTag) = TeamMember ntmNewTeamMember :: NewTeamMember' tag -> TeamMember' tag ntmNewTeamMember ntm = TeamMember ntm defUserLegalHoldStatus -deriving instance Eq (PermissionType tag) => Eq (TeamMember' tag) +deriving instance (Eq (PermissionType tag)) => Eq (TeamMember' tag) -deriving instance Ord (PermissionType tag) => Ord (TeamMember' tag) +deriving instance (Ord (PermissionType tag)) => Ord (TeamMember' tag) -deriving instance Show (PermissionType tag) => Show (TeamMember' tag) +deriving instance (Show (PermissionType tag)) => Show (TeamMember' tag) deriving via (GenericUniform TeamMember) instance Arbitrary TeamMember @@ -243,9 +243,9 @@ data TeamMemberList' (tag :: PermissionTag) = TeamMemberList } deriving stock (Generic) -deriving instance Eq (PermissionType tag) => Eq (TeamMemberList' tag) +deriving instance (Eq (PermissionType tag)) => Eq (TeamMemberList' tag) -deriving instance Show (PermissionType tag) => Show (TeamMemberList' tag) +deriving instance (Show (PermissionType tag)) => Show (TeamMemberList' tag) deriving via (GenericUniform (TeamMemberList' 'Optional)) instance Arbitrary (TeamMemberList' 'Optional) @@ -254,13 +254,13 @@ deriving via (GenericUniform TeamMemberList) instance Arbitrary TeamMemberList deriving via (Schema (TeamMemberList' tag)) instance - ToSchema (TeamMemberList' tag) => + (ToSchema (TeamMemberList' tag)) => FromJSON (TeamMemberList' tag) deriving via (Schema (TeamMemberList' tag)) instance - ToSchema (TeamMemberList' tag) => + (ToSchema (TeamMemberList' tag)) => ToJSON (TeamMemberList' tag) deriving via @@ -272,7 +272,7 @@ deriving via newTeamMemberList :: [TeamMember] -> ListType -> TeamMemberList newTeamMemberList = TeamMemberList -instance ToSchema (TeamMember' tag) => ToSchema (TeamMemberList' tag) where +instance (ToSchema (TeamMember' tag)) => ToSchema (TeamMemberList' tag) where schema = objectWithDocModifier "TeamMemberList" (description ?~ "list of team member") $ TeamMemberList diff --git a/libs/wire-api/src/Wire/API/Team/Role.hs b/libs/wire-api/src/Wire/API/Team/Role.hs index d4602394750..8b1060f3a7c 100644 --- a/libs/wire-api/src/Wire/API/Team/Role.hs +++ b/libs/wire-api/src/Wire/API/Team/Role.hs @@ -102,7 +102,7 @@ instance FromHttpApiData Role where flip foldMap [minBound .. maxBound] $ \s -> guard (T.pack (show s) == name) $> s -roleName :: IsString a => Role -> a +roleName :: (IsString a) => Role -> a roleName RoleOwner = "owner" roleName RoleAdmin = "admin" roleName RoleMember = "member" diff --git a/libs/wire-api/src/Wire/API/User.hs b/libs/wire-api/src/Wire/API/User.hs index 2e3e6f0a017..ce26cfb4eca 100644 --- a/libs/wire-api/src/Wire/API/User.hs +++ b/libs/wire-api/src/Wire/API/User.hs @@ -588,7 +588,7 @@ instance (KnownNat max, 1 <= max) => FromJSON (LimitedQualifiedUserIdList max) w parseJSON = A.withObject "LimitedQualifiedUserIdList" $ \o -> LimitedQualifiedUserIdList <$> o A..: "qualified_users" -instance 1 <= max => ToJSON (LimitedQualifiedUserIdList max) where +instance (1 <= max) => ToJSON (LimitedQualifiedUserIdList max) where toJSON e = A.object ["qualified_users" A..= qualifiedUsers e] -------------------------------------------------------------------------------- diff --git a/libs/wire-api/src/Wire/API/User/Auth.hs b/libs/wire-api/src/Wire/API/User/Auth.hs index 135c1cb89ba..3206b173747 100644 --- a/libs/wire-api/src/Wire/API/User/Auth.hs +++ b/libs/wire-api/src/Wire/API/User/Auth.hs @@ -69,6 +69,7 @@ import Data.ByteString.Builder import Data.ByteString.Conversion import Data.ByteString.Lazy qualified as LBS import Data.Code as Code +import Data.Functor.Alt import Data.Handle (Handle) import Data.Id import Data.Json.Util @@ -125,7 +126,9 @@ loginObjectSchema = validate :: (Maybe Email, Maybe Phone, Maybe Handle) -> A.Parser LoginId validate (mEmail, mPhone, mHandle) = maybe (fail "'email', 'phone' or 'handle' required") pure $ - (LoginByEmail <$> mEmail) <|> (LoginByPhone <$> mPhone) <|> (LoginByHandle <$> mHandle) + (LoginByEmail <$> mEmail) + <|> (LoginByPhone <$> mPhone) + <|> (LoginByHandle <$> mHandle) -------------------------------------------------------------------------------- -- LoginCode @@ -504,7 +507,7 @@ instance FromHttpApiData SomeUserToken where parseHeader h = first T.pack $ fmap PlainUserToken (runParser parser h) - <|> fmap LHUserToken (runParser parser h) + fmap LHUserToken (runParser parser h) parseUrlPiece = parseHeader . T.encodeUtf8 instance FromByteString SomeUserToken where @@ -525,7 +528,7 @@ instance FromHttpApiData SomeAccessToken where parseHeader h = first T.pack $ fmap PlainAccessToken (runParser parser h) - <|> fmap LHAccessToken (runParser parser h) + fmap LHAccessToken (runParser parser h) parseUrlPiece = parseHeader . T.encodeUtf8 -- | Data that is returned to the client in the form of a cookie containing a diff --git a/libs/wire-api/src/Wire/API/User/Client.hs b/libs/wire-api/src/Wire/API/User/Client.hs index ecdc20531bd..35bbde4892d 100644 --- a/libs/wire-api/src/Wire/API/User/Client.hs +++ b/libs/wire-api/src/Wire/API/User/Client.hs @@ -180,7 +180,7 @@ instance ToSchema ClientCapabilityList where ClientCapabilityList <$> fromClientCapabilityList .= fmap runIdentity capabilitiesFieldSchema capabilitiesFieldSchema :: - FieldFunctor SwaggerDoc f => + (FieldFunctor SwaggerDoc f) => ObjectSchemaP SwaggerDoc (Set ClientCapability) (f (Set ClientCapability)) capabilitiesFieldSchema = Set.toList @@ -201,7 +201,7 @@ newtype UserClientMap a = UserClientMap deriving newtype (Semigroup, Monoid) deriving (FromJSON, ToJSON, Swagger.ToSchema) via Schema (UserClientMap a) -instance ToSchema a => ToSchema (UserClientMap a) where +instance (ToSchema a) => ToSchema (UserClientMap a) where schema = userClientMapSchema schema class WrapName doc where @@ -247,7 +247,7 @@ instance ToSchema UserClientPrekeyMap where ) ) -instance Arbitrary a => Arbitrary (UserClientMap a) where +instance (Arbitrary a) => Arbitrary (UserClientMap a) where arbitrary = UserClientMap <$> mapOf' arbitrary (mapOf' arbitrary arbitrary) newtype QualifiedUserClientMap a = QualifiedUserClientMap @@ -256,17 +256,17 @@ newtype QualifiedUserClientMap a = QualifiedUserClientMap deriving stock (Eq, Show, Functor) deriving (FromJSON, ToJSON, Swagger.ToSchema) via Schema (QualifiedUserClientMap a) -instance Semigroup a => Semigroup (QualifiedUserClientMap a) where +instance (Semigroup a) => Semigroup (QualifiedUserClientMap a) where (QualifiedUserClientMap m1) <> (QualifiedUserClientMap m2) = QualifiedUserClientMap $ Map.unionWith (Map.unionWith (Map.unionWith (<>))) m1 m2 -instance Semigroup (QualifiedUserClientMap a) => Monoid (QualifiedUserClientMap a) where +instance (Semigroup (QualifiedUserClientMap a)) => Monoid (QualifiedUserClientMap a) where mempty = QualifiedUserClientMap mempty -instance Arbitrary a => Arbitrary (QualifiedUserClientMap a) where +instance (Arbitrary a) => Arbitrary (QualifiedUserClientMap a) where arbitrary = QualifiedUserClientMap <$> mapOf' arbitrary (mapOf' arbitrary (mapOf' arbitrary arbitrary)) -instance ToSchema a => ToSchema (QualifiedUserClientMap a) where +instance (ToSchema a) => ToSchema (QualifiedUserClientMap a) where schema = qualifiedUserClientMapSchema schema qualifiedUserClientMapSchema :: diff --git a/libs/wire-api/src/Wire/API/User/Client/Prekey.hs b/libs/wire-api/src/Wire/API/User/Client/Prekey.hs index 9447da1b530..1a8c1edf9b5 100644 --- a/libs/wire-api/src/Wire/API/User/Client/Prekey.hs +++ b/libs/wire-api/src/Wire/API/User/Client/Prekey.hs @@ -94,8 +94,9 @@ instance ToSchema LastPrekey where schema = LastPrekey <$> unpackLastPrekey .= schema `withParser` check where check x = - x <$ guard (prekeyId x == lastPrekeyId) - <|> fail "Invalid last prekey ID" + x + <$ guard (prekeyId x == lastPrekeyId) + <|> fail "Invalid last prekey ID" instance Arbitrary LastPrekey where arbitrary = lastPrekey <$> arbitrary diff --git a/libs/wire-api/src/Wire/API/User/Identity.hs b/libs/wire-api/src/Wire/API/User/Identity.hs index 217c55d5864..19e3f68218d 100644 --- a/libs/wire-api/src/Wire/API/User/Identity.hs +++ b/libs/wire-api/src/Wire/API/User/Identity.hs @@ -54,6 +54,7 @@ where import Cassandra qualified as C import Control.Applicative (optional) +import Control.Error (hush) import Control.Lens (dimap, over, (.~), (?~), (^.)) import Data.Aeson (FromJSON (..), ToJSON (..)) import Data.Aeson qualified as A @@ -115,9 +116,12 @@ type UserIdentityComponents = (Maybe Email, Maybe Phone, Maybe UserSSOId) userIdentityComponentsObjectSchema :: ObjectSchema SwaggerDoc UserIdentityComponents userIdentityComponentsObjectSchema = (,,) - <$> fst3 .= maybe_ (optField "email" schema) - <*> snd3 .= maybe_ (optField "phone" schema) - <*> thd3 .= maybe_ (optField "sso_id" genericToSchema) + <$> fst3 + .= maybe_ (optField "email" schema) + <*> snd3 + .= maybe_ (optField "phone" schema) + <*> thd3 + .= maybe_ (optField "sso_id" genericToSchema) maybeUserIdentityFromComponents :: UserIdentityComponents -> Maybe UserIdentity maybeUserIdentityFromComponents = \case @@ -237,10 +241,12 @@ parseEmail t = case Text.split (== '@') t of -- is the dependency worth it just for validating the local part? validateEmail :: Email -> Either String Email validateEmail = - pure . uncurry Email + pure + . uncurry Email <=< validateDomain <=< validateExternalLib - <=< validateLength . fromEmail + <=< validateLength + . fromEmail where validateLength e | len <= 100 = Right e @@ -277,7 +283,8 @@ instance ToParamSchema Phone where instance ToSchema Phone where schema = over doc (S.description ?~ "E.164 phone number") $ - fromPhone .= parsedText "PhoneNumber" (maybe (Left "Invalid phone number. Expected E.164 format.") Right . parsePhone) + fromPhone + .= parsedText "PhoneNumber" (maybe (Left "Invalid phone number. Expected E.164 format.") Right . parsePhone) instance ToByteString Phone where builder = builder . fromPhone @@ -366,7 +373,8 @@ instance S.ToSchema UserSSOId where pure $ S.NamedSchema (Just "UserSSOId") $ mempty - & S.type_ ?~ S.OpenApiObject + & S.type_ + ?~ S.OpenApiObject & S.properties .~ [ ("tenant", tenantSchema), ("subject", subjectSchema), @@ -416,7 +424,7 @@ lenientlyParseSAMLIssuer mbtxt = forM mbtxt $ \txt -> do err :: String err = "lenientlyParseSAMLIssuer: " <> show (asxml, asurl, mbtxt) - either (const $ fail err) pure $ asxml <|> asurl + maybe (fail err) pure $ hush asxml <|> hush asurl lenientlyParseSAMLNameID :: Maybe LText -> A.Parser (Maybe SAML.NameID) lenientlyParseSAMLNameID Nothing = pure Nothing @@ -439,23 +447,23 @@ lenientlyParseSAMLNameID (Just txt) = do err :: String err = "lenientlyParseSAMLNameID: " <> show (asxml, asemail, astxt, txt) - either - (const $ fail err) + maybe + (fail err) (pure . Just) - (asxml <|> asemail <|> astxt) + (hush asxml <|> hush asemail <|> hush astxt) -emailFromSAML :: HasCallStack => SAMLEmail.Email -> Email +emailFromSAML :: (HasCallStack) => SAMLEmail.Email -> Email emailFromSAML = fromJust . parseEmail . SAMLEmail.render -emailToSAML :: HasCallStack => Email -> SAMLEmail.Email +emailToSAML :: (HasCallStack) => Email -> SAMLEmail.Email emailToSAML = CI.original . fromRight (error "emailToSAML") . SAMLEmail.validate . toByteString -- | FUTUREWORK(fisx): if saml2-web-sso exported the 'NameID' constructor, we could make this -- function total without all that praying and hoping. -emailToSAMLNameID :: HasCallStack => Email -> SAML.NameID +emailToSAMLNameID :: (HasCallStack) => Email -> SAML.NameID emailToSAMLNameID = fromRight (error "impossible") . SAML.emailNameID . fromEmail -emailFromSAMLNameID :: HasCallStack => SAML.NameID -> Maybe Email +emailFromSAMLNameID :: (HasCallStack) => SAML.NameID -> Maybe Email emailFromSAMLNameID nid = case nid ^. SAML.nameID of SAML.UNameIDEmail email -> Just . emailFromSAML . CI.original $ email _ -> Nothing diff --git a/libs/wire-api/src/Wire/API/User/IdentityProvider.hs b/libs/wire-api/src/Wire/API/User/IdentityProvider.hs index 544e8718685..9100be731e2 100644 --- a/libs/wire-api/src/Wire/API/User/IdentityProvider.hs +++ b/libs/wire-api/src/Wire/API/User/IdentityProvider.hs @@ -21,7 +21,6 @@ module Wire.API.User.IdentityProvider where import Cassandra qualified as Cql import Control.Lens (makeLenses, (.~), (?~)) -import Control.Monad.Except import Data.Aeson import Data.Aeson.TH import Data.Aeson.Types (parseMaybe) @@ -211,10 +210,14 @@ instance ToSchema IdPMetadataInfo where pure $ NamedSchema (Just "IdPMetadataInfo") $ mempty - & properties .~ properties_ - & minProperties ?~ 1 - & maxProperties ?~ 1 - & type_ ?~ OpenApiObject + & properties + .~ properties_ + & minProperties + ?~ 1 + & maxProperties + ?~ 1 + & type_ + ?~ OpenApiObject where properties_ :: InsOrdHashMap Text (Referenced Schema) properties_ = diff --git a/libs/wire-api/src/Wire/API/User/Orphans.hs b/libs/wire-api/src/Wire/API/User/Orphans.hs index 5cb2e0225db..0f019fdc1f9 100644 --- a/libs/wire-api/src/Wire/API/User/Orphans.hs +++ b/libs/wire-api/src/Wire/API/User/Orphans.hs @@ -114,13 +114,13 @@ instance ToSchema SAML.SPMetadata where instance ToSchema Void where declareNamedSchema _ = declareNamedSchema (Proxy @String) -instance HasOpenApi route => HasOpenApi (SM.MultipartForm SM.Mem resp :> route) where +instance (HasOpenApi route) => HasOpenApi (SM.MultipartForm SM.Mem resp :> route) where toOpenApi _proxy = toOpenApi (Proxy @route) instance ToSchema SAML.IdPId where declareNamedSchema _ = declareNamedSchema (Proxy @UUID) -instance ToSchema a => ToSchema (SAML.IdPConfig a) where +instance (ToSchema a) => ToSchema (SAML.IdPConfig a) where declareNamedSchema = genericDeclareNamedSchema samlSchemaOptions instance ToSchema SAML.Issuer where diff --git a/libs/wire-api/src/Wire/API/User/Profile.hs b/libs/wire-api/src/Wire/API/User/Profile.hs index 9a5e06883d2..a946c6249aa 100644 --- a/libs/wire-api/src/Wire/API/User/Profile.hs +++ b/libs/wire-api/src/Wire/API/User/Profile.hs @@ -148,7 +148,7 @@ instance C.Cql Asset where 0 -> pure $! ImageAsset k s _ -> Left $ "unexpected user asset type: " ++ show t where - required :: C.Cql r => Text -> Either String r + required :: (C.Cql r) => Text -> Either String r required f = maybe (Left ("Asset: Missing required field '" ++ show f ++ "'")) diff --git a/libs/wire-api/src/Wire/API/User/RichInfo.hs b/libs/wire-api/src/Wire/API/User/RichInfo.hs index d84ba4f3c2f..3796d811077 100644 --- a/libs/wire-api/src/Wire/API/User/RichInfo.hs +++ b/libs/wire-api/src/Wire/API/User/RichInfo.hs @@ -261,7 +261,7 @@ instance Arbitrary RichInfoMapAndList where arbitrary = mkRichInfoMapAndList <$> arbitrary -- | Uniform Resource Names used for serialization of 'RichInfo'. -richInfoMapURN, richInfoAssocListURN :: IsString s => s +richInfoMapURN, richInfoAssocListURN :: (IsString s) => s richInfoMapURN = "urn:ietf:params:scim:schemas:extension:wire:1.0:User" richInfoAssocListURN = "urn:wire:scim:schemas:profile:1.0" diff --git a/libs/wire-api/src/Wire/API/User/Saml.hs b/libs/wire-api/src/Wire/API/User/Saml.hs index f165a17f76c..fa97f24fb07 100644 --- a/libs/wire-api/src/Wire/API/User/Saml.hs +++ b/libs/wire-api/src/Wire/API/User/Saml.hs @@ -66,7 +66,7 @@ makeLenses ''VerdictFormat deriveJSON deriveJSONOptions ''VerdictFormat -mkVerdictGrantedFormatMobile :: MonadError String m => URI -> SetCookie -> UserId -> m URI +mkVerdictGrantedFormatMobile :: (MonadError String m) => URI -> SetCookie -> UserId -> m URI mkVerdictGrantedFormatMobile before cky uid = parseURI' . substituteVar @@ -80,7 +80,7 @@ mkVerdictGrantedFormatMobile before cky uid = . substituteVar "userid" (T.pack . show $ uid) $ renderURI before -mkVerdictDeniedFormatMobile :: MonadError String m => URI -> Text -> m URI +mkVerdictDeniedFormatMobile :: (MonadError String m) => URI -> Text -> m URI mkVerdictDeniedFormatMobile before lbl = parseURI' . substituteVar "label" lbl @@ -96,7 +96,7 @@ substituteVar' var val = T.intercalate val . T.splitOn var newtype TTL (tablename :: Symbol) = TTL {fromTTL :: Int32} deriving (Eq, Ord, Show, Num) -showTTL :: KnownSymbol a => TTL a -> String +showTTL :: (KnownSymbol a) => TTL a -> String showTTL (TTL i :: TTL a) = "TTL:" <> symbolVal (Proxy @a) <> ":" <> show i instance FromJSON (TTL a) where diff --git a/libs/wire-api/src/Wire/API/User/Scim.hs b/libs/wire-api/src/Wire/API/User/Scim.hs index d8482447523..eebfe13621c 100644 --- a/libs/wire-api/src/Wire/API/User/Scim.hs +++ b/libs/wire-api/src/Wire/API/User/Scim.hs @@ -168,11 +168,16 @@ instance FromJSON ScimTokenInfo where instance ToJSON ScimTokenInfo where toJSON s = A.object $ - "team" A..= stiTeam s - # "id" A..= stiId s - # "created_at" A..= stiCreatedAt s - # "idp" A..= stiIdP s - # "description" A..= stiDescr s + "team" + A..= stiTeam s + # "id" + A..= stiId s + # "created_at" + A..= stiCreatedAt s + # "idp" + A..= stiIdP s + # "description" + A..= stiDescr s # [] ---------------------------------------------------------------------------- diff --git a/libs/wire-api/src/Wire/API/User/Search.hs b/libs/wire-api/src/Wire/API/User/Search.hs index 435c7cf3998..dfeb601c4e0 100644 --- a/libs/wire-api/src/Wire/API/User/Search.hs +++ b/libs/wire-api/src/Wire/API/User/Search.hs @@ -107,7 +107,7 @@ instance Traversable SearchResult where newResults <- traverse f (searchResults r) pure $ r {searchResults = newResults} -instance ToSchema a => ToSchema (SearchResult a) where +instance (ToSchema a) => ToSchema (SearchResult a) where schema = object "SearchResult" $ SearchResult @@ -247,7 +247,7 @@ instance FromHttpApiData TeamUserSearchSortBy where flip foldMap [minBound .. maxBound] $ \s -> guard (teamUserSearchSortByName s == name) $> s -teamUserSearchSortByName :: IsString a => TeamUserSearchSortBy -> a +teamUserSearchSortByName :: (IsString a) => TeamUserSearchSortBy -> a teamUserSearchSortByName SortByName = "name" teamUserSearchSortByName SortByHandle = "handle" teamUserSearchSortByName SortByEmail = "email" @@ -283,7 +283,7 @@ instance FromHttpApiData TeamUserSearchSortOrder where flip foldMap [minBound .. maxBound] $ \s -> guard (teamUserSearchSortOrderName s == name) $> s -teamUserSearchSortOrderName :: IsString a => TeamUserSearchSortOrder -> a +teamUserSearchSortOrderName :: (IsString a) => TeamUserSearchSortOrder -> a teamUserSearchSortOrderName SortOrderAsc = "asc" teamUserSearchSortOrderName SortOrderDesc = "desc" diff --git a/libs/wire-api/src/Wire/API/UserMap.hs b/libs/wire-api/src/Wire/API/UserMap.hs index 31f81392195..e0889e2832d 100644 --- a/libs/wire-api/src/Wire/API/UserMap.hs +++ b/libs/wire-api/src/Wire/API/UserMap.hs @@ -38,7 +38,7 @@ newtype UserMap a = UserMap {userMap :: Map UserId a} deriving stock (Eq, Show) deriving newtype (Semigroup, Monoid, ToJSON, FromJSON, Functor) -instance Arbitrary a => Arbitrary (UserMap a) where +instance (Arbitrary a) => Arbitrary (UserMap a) where arbitrary = UserMap <$> mapOf' arbitrary arbitrary type WrappedQualifiedUserMap a = Wrapped "qualified_user_map" (QualifiedUserMap a) @@ -53,7 +53,7 @@ instance Functor QualifiedUserMap where fmap f (QualifiedUserMap qMap) = QualifiedUserMap $ f <$$> qMap -instance Arbitrary a => Arbitrary (QualifiedUserMap a) where +instance (Arbitrary a) => Arbitrary (QualifiedUserMap a) where arbitrary = QualifiedUserMap <$> mapOf' arbitrary arbitrary instance (ToSchema a, ToJSON a, Arbitrary a) => ToSchema (UserMap (Set a)) where diff --git a/libs/wire-api/src/Wire/API/VersionInfo.hs b/libs/wire-api/src/Wire/API/VersionInfo.hs index 1d05a55e027..b7267028b60 100644 --- a/libs/wire-api/src/Wire/API/VersionInfo.hs +++ b/libs/wire-api/src/Wire/API/VersionInfo.hs @@ -107,7 +107,7 @@ instance clientWithRoute pm (Proxy @api) req hoistClientMonad pm _ f = hoistClientMonad pm (Proxy @api) f -instance RoutesToPaths api => RoutesToPaths (Until v :> api) where +instance (RoutesToPaths api) => RoutesToPaths (Until v :> api) where getRoutes = getRoutes @api instance @@ -155,5 +155,5 @@ instance clientWithRoute pm (Proxy @api) req hoistClientMonad pm _ f = hoistClientMonad pm (Proxy @api) f -instance RoutesToPaths api => RoutesToPaths (From v :> api) where +instance (RoutesToPaths api) => RoutesToPaths (From v :> api) where getRoutes = getRoutes @api diff --git a/libs/wire-api/test/golden/Test/Wire/API/Golden/Runner.hs b/libs/wire-api/test/golden/Test/Wire/API/Golden/Runner.hs index 6a458413d84..a7db1f7594d 100644 --- a/libs/wire-api/test/golden/Test/Wire/API/Golden/Runner.hs +++ b/libs/wire-api/test/golden/Test/Wire/API/Golden/Runner.hs @@ -147,7 +147,7 @@ testFromJSONFailureWithMsg msg path = do where failurePrefix = show (typeRep @a) <> ": FromJSON of " <> path -assertRight :: Show a => Either a b -> IO b +assertRight :: (Show a) => Either a b -> IO b assertRight = \case Left a -> assertFailure $ "Expected Right, got Left: " <> show a diff --git a/libs/wire-api/test/unit/Test/Wire/API/MLS.hs b/libs/wire-api/test/unit/Test/Wire/API/MLS.hs index e98ae87e01f..b6fcf5d945f 100644 --- a/libs/wire-api/test/unit/Test/Wire/API/MLS.hs +++ b/libs/wire-api/test/unit/Test/Wire/API/MLS.hs @@ -280,7 +280,7 @@ createGroup tmp store groupName removalKey gid = do Nothing liftIO $ BS.writeFile (tmp groupName) groupJSON -decodeMLSError :: ParseMLS a => ByteString -> a +decodeMLSError :: (ParseMLS a) => ByteString -> a decodeMLSError s = case decodeMLS' s of Left e -> error ("Could not parse MLS object: " <> Text.unpack e) Right x -> x @@ -293,7 +293,7 @@ userClientQid usr c = <> "@" <> T.unpack (domainText (qDomain usr)) -spawn :: HasCallStack => CreateProcess -> Maybe ByteString -> IO ByteString +spawn :: (HasCallStack) => CreateProcess -> Maybe ByteString -> IO ByteString spawn cp minput = do (mout, ex) <- withCreateProcess cp diff --git a/libs/wire-api/test/unit/Test/Wire/API/Roundtrip/MLS.hs b/libs/wire-api/test/unit/Test/Wire/API/Roundtrip/MLS.hs index d8b6ec7f552..e68b24d6718 100644 --- a/libs/wire-api/test/unit/Test/Wire/API/Roundtrip/MLS.hs +++ b/libs/wire-api/test/unit/Test/Wire/API/Roundtrip/MLS.hs @@ -88,7 +88,7 @@ class ArbitraryFramedContent a where newtype MessageGenerator fc = MessageGenerator {unMessageGenerator :: Message} deriving newtype (ParseMLS, SerialiseMLS, Eq, Show) -instance ArbitraryFramedContent fc => Arbitrary (MessageGenerator fc) where +instance (ArbitraryFramedContent fc) => Arbitrary (MessageGenerator fc) where arbitrary = fmap MessageGenerator $ do fc <- arbitraryFramedContent @fc diff --git a/libs/wire-api/wire-api.cabal b/libs/wire-api/wire-api.cabal index ec9ca0404e6..4cb54116bdb 100644 --- a/libs/wire-api/wire-api.cabal +++ b/libs/wire-api/wire-api.cabal @@ -310,6 +310,7 @@ library , saml2-web-sso , schema-profunctor , scientific + , semigroupoids , servant , servant-client , servant-client-core diff --git a/libs/wire-subsystems/src/Wire/DeleteQueue/InMemory.hs b/libs/wire-subsystems/src/Wire/DeleteQueue/InMemory.hs index cd9400c7f54..9818ea7228a 100644 --- a/libs/wire-subsystems/src/Wire/DeleteQueue/InMemory.hs +++ b/libs/wire-subsystems/src/Wire/DeleteQueue/InMemory.hs @@ -6,7 +6,7 @@ import Polysemy.State import Wire.DeleteQueue import Wire.InternalEvent -inMemoryDeleteQueueInterpreter :: Member (State [InternalNotification]) r => InterpreterFor DeleteQueue r +inMemoryDeleteQueueInterpreter :: (Member (State [InternalNotification]) r) => InterpreterFor DeleteQueue r inMemoryDeleteQueueInterpreter = interpret $ \case EnqueueUserDeletion uid -> modify (\l -> DeleteUser uid : l) EnqueueClientDeletion cid uid mConnId -> modify (\l -> DeleteClient cid uid mConnId : l) diff --git a/libs/wire-subsystems/src/Wire/FederationAPIAccess.hs b/libs/wire-subsystems/src/Wire/FederationAPIAccess.hs index 9065f9f8c3b..e251043c8ae 100644 --- a/libs/wire-subsystems/src/Wire/FederationAPIAccess.hs +++ b/libs/wire-subsystems/src/Wire/FederationAPIAccess.hs @@ -12,7 +12,7 @@ import Wire.API.Federation.Error data FederationAPIAccess (fedM :: Component -> Type -> Type) m a where RunFederatedEither :: - KnownComponent c => + (KnownComponent c) => Remote x -> fedM c a -> FederationAPIAccess fedM m (Either FederationError a) diff --git a/libs/wire-subsystems/src/Wire/MiniBackend.hs b/libs/wire-subsystems/src/Wire/MiniBackend.hs index 4a915049448..f4508362b7f 100644 --- a/libs/wire-subsystems/src/Wire/MiniBackend.hs +++ b/libs/wire-subsystems/src/Wire/MiniBackend.hs @@ -137,12 +137,12 @@ instance RunClient (MiniFederationMonad comp) where data SubsystemOperationList where TNil :: SubsystemOperationList - (:::) :: Typeable a => (Component, Text, a) -> SubsystemOperationList -> SubsystemOperationList + (:::) :: (Typeable a) => (Component, Text, a) -> SubsystemOperationList -> SubsystemOperationList infixr 5 ::: lookupSubsystemOperation :: - Typeable a => + (Typeable a) => -- | The type to compare to (Component, Text, Proxy a) -> -- | what to return when none of the types match @@ -305,7 +305,7 @@ interpretNoFederationStack localBackend teamMember galleyConfigs cfg = . miniGalleyAPIAccess teamMember galleyConfigs . runUserSubsystem cfg -runErrorUnsafe :: Exception e => InterpreterFor (Error e) r +runErrorUnsafe :: (Exception e) => InterpreterFor (Error e) r runErrorUnsafe action = do res <- runError action case res of @@ -336,11 +336,11 @@ miniFederationAPIAccess online = do RunFederatedBucketed _domain _rpc -> error "unimplemented: RunFederatedBucketed" IsFederationConfigured -> pure True -getLocalUsers :: Member (State MiniBackend) r => Sem r [StoredUser] +getLocalUsers :: (Member (State MiniBackend) r) => Sem r [StoredUser] getLocalUsers = gets (.users) modifyLocalUsers :: - Member (State MiniBackend) r => + (Member (State MiniBackend) r) => ([StoredUser] -> Sem r [StoredUser]) -> Sem r () modifyLocalUsers f = do @@ -350,7 +350,7 @@ modifyLocalUsers f = do staticUserStoreInterpreter :: forall r. - Member (State MiniBackend) r => + (Member (State MiniBackend) r) => InterpreterFor UserStore r staticUserStoreInterpreter = interpret $ \case GetUser uid -> find (\user -> user.id == uid) <$> getLocalUsers @@ -387,7 +387,7 @@ staticUserStoreInterpreter = interpret $ \case GlimpseHandle h -> miniBackendLookupHandle h miniBackendLookupHandle :: - Member (State MiniBackend) r => + (Member (State MiniBackend) r) => Handle -> Sem r (Maybe UserId) miniBackendLookupHandle h = do @@ -407,7 +407,7 @@ miniGalleyAPIAccess member configs = interpret $ \case _ -> error "uninterpreted effect: GalleyAPIAccess" miniEventInterpreter :: - Member (State [MiniEvent]) r => + (Member (State [MiniEvent]) r) => InterpreterFor UserEvents r miniEventInterpreter = interpret \case GenerateUserEvent uid _mconn e -> modify (MkMiniEvent uid e :) diff --git a/libs/wire-subsystems/src/Wire/Rpc.hs b/libs/wire-subsystems/src/Wire/Rpc.hs index b7589d6128f..99f52727867 100644 --- a/libs/wire-subsystems/src/Wire/Rpc.hs +++ b/libs/wire-subsystems/src/Wire/Rpc.hs @@ -35,7 +35,7 @@ data Rpc m a where makeSem ''Rpc -runRpcWithHttp :: Member (Embed IO) r => Manager -> RequestId -> Sem (Rpc : r) a -> Sem r a +runRpcWithHttp :: (Member (Embed IO) r) => Manager -> RequestId -> Sem (Rpc : r) a -> Sem r a runRpcWithHttp mgr reqId = interpret $ \case Rpc serviceName ep req -> embed $ runHttpRpc mgr reqId $ rpcImpl serviceName ep req diff --git a/libs/wire-subsystems/src/Wire/UserStore/Cassandra.hs b/libs/wire-subsystems/src/Wire/UserStore/Cassandra.hs index 4f3be239832..f530c90b197 100644 --- a/libs/wire-subsystems/src/Wire/UserStore/Cassandra.hs +++ b/libs/wire-subsystems/src/Wire/UserStore/Cassandra.hs @@ -13,7 +13,7 @@ import Wire.StoredUser import Wire.UserStore import Wire.UserStore.Unique -interpretUserStoreCassandra :: Member (Embed IO) r => ClientState -> InterpreterFor UserStore r +interpretUserStoreCassandra :: (Member (Embed IO) r) => ClientState -> InterpreterFor UserStore r interpretUserStoreCassandra casClient = interpret $ runEmbedded (runClient casClient) . \case @@ -24,7 +24,7 @@ interpretUserStoreCassandra casClient = LookupHandle hdl -> embed $ lookupHandleImpl LocalQuorum hdl GlimpseHandle hdl -> embed $ lookupHandleImpl One hdl -getUserImpl :: Member (Embed Client) r => UserId -> Sem r (Maybe StoredUser) +getUserImpl :: (Member (Embed Client) r) => UserId -> Sem r (Maybe StoredUser) getUserImpl uid = embed $ do mUserTuple <- retry x1 $ query1 selectUser (params LocalQuorum (Identity uid)) pure $ asRecord <$> mUserTuple diff --git a/libs/wire-subsystems/src/Wire/UserStore/Unique.hs b/libs/wire-subsystems/src/Wire/UserStore/Unique.hs index f85b26fd4a0..f6abeddd433 100644 --- a/libs/wire-subsystems/src/Wire/UserStore/Unique.hs +++ b/libs/wire-subsystems/src/Wire/UserStore/Unique.hs @@ -93,7 +93,7 @@ deleteClaim u v t = do cql = "UPDATE unique_claims USING TTL ? SET claims = claims - ? WHERE value = ?" -- | Lookup the current claims on a value. -lookupClaims :: MonadClient m => Text -> m [Id a] +lookupClaims :: (MonadClient m) => Text -> m [Id a] lookupClaims v = fmap (maybe [] (fromSet . runIdentity)) $ retry x1 $ diff --git a/libs/wire-subsystems/src/Wire/UserSubsystem.hs b/libs/wire-subsystems/src/Wire/UserSubsystem.hs index 7c7df86d92b..c7bc75edc7d 100644 --- a/libs/wire-subsystems/src/Wire/UserSubsystem.hs +++ b/libs/wire-subsystems/src/Wire/UserSubsystem.hs @@ -106,13 +106,13 @@ data CheckHandleResp makeSem ''UserSubsystem -getUserProfile :: Member UserSubsystem r => Local UserId -> Qualified UserId -> Sem r (Maybe UserProfile) +getUserProfile :: (Member UserSubsystem r) => Local UserId -> Qualified UserId -> Sem r (Maybe UserProfile) getUserProfile luid targetUser = listToMaybe <$> getUserProfiles luid [targetUser] -getLocalUserProfile :: Member UserSubsystem r => Local UserId -> Sem r (Maybe UserProfile) +getLocalUserProfile :: (Member UserSubsystem r) => Local UserId -> Sem r (Maybe UserProfile) getLocalUserProfile targetUser = listToMaybe <$> getLocalUserProfiles ((: []) <$> targetUser) -updateSupportedProtocols :: Member UserSubsystem r => Local UserId -> UpdateOriginType -> Set BaseProtocolTag -> Sem r () +updateSupportedProtocols :: (Member UserSubsystem r) => Local UserId -> UpdateOriginType -> Set BaseProtocolTag -> Sem r () updateSupportedProtocols uid mb prots = updateUserProfile uid Nothing mb (def {supportedProtocols = Just prots}) diff --git a/libs/wire-subsystems/src/Wire/UserSubsystem/Interpreter.hs b/libs/wire-subsystems/src/Wire/UserSubsystem/Interpreter.hs index 688818f6a99..27255fcc1ae 100644 --- a/libs/wire-subsystems/src/Wire/UserSubsystem/Interpreter.hs +++ b/libs/wire-subsystems/src/Wire/UserSubsystem/Interpreter.hs @@ -251,7 +251,7 @@ getSelfProfileImpl self = do -- - comments in `testUpdateHandle` in `/integration`. -- -- FUTUREWORK: figure out a better way for clients to detect E2EId (V6?) - hackForBlockingHandleChangeForE2EIdTeams :: Member GalleyAPIAccess r => StoredUser -> Sem r StoredUser + hackForBlockingHandleChangeForE2EIdTeams :: (Member GalleyAPIAccess r) => StoredUser -> Sem r StoredUser hackForBlockingHandleChangeForE2EIdTeams user = do e2eid <- hasE2EId user pure $ @@ -427,18 +427,19 @@ checkHandleImpl uhandle = do else -- Handle is free and can be taken pure CheckHandleNotFound -hasE2EId :: Member GalleyAPIAccess r => StoredUser -> Sem r Bool +hasE2EId :: (Member GalleyAPIAccess r) => StoredUser -> Sem r Bool hasE2EId user = - wsStatus . afcMlsE2EId <$> getAllFeatureConfigsForUser (Just user.id) <&> \case - FeatureStatusEnabled -> True - FeatureStatusDisabled -> False + wsStatus . afcMlsE2EId + <$> getAllFeatureConfigsForUser (Just user.id) <&> \case + FeatureStatusEnabled -> True + FeatureStatusDisabled -> False -------------------------------------------------------------------------------- -- Check Handles -- | checks for handles @check@ to be available and returns -- at maximum @num@ of them -checkHandlesImpl :: _ => [Handle] -> Word -> Sem r [Handle] +checkHandlesImpl :: (_) => [Handle] -> Word -> Sem r [Handle] checkHandlesImpl check num = reverse <$> collectFree [] check num where collectFree free _ 0 = pure free diff --git a/libs/wire-subsystems/test/unit/Wire/NotificationSubsystem/InterpreterSpec.hs b/libs/wire-subsystems/test/unit/Wire/NotificationSubsystem/InterpreterSpec.hs index 38bebcabb28..1c633c201ab 100644 --- a/libs/wire-subsystems/test/unit/Wire/NotificationSubsystem/InterpreterSpec.hs +++ b/libs/wire-subsystems/test/unit/Wire/NotificationSubsystem/InterpreterSpec.hs @@ -308,7 +308,7 @@ runMiniStackWithControlledDelay mockConfig delayControl actualPushesRef = do . runControlledDelay delayControl . runInputConst mockConfig -runGundeckAPIAccessFailure :: Member (Embed IO) r => IORef [[V2.Push]] -> Sem (GundeckAPIAccess : r) a -> Sem r a +runGundeckAPIAccessFailure :: (Member (Embed IO) r) => IORef [[V2.Push]] -> Sem (GundeckAPIAccess : r) a -> Sem r a runGundeckAPIAccessFailure pushesRef = interpret $ \action -> do case action of @@ -328,7 +328,7 @@ data TestException = TestException instance Exception TestException -runGundeckAPIAccessIORef :: Member (Embed IO) r => IORef [[V2.Push]] -> Sem (GundeckAPIAccess : r) a -> Sem r a +runGundeckAPIAccessIORef :: (Member (Embed IO) r) => IORef [[V2.Push]] -> Sem (GundeckAPIAccess : r) a -> Sem r a runGundeckAPIAccessIORef pushesRef = interpret \case PushV2 pushes -> modifyIORef pushesRef (<> [pushes]) diff --git a/libs/wire-subsystems/test/unit/Wire/UserSubsystem/InterpreterSpec.hs b/libs/wire-subsystems/test/unit/Wire/UserSubsystem/InterpreterSpec.hs index b43c9173a3d..c5dd5bd58ef 100644 --- a/libs/wire-subsystems/test/unit/Wire/UserSubsystem/InterpreterSpec.hs +++ b/libs/wire-subsystems/test/unit/Wire/UserSubsystem/InterpreterSpec.hs @@ -433,7 +433,7 @@ spec = describe "UserSubsystem.Interpreter" do where dom = Domain "localdomain" - operation :: Monad m => Sem (GetUserProfileEffects `Append` AllErrors) a -> m a + operation :: (Monad m) => Sem (GetUserProfileEffects `Append` AllErrors) a -> m a operation op = result `seq` pure result where result = runNoFederationStack localBackend Nothing config op diff --git a/libs/zauth/main/Main.hs b/libs/zauth/main/Main.hs index 16aacc4b56f..90ddb9a0a0d 100644 --- a/libs/zauth/main/Main.hs +++ b/libs/zauth/main/Main.hs @@ -123,7 +123,7 @@ tkn xs f = fromMaybe (error "Failed to read token") . f $ headDef "missing token uuid :: ByteString -> UUID uuid s = fromMaybe (error $ "Invalid UUID: " ++ show s) $ fromASCIIBytes s -check' :: ToByteString a => ByteString -> Token a -> IO () +check' :: (ToByteString a) => ByteString -> Token a -> IO () check' k t = exceptT (\e -> putStrLn e >> exitFailure) (const $ pure ()) $ do p <- hoistEither $ PublicKey <$> decode k e <- liftIO $ runValidate (V.mkEnv p (replicate (t ^. header . key) p)) (check t) diff --git a/libs/zauth/src/Data/ZAuth/Creation.hs b/libs/zauth/src/Data/ZAuth/Creation.hs index 7a63a68e4a7..f7dfda93d17 100644 --- a/libs/zauth/src/Data/ZAuth/Creation.hs +++ b/libs/zauth/src/Data/ZAuth/Creation.hs @@ -155,12 +155,12 @@ providerToken dur pid = do d <- expiry dur newToken d P Nothing (mkProvider pid) -renewToken :: ToByteString a => Integer -> Header -> a -> Create (Token a) +renewToken :: (ToByteString a) => Integer -> Header -> a -> Create (Token a) renewToken dur hdr bdy = do d <- expiry dur newToken d (hdr ^. typ) (hdr ^. tag) bdy -newToken :: ToByteString a => POSIXTime -> Type -> Maybe Tag -> a -> Create (Token a) +newToken :: (ToByteString a) => POSIXTime -> Type -> Maybe Tag -> a -> Create (Token a) newToken ti ty ta a = do k <- Create $ asks keyIdx let h = mkHeader tokenVersion k (floor ti) ty ta @@ -170,10 +170,10 @@ newToken ti ty ta a = do ----------------------------------------------------------------------------- -- Internal -signToken :: ToByteString a => Header -> a -> Create Signature +signToken :: (ToByteString a) => Header -> a -> Create Signature signToken h a = Create $ do f <- (! (h ^. key - 1)) <$> asks zSign liftIO . f . toStrict . toLazyByteString $ writeData h a -expiry :: MonadIO m => Integer -> m POSIXTime +expiry :: (MonadIO m) => Integer -> m POSIXTime expiry d = (fromInteger d +) <$> liftIO getPOSIXTime diff --git a/libs/zauth/src/Data/ZAuth/Token.hs b/libs/zauth/src/Data/ZAuth/Token.hs index 561878ce0bb..f87a314a6d0 100644 --- a/libs/zauth/src/Data/ZAuth/Token.hs +++ b/libs/zauth/src/Data/ZAuth/Token.hs @@ -233,7 +233,7 @@ instance FromByteString (Token LegalHoldUser) where Nothing -> fail "Invalid user token" Just t -> pure t -instance ToByteString a => ToByteString (Token a) where +instance (ToByteString a) => ToByteString (Token a) where builder = writeToken ----------------------------------------------------------------------------- @@ -331,13 +331,13 @@ readLegalHoldUserBody t = LegalHoldUser <$> readUserBody t ----------------------------------------------------------------------------- -- Writing -writeToken :: ToByteString a => Token a -> Builder +writeToken :: (ToByteString a) => Token a -> Builder writeToken t = byteString (encode (sigBytes (t ^. signature))) <> dot <> writeData (t ^. header) (t ^. body) -writeData :: ToByteString a => Header -> a -> Builder +writeData :: (ToByteString a) => Header -> a -> Builder writeData h a = writeHeader h <> dot <> builder a writeHeader :: Header -> Builder @@ -402,7 +402,7 @@ instance ToByteString Type where instance ToByteString Tag where builder S = char8 's' -field :: ToByteString a => LByteString -> a -> Builder +field :: (ToByteString a) => LByteString -> a -> Builder field k v = builder k <> eq <> builder v dot, eq :: Builder diff --git a/libs/zauth/src/Data/ZAuth/Validation.hs b/libs/zauth/src/Data/ZAuth/Validation.hs index f6289c4b67d..ca0283e642e 100644 --- a/libs/zauth/src/Data/ZAuth/Validation.hs +++ b/libs/zauth/src/Data/ZAuth/Validation.hs @@ -73,7 +73,7 @@ newtype Validate a = Validate mkEnv :: PublicKey -> [PublicKey] -> Env mkEnv k kk = Env $ Vec.fromList (map verifyWith (k : kk)) -runValidate :: MonadIO m => Env -> Validate a -> m (Either Failure a) +runValidate :: (MonadIO m) => Env -> Validate a -> m (Either Failure a) runValidate v m = liftIO $ runReaderT (runExceptT (valid m)) v validateUser :: ByteString -> Validate (Token User) @@ -112,7 +112,7 @@ validate (Just c) (Just t) = do throwError Invalid pure a -check :: ToByteString a => Token a -> Validate (Token a) +check :: (ToByteString a) => Token a -> Validate (Token a) check t = do ff <- Validate $ lift $ asks verifyFns let dat = toByteString' $ writeData (t ^. header) (t ^. body) @@ -130,5 +130,5 @@ check t = do throwError Expired pure t -now :: MonadIO m => m Integer +now :: (MonadIO m) => m Integer now = floor <$> liftIO getPOSIXTime diff --git a/nix/haskell-pins.nix b/nix/haskell-pins.nix index 5b5aa560ac3..9b6b99d8195 100644 --- a/nix/haskell-pins.nix +++ b/nix/haskell-pins.nix @@ -36,7 +36,7 @@ # and update the 'rev' field of the pin under 'gitPins'. # # 2. Update 'sha256' field under `fetchgit` to be an empty string. (This step is optional: -# since the hash has changed, the error will be the same if you remove it or if you leave the +# since the sha256 has changed, the error will be the same if you remove it or if you leave the # old value in place.) # # 3. Run step 3. from how to add a git pin. @@ -66,8 +66,8 @@ let transitive-anns = { src = fetchgit { url = "https://github.com/wireapp/transitive-anns"; - rev = "95ee8b5f9c47fe04f8f0d1321f0ade261ab9af54"; - sha256 = "sha256-8NEAHkCBlGO6xnG2K3Lllb2xiCHSYf/dSV1YrmBkOW8="; + rev = "5e0cad1f411a0c92e6445404c205ddd4a0229c4d"; + hash = "sha256-/P4KJ4yZgqhZhzmg1GcE+Ti4kdsWUQX8q++RhgCUDKI="; }; }; @@ -75,15 +75,16 @@ let src = fetchgit { url = "https://github.com/wireapp/cryptobox-haskell"; rev = "7546a1a25635ef65183e3d44c1052285e8401608"; - sha256 = "0dgizj1kc135yzzqdf5l7f5ax0qpvrr8mxvg7s1dbm01cf11aqzn"; + hash = "sha256-9mMVgmMB1NWCPm/3inLeF4Ouiju0uIb/92UENoP88TU="; }; }; + # FIXME(mangoiv): should be merged https://github.com/wireapp/saml2-web-sso/pull/86 saml2-web-sso = { src = fetchgit { url = "https://github.com/wireapp/saml2-web-sso"; - rev = "0cf23a87b140ba5b960a848ecad3976e6fdaac88"; - sha256 = "sha256-Gm58Yjt5ZGh74cfEjcZSx6jvwkpFC324xTPLhLS29r0="; + rev = "9474485e6ed45930b75524f97633f7e036fc0273"; + hash = "sha256-TkULURVk7lDHXpbXREwowxFoiUp2VSVZWjr9KF48170="; }; }; @@ -95,7 +96,7 @@ let src = fetchgit { url = "https://github.com/wireapp/bloodhound"; rev = "abf819a4a6ec7601f1e58cb8da13b2fdad377d9e"; - sha256 = "sha256-m1O+F/mOJN5z5WNChmeyHP4dtmLRkl2YnLlTuwzRelk="; + hash = "sha256-m1O+F/mOJN5z5WNChmeyHP4dtmLRkl2YnLlTuwzRelk="; }; }; @@ -104,7 +105,7 @@ let src = fetchgit { url = "https://github.com/akshaymankar/hs-certificate"; rev = "9e293695d8ca5efc513ee0082ae955ff9b32eb6b"; - sha256 = "sha256-mD5Dvuzol3K9CNNSfa2L9ir9AbrQ8HJc0QNmkK3qBWk="; + hash = "sha256-mD5Dvuzol3K9CNNSfa2L9ir9AbrQ8HJc0QNmkK3qBWk="; }; packages = { "crypton-x509-validation" = "x509-validation"; @@ -116,15 +117,16 @@ let src = fetchgit { url = "https://github.com/wireapp/HaskellNet-SSL"; rev = "c2844b63a39f458ffbfe62f2ac824017f1f84453"; - sha256 = "sha256-1mu/yEAWr3POY4MHRomum0DDvs5Qty1JvP3v5GS2u64="; + hash = "sha256-1mu/yEAWr3POY4MHRomum0DDvs5Qty1JvP3v5GS2u64="; }; }; + # PR https://github.com/dylex/hsaml2/pull/20 hsaml2 = { src = fetchgit { - url = "https://github.com/dylex/hsaml2"; - rev = "95d9dc7502c2533f7927de00cbc2bd20ad989ace"; - sha256 = "sha256-z3s/ZkkCd2ThVBsu72pS/+XygHImuffz/HVy3hkQ6eo="; + url = "https://github.com/mangoiv/hsaml2"; + rev = "d35f92a3253d146c92caf371b90eb4889841918a"; + hash = "sha256-gufEAC7fFqafG8dXkGIOSfAcVv+ZWkawmBgUV+Ics2s="; }; }; @@ -144,7 +146,7 @@ let src = fetchgit { url = "https://github.com/wireapp/http-client"; rev = "37494bb9a89dd52f97a8dc582746c6ff52943934"; - sha256 = "sha256-z47GlT+tHsSlRX4ApSGQIpOpaZiBeqr72/tWuvzw8tc="; + hash = "sha256-z47GlT+tHsSlRX4ApSGQIpOpaZiBeqr72/tWuvzw8tc="; }; packages = { "http-client" = "http-client"; @@ -159,7 +161,7 @@ let src = fetchgit { url = "https://github.com/wireapp/hspec-wai"; rev = "08176f07fa893922e2e78dcaf996c33d79d23ce2"; - sha256 = "sha256-Nc5POjA+mJt7Vi3drczEivGsv9PXeVOCSwp21lLmz58="; + hash = "sha256-Nc5POjA+mJt7Vi3drczEivGsv9PXeVOCSwp21lLmz58="; }; }; @@ -168,7 +170,7 @@ let src = fetchgit { url = "https://github.com/wireapp/cql"; rev = "abbd2739969d17a909800f282d10d42a254c4e3b"; - sha256 = "sha256-2MYwZKiTdwgjJdLNvECi7gtcIo+3H4z1nYzen5x0lgU="; + hash = "sha256-2MYwZKiTdwgjJdLNvECi7gtcIo+3H4z1nYzen5x0lgU="; }; }; @@ -177,7 +179,7 @@ let src = fetchgit { url = "https://github.com/wireapp/cql-io"; rev = "c2b6aa995b5817ed7c78c53f72d5aa586ef87c36"; - sha256 = "sha256-DMRWUq4yorG5QFw2ZyF/DWnRjfnzGupx0njTiOyLzPI="; + hash = "sha256-DMRWUq4yorG5QFw2ZyF/DWnRjfnzGupx0njTiOyLzPI="; }; }; @@ -187,7 +189,7 @@ let src = fetchgit { url = "https://github.com/wireapp/wai-predicates"; rev = "ff95282a982ab45cced70656475eaf2cefaa26ea"; - sha256 = "sha256-x2XSv2+/+DG9FXN8hfUWGNIO7V4iBhlzYz19WWKaLKQ="; + hash = "sha256-x2XSv2+/+DG9FXN8hfUWGNIO7V4iBhlzYz19WWKaLKQ="; }; }; @@ -196,7 +198,7 @@ let src = fetchgit { url = "https://github.com/wireapp/wai-routing"; rev = "7e996a93fec5901767f845a50316b3c18e51a61d"; - sha256 = "18icwks9jc6sy42vcvj2ysaip2s0dsrpvm9sy608b6nq6kk1ahlk"; + hash = "sha256-k0IV5jTYmoWA8TrVfbNuQIsblfZCbrYF8dowmfTkLKI="; }; }; @@ -205,7 +207,7 @@ let src = fetchgit { url = "https://github.com/wireapp/tasty"; rev = "97df5c1db305b626ffa0b80055361b7b28e69cec"; - sha256 = "sha256-oACehxazeKgRr993gASRbQMf74heh5g0B+70ceAg17I="; + hash = "sha256-oACehxazeKgRr993gASRbQMf74heh5g0B+70ceAg17I="; }; packages = { tasty-hunit = "hunit"; @@ -217,16 +219,17 @@ let servant-openapi3 = { src = fetchgit { url = "https://github.com/wireapp/servant-openapi3"; - rev = "5cdb2783f15058f753c41b800415d4ba1149a78b"; - sha256 = "sha256-8FM3IAA3ewCuv9Mar8aWmzbyfKK9eLXIJPMHzmYb1zE="; + rev = "0db0095040df2c469a48f5b8724595f82afbad0c"; + hash = "sha256-iKMWd+qm8hHhKepa13VWXDPCpTMXxoOwWyoCk4lLlIY="; }; }; + # we need HEAD, the latest release is too old postie = { src = fetchgit { url = "https://github.com/alexbiehl/postie"; rev = "7321b977a2b427e0be782b7239901e4edfbb027f"; - sha256 = "sha256-DKugy4EpRsSgaGvybdh2tLa7HCtoxId+7RAAAw43llA="; + hash = "sha256-DKugy4EpRsSgaGvybdh2tLa7HCtoxId+7RAAAw43llA="; }; }; @@ -234,7 +237,7 @@ let src = fetchgit { url = "https://github.com/wireapp/tinylog.git"; rev = "9609104263e8cd2a631417c1c3ef23e090de0d09"; - sha256 = "sha256-htEIJY+LmIMACVZrflU60+X42/g14NxUyFM7VJs4E6w="; + hash = "sha256-htEIJY+LmIMACVZrflU60+X42/g14NxUyFM7VJs4E6w="; }; }; @@ -243,7 +246,7 @@ let src = fetchgit { url = "https://github.com/wireapp/tasty-ant-xml"; rev = "34ff294d805e62e73678dccc0be9d3da13540fbe"; - sha256 = "sha256-+rHcS+BwEFsXqPAHX/KZDIgv9zfk1dZl0LlZJ57Com4="; + hash = "sha256-+rHcS+BwEFsXqPAHX/KZDIgv9zfk1dZl0LlZJ57Com4="; }; }; @@ -255,18 +258,6 @@ let hash = "sha256-E35PVxi/4iJFfWts3td52KKZKQt4dj9KFP3SvWG77Cc="; }; }; - # PR: https://github.com/yesodweb/wai/pull/958 - warp = { - src = fetchgit { - url = "https://github.com/wireapp/wai"; - rev = "bedd6a835f6d98128880465c30e8115fa986e3f6"; - sha256 = "sha256-0r/d9YwcKZIZd10EhL2TP+W14Wjk0/S8Q4pVvZuZLaY="; - }; - packages = { - "warp" = "warp"; - }; - }; - }; hackagePins = { # Major re-write upstream, we should get rid of this dependency rather than @@ -276,19 +267,15 @@ let sha256 = "sha256-DSMckKIeVE/buSMg8Mq+mUm1bYPYB7veA11Ns7vTBbc="; }; - # these are not yet in nixpkgs - ghc-source-gen = { - version = "0.4.4.0"; - sha256 = "sha256-ZSJGF4sdr7tOCv6IUCjIiTrFYL+5gF4W3U6adjBODrE="; - }; - hoogle = { - version = "5.0.18.4"; - sha256 = "sha256-gIc4hpdUfTS33rZPfzwLfVcXkQaglmsljqViyYdihdk="; + http2 = { + version = "4.1.4"; + sha256 = "sha256-r4Bu0vourKMkBO1cPeJVszSbAqHopmkv9EeTHcaTfuo="; }; - # dependency of hoogle - safe = { - version = "0.3.20"; - sha256 = "sha256-PGwjhrRnkH8cLhd7fHTZFd6ts9abp0w5sLlV8ke1yXU="; + + # warp is not compatible with + warp = { + version = "3.3.30"; + sha256 = "sha256-VrK27a2wFtezh9qabcXGe2tw9EwBmI8mKwmpCtXq9rc="; }; # PR: https://github.com/wireapp/wire-server/pull/4027 HsOpenSSL = { @@ -306,7 +293,7 @@ let else "--subpath='${subpath}'"; in hself.callCabal2nixWithOptions name src "${subpathArg}" { }; - # [[AtrrSet]] + # [[AttrSet]] gitPackages = lib.attrsets.mapAttrsToList (name: pin: let diff --git a/nix/manual-overrides.nix b/nix/manual-overrides.nix index a3b16e6fee4..86a55d8754f 100644 --- a/nix/manual-overrides.nix +++ b/nix/manual-overrides.nix @@ -1,4 +1,4 @@ -{ libsodium, protobuf, hlib, mls-test-cli, ... }: +{ libsodium, protobuf, hlib, mls-test-cli, fetchurl, curl, fetchpatch, ... }: # 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: { @@ -7,7 +7,10 @@ hself: hsuper: { # (these are in general not fine they need to be investigated) # FUTUREWORK: investigate whether all of these tests need to fail # ---------------- - amqp = hlib.dontCheck hsuper.amqp_0_22_2; + + # tests don't compile because `replicateM` isn't in scope. this dependency should be dropped asap + wai-route = hlib.dontCheck hsuper.wai-route; + # test suite doesn't compile and needs network access bloodhound = hlib.dontCheck hsuper.bloodhound; # tests need network access, cabal2nix disables haddocks @@ -15,13 +18,13 @@ hself: hsuper: { # PR with fix: https://github.com/freckle/hspec-junit-formatter/pull/23 # the PR has been merged, but has not arrived in nixpkgs hspec-junit-formatter = hlib.markUnbroken (hlib.dontCheck hsuper.hspec-junit-formatter); - markov-chain-usage-model = hlib.markUnbroken (hlib.dontCheck hsuper.markov-chain-usage-model); - openapi3 = hlib.markUnbroken (hlib.dontCheck hsuper.openapi3); - quickcheck-state-machine = hlib.dontCheck hsuper.quickcheck-state-machine; + quickcheck-state-machine = hlib.markUnbroken (hlib.dontCheck hsuper.quickcheck-state-machine); saml2-web-sso = hlib.dontCheck hsuper.saml2-web-sso; + # these are okay, the only issue is that the compiler underlines + # errors differently than before + singletons-base = hlib.markUnbroken (hlib.dontCheck hsuper.singletons-base); # one of the tests is flaky transitive-anns = hlib.dontCheck hsuper.transitive-anns; - warp = hlib.dontCheck hsuper.warp; # Tests require a running redis hedis = hlib.dontCheck hsuper.hedis; @@ -34,30 +37,53 @@ hself: hsuper: { binary-parsers = hlib.markUnbroken (hlib.doJailbreak hsuper.binary-parsers); bytestring-arbitrary = hlib.markUnbroken (hlib.doJailbreak hsuper.bytestring-arbitrary); lens-datetime = hlib.markUnbroken (hlib.doJailbreak hsuper.lens-datetime); - network-arbitrary = hlib.markUnbroken (hlib.doJailbreak hsuper.network-arbitrary); - proto-lens-protoc = hlib.doJailbreak hsuper.proto-lens-protoc; - proto-lens-setup = hlib.doJailbreak hsuper.proto-lens-setup; - th-desugar = hlib.doJailbreak hsuper.th-desugar; + + # the libsodium haskell library is incompatible with the new version of the libsodium c library + # that nixpkgs has - this downgrades libsodium from 1.0.19 to 1.0.18 + libsodium = hlib.markUnbroken (hlib.addPkgconfigDepend hsuper.libsodium ( + libsodium.overrideAttrs (old: + rec { + # we don't care for the patches for mingw and for 1.0.19 + patches = [ ]; + version = "1.0.18"; + src = fetchurl { + url = "https://download.libsodium.org/libsodium/releases/${old.pname}-${version}.tar.gz"; + hash = "sha256-b1BEkLNCpPikxKAvybhmy++GItXfTlRStGvhIeRmNsE="; + }; + } + ))); + + # depend on an old version of hedgehog + polysemy-test = hlib.markUnbroken (hlib.doJailbreak hsuper.polysemy-test); + polysemy-conc = hlib.markUnbroken (hlib.doJailbreak hsuper.polysemy-conc); # ------------------------------------ # okay but marked broken (nixpkgs bug) # (we can unfortunately not do anything here but update nixpkgs) # ------------------------------------ - bytestring-conversion = hlib.markUnbroken hsuper.bytestring-conversion; template = hlib.markUnbroken hsuper.template; - polysemy-test = hlib.markUnbroken hsuper.polysemy-test; # ----------------- # version overrides # (these are fine but will probably need to be adjusted in a future nixpkgs update) # ----------------- - hpack = hsuper.hpack_0_36_0; - linear-generics = hsuper.linear-generics_0_2_2; - network-conduit-tls = hsuper.network-conduit-tls_1_4_0; - optparse-generic = hsuper.optparse-generic_1_5_2; - th-abstraction = hsuper.th-abstraction_0_5_0_0; - tls = hsuper.tls_1_9_0; - warp-tls = hsuper.warp-tls_3_4_3; + tls = hsuper.tls_2_0_5; + tls-session-manager = hsuper.tls-session-manager_0_0_5; + + # for warp (and its transitive deps) + # we have a PR open https://github.com/yesodweb/wai/pull/958 + # unfortunately, because of breakage in http2, our fork has moved beyond what + # we can use in wire itself, hence the patch + # the version of warp is pinned in ./haskell-pins.nix + warp = hlib.addTestToolDepends + (hlib.appendPatches hsuper.warp [ + (fetchpatch { + url = "https://github.com/yesodweb/wai/commit/ef993a357822d9bc2a2040afcb656b31c378491c.patch"; + stripLen = 1; + sha256 = "sha256-rv/ujqyBmpsChQg2uS3/HUgQZCA3SzBiF8kUnZJN0xs="; + }) + ]) [ curl ]; + # end for warp # ----------------- # flags and patches diff --git a/nix/overlay-docs.nix b/nix/overlay-docs.nix index 5c1a233bb5f..c97cbe66e6a 100644 --- a/nix/overlay-docs.nix +++ b/nix/overlay-docs.nix @@ -9,7 +9,5 @@ self: super: rec { }; }; - mls-test-cli = self.callPackage ./pkgs/mls-test-cli { }; - python3Packages = python3.pkgs; } diff --git a/nix/overlay.nix b/nix/overlay.nix index 81d7f887649..fe5263e55b9 100644 --- a/nix/overlay.nix +++ b/nix/overlay.nix @@ -50,7 +50,6 @@ let }; sources = import ./sources.nix; - pkgsCargo = import sources.nixpkgs-cargo { }; in self: super: { @@ -60,9 +59,7 @@ self: super: { mls-test-cli = self.callPackage ./pkgs/mls-test-cli { }; # Named like this so cabal2nix can find it - rusty_jwt_tools_ffi = self.callPackage ./pkgs/rusty_jwt_tools_ffi { - inherit (pkgsCargo) rustPlatform; - }; + rusty_jwt_tools_ffi = self.callPackage ./pkgs/rusty_jwt_tools_ffi { }; nginxModules = super.nginxModules // { zauth = { diff --git a/nix/pkgs/python-docs/sphinxcontrib-kroki.nix b/nix/pkgs/python-docs/sphinxcontrib-kroki.nix index 179c6cad862..53ef1ee3f35 100644 --- a/nix/pkgs/python-docs/sphinxcontrib-kroki.nix +++ b/nix/pkgs/python-docs/sphinxcontrib-kroki.nix @@ -2,6 +2,7 @@ , buildPythonPackage , sphinx , requests +, setuptools , pyyaml }: buildPythonPackage rec { @@ -17,6 +18,6 @@ buildPythonPackage rec { sphinx requests pyyaml + setuptools ]; - } diff --git a/nix/sources.json b/nix/sources.json index 207225e566b..0abe53ae006 100644 --- a/nix/sources.json +++ b/nix/sources.json @@ -1,38 +1,14 @@ { - "bombon": { - "branch": "main", - "description": "Nix CycloneDX Software Bills of Materials (SBOMs)", - "homepage": "", - "owner": "nikstur", - "repo": "bombon", - "rev": "09dce0377beb87c24822f79501d6c76166105788", - "sha256": "1z80waaimga03m4b0nhc3djaca4y2bh0dq8mc1r8s59hqngc22ch", - "type": "tarball", - "url": "https://github.com/nikstur/bombon/archive/09dce0377beb87c24822f79501d6c76166105788.tar.gz", - "url_template": "https://github.com///archive/.tar.gz" - }, "nixpkgs": { "branch": "nixpkgs-unstable", "description": "Nix Packages collection", "homepage": "https://github.com/NixOS/nixpkgs", "owner": "NixOS", "repo": "nixpkgs", - "rev": "e97b3e4186bcadf0ef1b6be22b8558eab1cdeb5d", - "sha256": "114ggf0xbwq16djg4qql3jljknk9xr8h7dw18ccalwqg9k1cgv0g", - "type": "tarball", - "url": "https://github.com/NixOS/nixpkgs/archive/e97b3e4186bcadf0ef1b6be22b8558eab1cdeb5d.tar.gz", - "url_template": "https://github.com///archive/.tar.gz" - }, - "nixpkgs-cargo": { - "branch": "master", - "description": "Nix Packages collection", - "homepage": "https://github.com/NixOS/nixpkgs", - "owner": "NixOS", - "repo": "nixpkgs", - "rev": "e236b838c71d2aff275356ade8104bbdef422117", - "sha256": "0zjf6b9pz3ljinwb2qxhmpix1mgiv4vakcqci7bcy5a6sv1sj1xs", + "rev": "4a3fc4cf736b7d2d288d7a8bf775ac8d4c0920b4", + "sha256": "1ibmc6iijim53bpi1wc1b295l579wzxgs8ynmsi0ldgjrxhgli1a", "type": "tarball", - "url": "https://github.com/NixOS/nixpkgs/archive/e236b838c71d2aff275356ade8104bbdef422117.tar.gz", + "url": "https://github.com/NixOS/nixpkgs/archive/4a3fc4cf736b7d2d288d7a8bf775ac8d4c0920b4.tar.gz", "url_template": "https://github.com///archive/.tar.gz" } } diff --git a/nix/sources.nix b/nix/sources.nix index 9a01c8acfc0..fe3dadf7ebb 100644 --- a/nix/sources.nix +++ b/nix/sources.nix @@ -10,33 +10,34 @@ let let name' = sanitizeName name + "-src"; in - if spec.builtin or true then - builtins_fetchurl { inherit (spec) url sha256; name = name'; } - else - pkgs.fetchurl { inherit (spec) url sha256; name = name'; }; + if spec.builtin or true then + builtins_fetchurl { inherit (spec) url sha256; name = name'; } + else + pkgs.fetchurl { inherit (spec) url sha256; name = name'; }; fetch_tarball = pkgs: name: spec: let name' = sanitizeName name + "-src"; in - if spec.builtin or true then - builtins_fetchTarball { name = name'; inherit (spec) url sha256; } - else - pkgs.fetchzip { name = name'; inherit (spec) url sha256; }; + if spec.builtin or true then + builtins_fetchTarball { name = name'; inherit (spec) url sha256; } + else + pkgs.fetchzip { name = name'; inherit (spec) url sha256; }; fetch_git = name: spec: let ref = - if spec ? ref then spec.ref else + spec.ref or ( if spec ? branch then "refs/heads/${spec.branch}" else - if spec ? tag then "refs/tags/${spec.tag}" else - abort "In git source '${name}': Please specify `ref`, `tag` or `branch`!"; - submodules = if spec ? submodules then spec.submodules else false; + if spec ? tag then "refs/tags/${spec.tag}" else + abort "In git source '${name}': Please specify `ref`, `tag` or `branch`!" + ); + submodules = spec.submodules or false; submoduleArg = let nixSupportsSubmodules = builtins.compareVersions builtins.nixVersion "2.4" >= 0; emptyArgWithWarning = - if submodules == true + if submodules then builtins.trace ( @@ -44,15 +45,15 @@ let + "but your nix's (${builtins.nixVersion}) builtins.fetchGit " + "does not support them" ) - {} - else {}; + { } + else { }; in - if nixSupportsSubmodules - then { inherit submodules; } - else emptyArgWithWarning; + if nixSupportsSubmodules + then { inherit submodules; } + else emptyArgWithWarning; in - builtins.fetchGit - ({ url = spec.repo; inherit (spec) rev; inherit ref; } // submoduleArg); + builtins.fetchGit + ({ url = spec.repo; inherit (spec) rev; inherit ref; } // submoduleArg); fetch_local = spec: spec.path; @@ -86,16 +87,16 @@ let hasNixpkgsPath = builtins.any (x: x.prefix == "nixpkgs") builtins.nixPath; hasThisAsNixpkgsPath = == ./.; in - if builtins.hasAttr "nixpkgs" sources - then sourcesNixpkgs - else if hasNixpkgsPath && ! hasThisAsNixpkgsPath then - import {} - else - abort - '' - Please specify either (through -I or NIX_PATH=nixpkgs=...) or - add a package called "nixpkgs" to your sources.json. - ''; + if builtins.hasAttr "nixpkgs" sources + then sourcesNixpkgs + else if hasNixpkgsPath && ! hasThisAsNixpkgsPath then + import { } + else + abort + '' + Please specify either (through -I or NIX_PATH=nixpkgs=...) or + add a package called "nixpkgs" to your sources.json. + ''; # The actual fetching function. fetch = pkgs: name: spec: @@ -115,13 +116,13 @@ let # the path directly as opposed to the fetched source. replace = name: drv: let - saneName = stringAsChars (c: if isNull (builtins.match "[a-zA-Z0-9]" c) then "_" else c) name; + saneName = stringAsChars (c: if (builtins.match "[a-zA-Z0-9]" c) == null then "_" else c) name; ersatz = builtins.getEnv "NIV_OVERRIDE_${saneName}"; in - if ersatz == "" then drv else - # this turns the string into an actual Nix path (for both absolute and - # relative paths) - if builtins.substring 0 1 ersatz == "/" then /. + ersatz else /. + builtins.getEnv "PWD" + "/${ersatz}"; + if ersatz == "" then drv else + # this turns the string into an actual Nix path (for both absolute and + # relative paths) + if builtins.substring 0 1 ersatz == "/" then /. + ersatz else /. + builtins.getEnv "PWD" + "/${ersatz}"; # Ports of functions for older nix versions @@ -132,7 +133,7 @@ let ); # https://github.com/NixOS/nixpkgs/blob/0258808f5744ca980b9a1f24fe0b1e6f0fecee9c/lib/lists.nix#L295 - range = first: last: if first > last then [] else builtins.genList (n: first + n) (last - first + 1); + range = first: last: if first > last then [ ] else builtins.genList (n: first + n) (last - first + 1); # https://github.com/NixOS/nixpkgs/blob/0258808f5744ca980b9a1f24fe0b1e6f0fecee9c/lib/strings.nix#L257 stringToCharacters = s: map (p: builtins.substring p 1 s) (range 0 (builtins.stringLength s - 1)); @@ -143,43 +144,46 @@ let concatStrings = builtins.concatStringsSep ""; # https://github.com/NixOS/nixpkgs/blob/8a9f58a375c401b96da862d969f66429def1d118/lib/attrsets.nix#L331 - optionalAttrs = cond: as: if cond then as else {}; + optionalAttrs = cond: as: if cond then as else { }; # fetchTarball version that is compatible between all the versions of Nix builtins_fetchTarball = { url, name ? null, sha256 }@attrs: let inherit (builtins) lessThan nixVersion fetchTarball; in - if lessThan nixVersion "1.12" then - fetchTarball ({ inherit url; } // (optionalAttrs (!isNull name) { inherit name; })) - else - fetchTarball attrs; + if lessThan nixVersion "1.12" then + fetchTarball ({ inherit url; } // (optionalAttrs (name != null) { inherit name; })) + else + fetchTarball attrs; # fetchurl version that is compatible between all the versions of Nix builtins_fetchurl = { url, name ? null, sha256 }@attrs: let inherit (builtins) lessThan nixVersion fetchurl; in - if lessThan nixVersion "1.12" then - fetchurl ({ inherit url; } // (optionalAttrs (!isNull name) { inherit name; })) - else - fetchurl attrs; + if lessThan nixVersion "1.12" then + fetchurl ({ inherit url; } // (optionalAttrs (name != null) { inherit name; })) + else + fetchurl attrs; # Create the final "sources" from the config mkSources = config: - mapAttrs ( - name: spec: - if builtins.hasAttr "outPath" spec - then abort - "The values in sources.json should not have an 'outPath' attribute" - else - spec // { outPath = replace name (fetch config.pkgs name spec); } - ) config.sources; + mapAttrs + ( + name: spec: + if builtins.hasAttr "outPath" spec + then + abort + "The values in sources.json should not have an 'outPath' attribute" + else + spec // { outPath = replace name (fetch config.pkgs name spec); } + ) + config.sources; # The "config" used by the fetchers mkConfig = { sourcesFile ? if builtins.pathExists ./sources.json then ./sources.json else null - , sources ? if isNull sourcesFile then {} else builtins.fromJSON (builtins.readFile sourcesFile) + , sources ? if sourcesFile == null then { } else builtins.fromJSON (builtins.readFile sourcesFile) , system ? builtins.currentSystem , pkgs ? mkPkgs sources system }: rec { @@ -191,4 +195,4 @@ let }; in -mkSources (mkConfig {}) // { __functor = _: settings: mkSources (mkConfig settings); } +mkSources (mkConfig { }) // { __functor = _: settings: mkSources (mkConfig settings); } diff --git a/nix/wire-server.nix b/nix/wire-server.nix index eb167f38d68..6fafadb5efa 100644 --- a/nix/wire-server.nix +++ b/nix/wire-server.nix @@ -88,7 +88,7 @@ let test-stats = [ "test-stats" ]; }; - attrsets = lib.attrsets; + inherit (lib) attrsets; pinnedPackages = import ./haskell-pins.nix { inherit pkgs; @@ -155,7 +155,8 @@ let ]; manualOverrides = import ./manual-overrides.nix (with pkgs; { - inherit hlib libsodium protobuf mls-test-cli fetchpatch pkgs; + inherit (pkgs) libsodium protobuf fetchpatch fetchurl curl; + inherit hlib mls-test-cli; }); executables = hself: hsuper: @@ -168,7 +169,7 @@ let ) executablesMap; - hPkgs = localMods@{ enableOptimization, enableDocs, enableTests }: pkgs.haskell.packages.ghc94.override { + hPkgs = localMods@{ enableOptimization, enableDocs, enableTests }: pkgs.haskellPackages.override { overrides = lib.composeManyExtensions [ pinnedPackages (localPackages localMods) @@ -396,8 +397,6 @@ let }; }; - ormolu = pkgs.haskell.packages.ghc94.ormolu_0_5_2_0; - # Tools common between CI and developers commonTools = [ pkgs.cabal2nix @@ -413,7 +412,7 @@ let pkgs.kubelogin-oidc pkgs.nixpkgs-fmt pkgs.openssl - (hlib.justStaticExecutables ormolu) + pkgs.ormolu pkgs.shellcheck pkgs.treefmt pkgs.gawk @@ -449,14 +448,6 @@ let }; ghcWithPackages = shell.nativeBuildInputs ++ shell.buildInputs; - inherit (pkgs.haskellPackages.override { - overrides = _hfinal: hprev: { - base-compat = hprev.base-compat_0_13_1; - base-compat-batteries = hprev.base-compat-batteries_0_13_1; - cabal-plan = hlib.markUnbroken (hlib.doJailbreak hprev.cabal-plan); - }; - }) cabal-plan; - profileEnv = pkgs.writeTextFile { name = "profile-env"; destination = "/.profile"; @@ -473,11 +464,6 @@ let allImages = pkgs.linkFarm "all-images" (images localModsEnableAll); - # BOM is an acronym for bill of materials - allLocalPackagesBom = lib.buildBom allLocalPackages { - includeBuildtimeDependencies = true; - }; - haskellPackages = hPkgs localModsEnableAll; haskellPackagesUnoptimizedNoDocs = hPkgs localModsOnlyTests; @@ -506,7 +492,7 @@ let pkgs.writeText "all-toplevel.jsonl" (builtins.concatStringsSep "\n" out); in { - inherit ciImage hoogleImage allImages allLocalPackages allLocalPackagesBom + inherit ciImage hoogleImage allImages allLocalPackages toplevel-derivations haskellPackages haskellPackagesUnoptimizedNoDocs imagesList; images = images localModsEnableAll; @@ -526,7 +512,7 @@ in pkgs.bash pkgs.crate2nix pkgs.dash - (pkgs.haskell-language-server.override { supportedGhcVersions = [ "94" ]; }) + (pkgs.haskell-language-server.override { supportedGhcVersions = [ "96" ]; }) pkgs.ghcid pkgs.kind pkgs.netcat @@ -554,7 +540,7 @@ in pkgs.cabal-install pkgs.nix-prefetch-git - cabal-plan + pkgs.haskellPackages.cabal-plan profileEnv ] ++ ghcWithPackages diff --git a/services/background-worker/src/Wire/BackendNotificationPusher.hs b/services/background-worker/src/Wire/BackendNotificationPusher.hs index 7dfad1390f1..913bf246f70 100644 --- a/services/background-worker/src/Wire/BackendNotificationPusher.hs +++ b/services/background-worker/src/Wire/BackendNotificationPusher.hs @@ -40,7 +40,7 @@ startPushingNotifications runningFlag chan domain = do lift $ ensureQueue chan domain._domainText QL.consumeMsgs chan (routingKey domain._domainText) Q.Ack (void . pushNotification runningFlag domain) -pushNotification :: RabbitMQEnvelope e => MVar () -> Domain -> (Q.Message, e) -> AppT IO (Async ()) +pushNotification :: (RabbitMQEnvelope e) => MVar () -> Domain -> (Q.Message, e) -> AppT IO (Async ()) pushNotification runningFlag targetDomain (msg, envelope) = do cfg <- asks (.backendNotificationsConfig) -- Jittered exponential backoff with 10ms as starting delay and 300s as max @@ -191,7 +191,7 @@ sendNotificationIgnoringVersionMismatch env comp path body = Right () -> pure () -- | Find the pair that maximises b. -pairedMaximumOn :: Ord b => (a -> b) -> [a] -> (a, b) +pairedMaximumOn :: (Ord b) => (a -> b) -> [a] -> (a, b) pairedMaximumOn f = maximumBy (compare `on` snd) . map (id &&& f) -- FUTUREWORK: Recosider using 1 channel for many consumers. It shouldn't matter diff --git a/services/background-worker/src/Wire/BackgroundWorker/Env.hs b/services/background-worker/src/Wire/BackgroundWorker/Env.hs index 9d1265fd131..db968315947 100644 --- a/services/background-worker/src/Wire/BackgroundWorker/Env.hs +++ b/services/background-worker/src/Wire/BackgroundWorker/Env.hs @@ -108,7 +108,7 @@ deriving newtype instance (MonadBase b m) => MonadBase b (AppT m) deriving newtype instance (MonadBaseControl b m) => MonadBaseControl b (AppT m) -- Coppied from Federator. -instance MonadUnliftIO m => MonadUnliftIO (AppT m) where +instance (MonadUnliftIO m) => MonadUnliftIO (AppT m) where withRunInIO inner = AppT . ReaderT $ \r -> withRunInIO $ \runner -> diff --git a/services/brig/src/Brig/API/Auth.hs b/services/brig/src/Brig/API/Auth.hs index 66e65b4354d..089d2969d04 100644 --- a/services/brig/src/Brig/API/Auth.hs +++ b/services/brig/src/Brig/API/Auth.hs @@ -124,12 +124,12 @@ logoutH uts' mat' = do partitionTokens uts mat >>= either (uncurry logout) (uncurry logout) -logout :: TokenPair u a => NonEmpty (Token u) -> Maybe (Token a) -> Handler r () +logout :: (TokenPair u a) => NonEmpty (Token u) -> Maybe (Token a) -> Handler r () logout _ Nothing = throwStd authMissingToken logout uts (Just at) = Auth.logout (List1 uts) at !>> zauthError changeSelfEmailH :: - Member BlacklistStore r => + (Member BlacklistStore r) => [Either Text SomeUserToken] -> Maybe (Either Text SomeAccessToken) -> EmailUpdate -> @@ -143,7 +143,7 @@ changeSelfEmailH uts' mat' up = do changeSelfEmail usr email UpdateOriginWireClient validateCredentials :: - TokenPair u a => + (TokenPair u a) => NonEmpty (Token u) -> Maybe (Token a) -> Handler r UserId @@ -197,7 +197,7 @@ getLoginCode phone = do code <- lift $ Auth.lookupLoginCode phone maybe (throwStd loginCodeNotFound) pure code -reauthenticate :: Member GalleyAPIAccess r => UserId -> ReAuthUser -> Handler r () +reauthenticate :: (Member GalleyAPIAccess r) => UserId -> ReAuthUser -> Handler r () reauthenticate uid body = do wrapClientE (User.reauthenticate uid (reAuthPassword body)) !>> reauthError case reAuthCodeAction body of diff --git a/services/brig/src/Brig/API/Client.hs b/services/brig/src/Brig/API/Client.hs index 3176421f984..bfc18a1121b 100644 --- a/services/brig/src/Brig/API/Client.hs +++ b/services/brig/src/Brig/API/Client.hs @@ -237,7 +237,7 @@ addClientWithReAuthPolicy policy u con new = do VerificationCodeNoPendingCode -> throwE ClientCodeAuthenticationFailed VerificationCodeNoEmail -> throwE ClientCodeAuthenticationFailed -updateClient :: MonadClient m => UserId -> ClientId -> UpdateClient -> ExceptT ClientError m () +updateClient :: (MonadClient m) => UserId -> ClientId -> UpdateClient -> ExceptT ClientError m () updateClient u c r = do client <- lift (Data.lookupClient u c) >>= maybe (throwE ClientNotFound) pure for_ (updateClientLabel r) $ lift . Data.updateClientLabel u c . Just @@ -253,7 +253,7 @@ updateClient u c r = do -- nb. We must ensure that the set of clients known to brig is always -- a superset of the clients known to galley. rmClient :: - Member DeleteQueue r => + (Member DeleteQueue r) => UserId -> ConnId -> ClientId -> @@ -273,7 +273,7 @@ rmClient u con clt pw = lift $ execDelete u (Just con) client claimPrekey :: - Member DeleteQueue r => + (Member DeleteQueue r) => LegalholdProtectee -> UserId -> Domain -> @@ -286,7 +286,7 @@ claimPrekey protectee u d c = do else wrapClientE $ claimRemotePrekey (Qualified u d) c claimLocalPrekey :: - Member DeleteQueue r => + (Member DeleteQueue r) => LegalholdProtectee -> UserId -> ClientId -> @@ -467,7 +467,7 @@ claimLocalMultiPrekeyBundles protectee userClients = do -- | Enqueue an orderly deletion of an existing client. execDelete :: - Member DeleteQueue r => + (Member DeleteQueue r) => UserId -> Maybe ConnId -> Client -> @@ -483,7 +483,7 @@ execDelete u con c = do -- thus repairing any inconsistencies related to distributed -- (and possibly duplicated) client data. noPrekeys :: - Member DeleteQueue r => + (Member DeleteQueue r) => UserId -> ClientId -> (AppT r) () diff --git a/services/brig/src/Brig/API/Connection.hs b/services/brig/src/Brig/API/Connection.hs index 45445657f23..2b6eb43e05d 100644 --- a/services/brig/src/Brig/API/Connection.hs +++ b/services/brig/src/Brig/API/Connection.hs @@ -72,7 +72,7 @@ import Wire.GalleyAPIAccess import Wire.GalleyAPIAccess qualified as GalleyAPIAccess import Wire.NotificationSubsystem -ensureNotSameTeam :: Member GalleyAPIAccess r => Local UserId -> Local UserId -> (ConnectionM r) () +ensureNotSameTeam :: (Member GalleyAPIAccess r) => Local UserId -> Local UserId -> (ConnectionM r) () ensureNotSameTeam self target = do selfTeam <- lift $ liftSem $ GalleyAPIAccess.getTeamId (tUnqualified self) targetTeam <- lift $ liftSem $ GalleyAPIAccess.getTeamId (tUnqualified target) @@ -191,7 +191,7 @@ createConnectionToLocalUser self conn target = do -- FUTUREWORK: we may want to move this to the LH application logic, so we can recycle it for -- group conv creation and possibly other situations. checkLegalholdPolicyConflict :: - Member GalleyAPIAccess r => + (Member GalleyAPIAccess r) => UserId -> UserId -> ExceptT ConnectionError (AppT r) () @@ -397,7 +397,7 @@ localConnection la lb = do lift (wrapClient $ Data.lookupConnection la (tUntagged lb)) >>= tryJust (NotConnected (tUnqualified la) (tUntagged lb)) -mkRelationWithHistory :: HasCallStack => Relation -> Relation -> RelationWithHistory +mkRelationWithHistory :: (HasCallStack) => Relation -> Relation -> RelationWithHistory mkRelationWithHistory oldRel = \case Accepted -> AcceptedWithHistory Blocked -> BlockedWithHistory diff --git a/services/brig/src/Brig/API/Connection/Remote.hs b/services/brig/src/Brig/API/Connection/Remote.hs index d9de83ccef5..ea9f16a1a1c 100644 --- a/services/brig/src/Brig/API/Connection/Remote.hs +++ b/services/brig/src/Brig/API/Connection/Remote.hs @@ -347,7 +347,7 @@ checkLimitForLocalAction u oldRel action = -- | Check if the local backend federates with the remote user's team. Throw an -- exception if it does not federate. ensureFederatesWith :: - Member FederationConfigStore r => + (Member FederationConfigStore r) => Remote UserId -> ConnectionM r () ensureFederatesWith remote = do diff --git a/services/brig/src/Brig/API/Error.hs b/services/brig/src/Brig/API/Error.hs index 23a24bad4e2..dd5717c3b8a 100644 --- a/services/brig/src/Brig/API/Error.hs +++ b/services/brig/src/Brig/API/Error.hs @@ -19,7 +19,7 @@ module Brig.API.Error where import Brig.API.Types import Brig.Phone (PhoneException (..)) -import Control.Monad.Error.Class hiding (Error) +import Control.Monad.Error.Class (MonadError (..)) import Data.Aeson import Data.Aeson.KeyMap qualified as KeyMap import Data.ByteString.Conversion @@ -38,7 +38,7 @@ import Wire.API.User data Error where StdError :: !Wai.Error -> Error - RichError :: ToJSON a => !Wai.Error -> !a -> [Header] -> Error + RichError :: (ToJSON a) => !Wai.Error -> !a -> [Header] -> Error errorLabel :: Error -> LText errorLabel (StdError e) = Wai.label e @@ -48,7 +48,7 @@ errorStatus :: Error -> Status errorStatus (StdError e) = Wai.code e errorStatus (RichError e _ _) = Wai.code e -throwStd :: MonadError Error m => Wai.Error -> m a +throwStd :: (MonadError Error m) => Wai.Error -> m a throwStd = throwError . StdError throwRich :: (MonadError Error m, ToJSON x) => Wai.Error -> x -> [Header] -> m a diff --git a/services/brig/src/Brig/API/Internal.hs b/services/brig/src/Brig/API/Internal.hs index af81a62a56c..0fc40ee44d4 100644 --- a/services/brig/src/Brig/API/Internal.hs +++ b/services/brig/src/Brig/API/Internal.hs @@ -245,7 +245,7 @@ teamsAPI = :<|> Named @"team-size" Team.teamSize :<|> Named @"create-invitations-via-scim" Team.createInvitationViaScim -userAPI :: Member UserSubsystem r => ServerT BrigIRoutes.UserAPI (Handler r) +userAPI :: (Member UserSubsystem r) => ServerT BrigIRoutes.UserAPI (Handler r) userAPI = updateLocale :<|> deleteLocale @@ -575,10 +575,10 @@ listActivatedAccounts elh includePendingInvitations = do us <- liftSem $ mapM API.lookupHandle hs byIds (catMaybes us) where - byIds :: Member DeleteQueue r => [UserId] -> (AppT r) [UserAccount] + byIds :: (Member DeleteQueue r) => [UserId] -> (AppT r) [UserAccount] byIds uids = wrapClient (API.lookupAccounts uids) >>= filterM accountValid - accountValid :: Member DeleteQueue r => UserAccount -> (AppT r) Bool + accountValid :: (Member DeleteQueue r) => UserAccount -> (AppT r) Bool accountValid account = case userIdentity . accountUser $ account of Nothing -> pure False Just ident -> @@ -717,7 +717,7 @@ updateConnectionInternalH updateConn = do API.updateConnectionInternal updateConn !>> connError pure NoContent -checkBlacklistH :: Member BlacklistStore r => Maybe Email -> Maybe Phone -> (Handler r) CheckBlacklistResponse +checkBlacklistH :: (Member BlacklistStore r) => Maybe Email -> Maybe Phone -> (Handler r) CheckBlacklistResponse checkBlacklistH (Just email) Nothing = checkBlacklist (Left email) checkBlacklistH Nothing (Just phone) = checkBlacklist (Right phone) checkBlacklistH bade badp = @@ -726,10 +726,10 @@ checkBlacklistH bade badp = ("need exactly one of email, phone: " <> LT.pack (show (bade, badp))) ) -checkBlacklist :: Member BlacklistStore r => Either Email Phone -> (Handler r) CheckBlacklistResponse +checkBlacklist :: (Member BlacklistStore r) => Either Email Phone -> (Handler r) CheckBlacklistResponse checkBlacklist emailOrPhone = lift $ bool NotBlacklisted YesBlacklisted <$> API.isBlacklisted emailOrPhone -deleteFromBlacklistH :: Member BlacklistStore r => Maybe Email -> Maybe Phone -> (Handler r) NoContent +deleteFromBlacklistH :: (Member BlacklistStore r) => Maybe Email -> Maybe Phone -> (Handler r) NoContent deleteFromBlacklistH (Just email) Nothing = deleteFromBlacklist (Left email) deleteFromBlacklistH Nothing (Just phone) = deleteFromBlacklist (Right phone) deleteFromBlacklistH bade badp = @@ -738,10 +738,10 @@ deleteFromBlacklistH bade badp = ("need exactly one of email, phone: " <> LT.pack (show (bade, badp))) ) -deleteFromBlacklist :: Member BlacklistStore r => Either Email Phone -> (Handler r) NoContent +deleteFromBlacklist :: (Member BlacklistStore r) => Either Email Phone -> (Handler r) NoContent deleteFromBlacklist emailOrPhone = lift $ NoContent <$ API.blacklistDelete emailOrPhone -addBlacklistH :: Member BlacklistStore r => Maybe Email -> Maybe Phone -> (Handler r) NoContent +addBlacklistH :: (Member BlacklistStore r) => Maybe Email -> Maybe Phone -> (Handler r) NoContent addBlacklistH (Just email) Nothing = addBlacklist (Left email) addBlacklistH Nothing (Just phone) = addBlacklist (Right phone) addBlacklistH bade badp = @@ -750,12 +750,12 @@ addBlacklistH bade badp = ("need exactly one of email, phone: " <> LT.pack (show (bade, badp))) ) -addBlacklist :: Member BlacklistStore r => Either Email Phone -> (Handler r) NoContent +addBlacklist :: (Member BlacklistStore r) => Either Email Phone -> (Handler r) NoContent addBlacklist emailOrPhone = lift $ NoContent <$ API.blacklistInsert emailOrPhone -- | Get any matching prefixes. Also try for shorter prefix matches, -- i.e. checking for +123456 also checks for +12345, +1234, ... -getPhonePrefixesH :: Member BlacklistPhonePrefixStore r => PhonePrefix -> (Handler r) GetPhonePrefixResponse +getPhonePrefixesH :: (Member BlacklistPhonePrefixStore r) => PhonePrefix -> (Handler r) GetPhonePrefixResponse getPhonePrefixesH prefix = lift $ do results <- API.phonePrefixGet prefix pure $ case results of @@ -763,10 +763,10 @@ getPhonePrefixesH prefix = lift $ do (_ : _) -> PhonePrefixesFound results -- | Delete a phone prefix entry (must be an exact match) -deleteFromPhonePrefixH :: Member BlacklistPhonePrefixStore r => PhonePrefix -> (Handler r) NoContent +deleteFromPhonePrefixH :: (Member BlacklistPhonePrefixStore r) => PhonePrefix -> (Handler r) NoContent deleteFromPhonePrefixH prefix = lift $ NoContent <$ API.phonePrefixDelete prefix -addPhonePrefixH :: Member BlacklistPhonePrefixStore r => ExcludedPrefix -> (Handler r) NoContent +addPhonePrefixH :: (Member BlacklistPhonePrefixStore r) => ExcludedPrefix -> (Handler r) NoContent addPhonePrefixH prefix = lift $ NoContent <$ API.phonePrefixInsert prefix updateSSOIdH :: @@ -820,13 +820,13 @@ updateRichInfoH uid rup = -- Intra.onUserEvent uid (Just conn) (richInfoUpdate uid ri) lift $ wrapClient $ Data.updateRichInfo uid (mkRichInfoAssocList richInfo) -updateLocale :: Member UserSubsystem r => UserId -> LocaleUpdate -> (Handler r) LocaleUpdate +updateLocale :: (Member UserSubsystem r) => UserId -> LocaleUpdate -> (Handler r) LocaleUpdate updateLocale uid upd@(LocaleUpdate locale) = do qUid <- qualifyLocal uid lift . liftSem $ updateUserProfile qUid Nothing UpdateOriginScim def {locale = Just locale} pure upd -deleteLocale :: Member UserSubsystem r => UserId -> (Handler r) NoContent +deleteLocale :: (Member UserSubsystem r) => UserId -> (Handler r) NoContent deleteLocale uid = do defLoc <- setDefaultUserLocale <$> view settings qUid <- qualifyLocal uid @@ -859,7 +859,7 @@ getRichInfoMultiH (maybe [] fromCommaSeparatedList -> uids) = lift $ wrapClient $ API.lookupRichInfoMultiUsers uids updateHandleH :: - Member UserSubsystem r => + (Member UserSubsystem r) => UserId -> HandleUpdate -> Handler r NoContent @@ -869,7 +869,7 @@ updateHandleH uid (HandleUpdate handleUpd) = lift . liftSem $ UserSubsystem.updateHandle quid Nothing UpdateOriginScim handleUpd updateUserNameH :: - Member UserSubsystem r => + (Member UserSubsystem r) => UserId -> NameUpdate -> (Handler r) NoContent @@ -881,7 +881,7 @@ updateUserNameH uid (NameUpdate nameUpd) = Just _ -> lift . liftSem $ updateUserProfile luid Nothing UpdateOriginScim (def {name = Just name}) Nothing -> throwStd (errorToWai @'E.InvalidUser) -checkHandleInternalH :: Member UserSubsystem r => Handle -> Handler r CheckHandleResponse +checkHandleInternalH :: (Member UserSubsystem r) => Handle -> Handler r CheckHandleResponse checkHandleInternalH h = lift $ liftSem do API.checkHandle (fromHandle h) <&> \case API.CheckHandleFound -> CheckHandleResponseFound diff --git a/services/brig/src/Brig/API/MLS/KeyPackages.hs b/services/brig/src/Brig/API/MLS/KeyPackages.hs index 35d1edba025..9226a4db7be 100644 --- a/services/brig/src/Brig/API/MLS/KeyPackages.hs +++ b/services/brig/src/Brig/API/MLS/KeyPackages.hs @@ -138,7 +138,7 @@ claimRemoteKeyPackages lusr suite target = do pure bundle where - handleFailure :: Monad m => Maybe x -> ExceptT ClientError m x + handleFailure :: (Monad m) => Maybe x -> ExceptT ClientError m x handleFailure = maybe (throwE (ClientUserNotFound (tUnqualified target))) pure countKeyPackages :: Local UserId -> ClientId -> Maybe CipherSuite -> Handler r KeyPackageCount diff --git a/services/brig/src/Brig/API/OAuth.hs b/services/brig/src/Brig/API/OAuth.hs index 8643e8eff6d..915b9844e44 100644 --- a/services/brig/src/Brig/API/OAuth.hs +++ b/services/brig/src/Brig/API/OAuth.hs @@ -89,13 +89,13 @@ registerOAuthClient (OAuthClientConfig name uri) = do lift $ wrapClient $ insertOAuthClient cid name uri safeSecret pure credentials where - createSecret :: MonadIO m => m OAuthClientPlainTextSecret + createSecret :: (MonadIO m) => m OAuthClientPlainTextSecret createSecret = OAuthClientPlainTextSecret <$> rand32Bytes - hashClientSecret :: MonadIO m => OAuthClientPlainTextSecret -> m Password + hashClientSecret :: (MonadIO m) => OAuthClientPlainTextSecret -> m Password hashClientSecret = mkSafePassword . plainTextPassword8Unsafe . toText . unOAuthClientPlainTextSecret -rand32Bytes :: MonadIO m => m AsciiBase16 +rand32Bytes :: (MonadIO m) => m AsciiBase16 rand32Bytes = liftIO . fmap encodeBase16 $ randBytes 32 getOAuthClientById :: OAuthClientId -> (Handler r) OAuthClient @@ -205,7 +205,9 @@ createAccessTokenWithRefreshToken req = do lookupVerifyAndDeleteToken :: JWK -> OAuthRefreshToken -> (Handler r) OAuthRefreshTokenInfo lookupVerifyAndDeleteToken key = verifyRefreshToken key - >=> lift . wrapClient . lookupAndDeleteOAuthRefreshToken + >=> lift + . wrapClient + . lookupAndDeleteOAuthRefreshToken >=> maybe (throwStd $ errorToWai @'OAuthInvalidRefreshToken) pure verifyRefreshToken :: JWK -> OAuthRefreshToken -> (Handler r) OAuthRefreshTokenId @@ -230,7 +232,7 @@ createAccessTokenWithAuthorizationCode req = do key <- signingKey createAccessToken key uid cid scope -signingKey :: Member Jwk r => (Handler r) JWK +signingKey :: (Member Jwk r) => (Handler r) JWK signingKey = do fp <- view settings >>= maybe (throwStd $ errorToWai @'OAuthJwtError) pure . Opt.setOAuthJwkKeyPair lift (liftSem $ Jwk.get fp) >>= maybe (throwStd $ errorToWai @'OAuthJwtError) pure @@ -254,14 +256,14 @@ createAccessToken key uid cid scope = do let claims = emptyClaimsSet & claimSub ?~ sub (rid,) . OAuthToken <$> signRefreshToken claims - mkAccessToken :: Member Now r => (Handler r) OAuthAccessToken + mkAccessToken :: (Member Now r) => (Handler r) OAuthAccessToken mkAccessToken = do domain <- Opt.setFederationDomain <$> view settings exp <- fromIntegral . Opt.setOAuthAccessTokenExpirationTimeSecs <$> view settings claims <- mkAccessTokenClaims uid domain scope exp OAuthToken <$> signAccessToken claims - mkAccessTokenClaims :: Member Now r => UserId -> Domain -> OAuthScopes -> NominalDiffTime -> (Handler r) OAuthClaimsSet + mkAccessTokenClaims :: (Member Now r) => UserId -> Domain -> OAuthScopes -> NominalDiffTime -> (Handler r) OAuthClaimsSet mkAccessTokenClaims u domain scopes ttl = do iat <- lift (liftSem Now.get) uri <- maybe (throwStd $ errorToWai @'OAuthJwtError) pure $ domainText domain ^? stringOrUri @@ -298,7 +300,7 @@ createAccessToken key uid cid scope = do -------------------------------------------------------------------------------- -revokeRefreshToken :: Member Jwk r => OAuthRevokeRefreshTokenRequest -> (Handler r) () +revokeRefreshToken :: (Member Jwk r) => OAuthRevokeRefreshTokenRequest -> (Handler r) () revokeRefreshToken req = do key <- signingKey info <- lookupAndVerifyToken key req.refreshToken @@ -308,7 +310,9 @@ revokeRefreshToken req = do lookupAndVerifyToken :: JWK -> OAuthRefreshToken -> (Handler r) OAuthRefreshTokenInfo lookupAndVerifyToken key = verifyRefreshToken key - >=> lift . wrapClient . lookupOAuthRefreshTokenInfo + >=> lift + . wrapClient + . lookupOAuthRefreshTokenInfo >=> maybe (throwStd $ errorToWai @'OAuthInvalidRefreshToken) pure -------------------------------------------------------------------------------- diff --git a/services/brig/src/Brig/API/Public.hs b/services/brig/src/Brig/API/Public.hs index 3636589b6bd..f08d79cdabf 100644 --- a/services/brig/src/Brig/API/Public.hs +++ b/services/brig/src/Brig/API/Public.hs @@ -527,7 +527,7 @@ listPropertyKeysAndValues u = do Public.PropertyKeysAndValues <$> traverse parseStoredPropertyValue keysAndVals getPrekeyUnqualifiedH :: - Member DeleteQueue r => + (Member DeleteQueue r) => UserId -> UserId -> ClientId -> @@ -537,7 +537,7 @@ getPrekeyUnqualifiedH zusr user client = do getPrekeyH zusr (Qualified user domain) client getPrekeyH :: - Member DeleteQueue r => + (Member DeleteQueue r) => UserId -> Qualified UserId -> ClientId -> @@ -625,7 +625,7 @@ addClient usr con new = do !>> clientError deleteClient :: - Member DeleteQueue r => + (Member DeleteQueue r) => UserId -> ConnId -> ClientId -> @@ -812,7 +812,7 @@ createUser (Public.NewUserPublic new) = lift . runExceptT $ do Public.NewTeamMemberSSO _ -> Team.sendMemberWelcomeMail e t n l -getSelf :: Member UserSubsystem r => Local UserId -> Handler r Public.SelfProfile +getSelf :: (Member UserSubsystem r) => Local UserId -> Handler r Public.SelfProfile getSelf self = lift (liftSem (getSelfProfile self)) >>= ifNothing (errorToWai @'E.UserNotFound) @@ -856,7 +856,7 @@ listUsersByUnqualifiedIdsOrHandles self mUids mHandles = do (Nothing, Nothing) -> throwStd $ badRequest "at least one ids or handles must be provided" listUsersByIdsOrHandlesGetIds :: - Member UserStore r => + (Member UserStore r) => [Handle] -> Handler r [Qualified UserId] listUsersByIdsOrHandlesGetIds localHandles = do @@ -865,7 +865,7 @@ listUsersByIdsOrHandlesGetIds localHandles = do pure $ map (`Qualified` domain) localUsers listUsersByIdsOrHandlesGetUsers :: - Member UserStore r => + (Member UserStore r) => Local x -> Range n m [Qualified Handle] -> Handler r [Qualified UserId] @@ -927,7 +927,7 @@ instance ToJSON GetActivationCodeResp where toJSON (GetActivationCodeResp (k, c)) = object ["key" .= k, "code" .= c] updateUser :: - Member UserSubsystem r => + (Member UserSubsystem r) => Local UserId -> ConnId -> Public.UserUpdate -> @@ -994,7 +994,7 @@ changePassword :: UserId -> Public.PasswordChange -> (Handler r) (Maybe Public.C changePassword u cp = lift . exceptTToMaybe $ API.changePassword u cp changeLocale :: - Member UserSubsystem r => + (Member UserSubsystem r) => Local UserId -> ConnId -> Public.LocaleUpdate -> @@ -1020,7 +1020,7 @@ changeSupportedProtocols u conn (Public.SupportedProtocolUpdate prots) = -- | (zusr is ignored by this handler, ie. checking handles is allowed as long as you have -- *any* account.) -checkHandle :: Member UserSubsystem r => UserId -> Text -> Handler r () +checkHandle :: (Member UserSubsystem r) => UserId -> Text -> Handler r () checkHandle _uid hndl = lift (liftSem $ UserSubsystem.checkHandle hndl) >>= \case API.CheckHandleFound -> pure () @@ -1028,7 +1028,7 @@ checkHandle _uid hndl = -- | (zusr is ignored by this handler, ie. checking handles is allowed as long as you have -- *any* account.) -checkHandles :: Member UserSubsystem r => UserId -> Public.CheckHandles -> Handler r [Handle] +checkHandles :: (Member UserSubsystem r) => UserId -> Public.CheckHandles -> Handler r [Handle] checkHandles _ (Public.CheckHandles hs num) = do let handles = mapMaybe Handle.parseHandle (fromRange hs) lift $ liftSem $ API.checkHandles handles (fromRange num) @@ -1330,7 +1330,7 @@ activateKey (Public.Activate tgt code dryrun) sendVerificationCode :: forall r. - Member GalleyAPIAccess r => + (Member GalleyAPIAccess r) => Public.SendVerificationCode -> (Handler r) () sendVerificationCode req = do diff --git a/services/brig/src/Brig/API/Public/Swagger.hs b/services/brig/src/Brig/API/Public/Swagger.hs index bce174ab17f..6db030d193f 100644 --- a/services/brig/src/Brig/API/Public/Swagger.hs +++ b/services/brig/src/Brig/API/Public/Swagger.hs @@ -164,7 +164,7 @@ eventNotificationSchemas = fst . (`S.runDeclare` mempty) <$> renderAll render @Wire.API.Event.Team.Event "Wire.API.Event.Team.Event" ] - render :: forall a. S.ToSchema a => Text -> S.Declare (S.Definitions S.Schema) () + render :: forall a. (S.ToSchema a) => Text -> S.Declare (S.Definitions S.Schema) () render eventTypeName = do eventSchema <- S.declareNamedSchema (Proxy @a) <&> view S.schema S.declare (HM.singleton eventTypeName eventSchema) diff --git a/services/brig/src/Brig/API/User.hs b/services/brig/src/Brig/API/User.hs index fba40e66135..85956b8d88d 100644 --- a/services/brig/src/Brig/API/User.hs +++ b/services/brig/src/Brig/API/User.hs @@ -199,7 +199,7 @@ identityErrorToBrigError = \case IdentityErrorBlacklistedPhone -> Error.StdError $ errorToWai @'E.BlacklistedPhone IdentityErrorUserKeyExists -> Error.StdError $ errorToWai @'E.UserKeyExists -verifyUniquenessAndCheckBlacklist :: Member BlacklistStore r => UserKey -> ExceptT IdentityError (AppT r) () +verifyUniquenessAndCheckBlacklist :: (Member BlacklistStore r) => UserKey -> ExceptT IdentityError (AppT r) () verifyUniquenessAndCheckBlacklist uk = do wrapClientE $ checkKey Nothing uk blacklisted <- lift $ liftSem $ BlacklistStore.exists uk @@ -598,7 +598,7 @@ changeManagedBy uid conn (ManagedByUpdate mb) = do -- | Call 'changeEmail' and process result: if email changes to itself, succeed, if not, send -- validation email. -changeSelfEmail :: Member BlacklistStore r => UserId -> Email -> UpdateOriginType -> ExceptT Error.Error (AppT r) ChangeEmailResponse +changeSelfEmail :: (Member BlacklistStore r) => UserId -> Email -> UpdateOriginType -> ExceptT Error.Error (AppT r) ChangeEmailResponse changeSelfEmail u email allowScim = do changeEmail u email allowScim !>> Error.changeEmailError >>= \case ChangeEmailIdempotent -> @@ -618,7 +618,7 @@ changeSelfEmail u email allowScim = do (userIdentity usr) -- | Prepare changing the email (checking a number of invariants). -changeEmail :: Member BlacklistStore r => UserId -> Email -> UpdateOriginType -> ExceptT ChangeEmailError (AppT r) ChangeEmailResult +changeEmail :: (Member BlacklistStore r) => UserId -> Email -> UpdateOriginType -> ExceptT ChangeEmailError (AppT r) ChangeEmailResult changeEmail u email updateOrigin = do em <- either @@ -1102,7 +1102,7 @@ checkNewIsDifferent uid pw = do _ -> pure () mkPasswordResetKey :: - Member CodeStore r => + (Member CodeStore r) => PasswordResetIdentity -> ExceptT PasswordResetError (AppT r) PasswordResetKey mkPasswordResetKey ident = case ident of @@ -1330,7 +1330,7 @@ deleteAccount (accountUser -> user) = do -- Lookups lookupActivationCode :: - MonadClient m => + (MonadClient m) => Either Email Phone -> m (Maybe ActivationPair) lookupActivationCode emailOrPhone = do @@ -1356,7 +1356,7 @@ lookupPasswordResetCode emailOrPhone = do pure $ (k,) <$> c deleteUserNoVerify :: - Member DeleteQueue r => + (Member DeleteQueue r) => UserId -> Sem r () deleteUserNoVerify uid = do @@ -1402,13 +1402,13 @@ lookupProfilesV3 :: lookupProfilesV3 self others = getUserProfilesWithErrors self others getLegalHoldStatus :: - Member GalleyAPIAccess r => + (Member GalleyAPIAccess r) => UserId -> AppT r (Maybe UserLegalHoldStatus) getLegalHoldStatus uid = traverse (liftSem . getLegalHoldStatus' . accountUser) =<< wrapHttpClient (lookupAccount uid) getLegalHoldStatus' :: - Member GalleyAPIAccess r => + (Member GalleyAPIAccess r) => User -> Sem r UserLegalHoldStatus getLegalHoldStatus' user = @@ -1430,26 +1430,26 @@ lookupAccountsByIdentity emailOrPhone includePendingInvitations = do then pure result else pure $ filter ((/= PendingInvitation) . accountStatus) result -isBlacklisted :: Member BlacklistStore r => Either Email Phone -> AppT r Bool +isBlacklisted :: (Member BlacklistStore r) => Either Email Phone -> AppT r Bool isBlacklisted emailOrPhone = do let uk = either userEmailKey userPhoneKey emailOrPhone liftSem $ BlacklistStore.exists uk -blacklistInsert :: Member BlacklistStore r => Either Email Phone -> AppT r () +blacklistInsert :: (Member BlacklistStore r) => Either Email Phone -> AppT r () blacklistInsert emailOrPhone = do let uk = either userEmailKey userPhoneKey emailOrPhone liftSem $ BlacklistStore.insert uk -blacklistDelete :: Member BlacklistStore r => Either Email Phone -> AppT r () +blacklistDelete :: (Member BlacklistStore r) => Either Email Phone -> AppT r () blacklistDelete emailOrPhone = do let uk = either userEmailKey userPhoneKey emailOrPhone liftSem $ BlacklistStore.delete uk -phonePrefixGet :: Member BlacklistPhonePrefixStore r => PhonePrefix -> (AppT r) [ExcludedPrefix] +phonePrefixGet :: (Member BlacklistPhonePrefixStore r) => PhonePrefix -> (AppT r) [ExcludedPrefix] phonePrefixGet = liftSem . BlacklistPhonePrefixStore.getAll -phonePrefixDelete :: Member BlacklistPhonePrefixStore r => PhonePrefix -> (AppT r) () +phonePrefixDelete :: (Member BlacklistPhonePrefixStore r) => PhonePrefix -> (AppT r) () phonePrefixDelete = liftSem . BlacklistPhonePrefixStore.delete -phonePrefixInsert :: Member BlacklistPhonePrefixStore r => ExcludedPrefix -> (AppT r) () +phonePrefixInsert :: (Member BlacklistPhonePrefixStore r) => ExcludedPrefix -> (AppT r) () phonePrefixInsert = liftSem . BlacklistPhonePrefixStore.insert diff --git a/services/brig/src/Brig/API/Util.hs b/services/brig/src/Brig/API/Util.hs index 947f761a511..65f8c25d4eb 100644 --- a/services/brig/src/Brig/API/Util.hs +++ b/services/brig/src/Brig/API/Util.hs @@ -69,7 +69,7 @@ lookupProfilesMaybeFilterSameTeamOnly self us = do Just team -> filter (\x -> profileTeam x == Just team) us Nothing -> us -fetchUserIdentity :: Member UserSubsystem r => UserId -> AppT r (Maybe UserIdentity) +fetchUserIdentity :: (Member UserSubsystem r) => UserId -> AppT r (Maybe UserIdentity) fetchUserIdentity uid = do luid <- qualifyLocal uid liftSem (getSelfProfile luid) @@ -153,7 +153,7 @@ traverseConcurrentlyWithErrorsAppT f t = do (mapExceptT (lowerAppT env) . f) t -exceptTToMaybe :: Monad m => ExceptT e m () -> m (Maybe e) +exceptTToMaybe :: (Monad m) => ExceptT e m () -> m (Maybe e) exceptTToMaybe = (pure . either Just (const Nothing)) <=< runExceptT tryInsertVerificationCode :: Code.Code -> (RetryAfter -> e) -> ExceptT e (AppT r) () diff --git a/services/brig/src/Brig/AWS.hs b/services/brig/src/Brig/AWS.hs index 54a93e85c5b..dddf1f36e77 100644 --- a/services/brig/src/Brig/AWS.hs +++ b/services/brig/src/Brig/AWS.hs @@ -151,7 +151,7 @@ getQueueUrl :: m Text getQueueUrl e q = view SQS.getQueueUrlResponse_queueUrl <$> exec e (SQS.newGetQueueUrl q) -execute :: MonadIO m => Env -> Amazon a -> m a +execute :: (MonadIO m) => Env -> Amazon a -> m a execute e m = liftIO $ runResourceT (runReaderT (unAmazon m) e) data Error where @@ -276,7 +276,7 @@ exec :: m (AWSResponse a) exec e cmd = liftIO (execCatch e cmd) >>= either (throwM . GeneralError) pure -canRetry :: MonadIO m => Either AWS.Error a -> m Bool +canRetry :: (MonadIO m) => Either AWS.Error a -> m Bool canRetry (Right _) = pure False canRetry (Left e) = case e of AWS.TransportError (HttpExceptionRequest _ ResponseTimeout) -> pure True diff --git a/services/brig/src/Brig/AWS/SesNotification.hs b/services/brig/src/Brig/AWS/SesNotification.hs index 97f75c55f8a..63b1f5c07ca 100644 --- a/services/brig/src/Brig/AWS/SesNotification.hs +++ b/services/brig/src/Brig/AWS/SesNotification.hs @@ -31,13 +31,13 @@ import System.Logger.Class (field, msg, (~~)) import System.Logger.Class qualified as Log import Wire.API.User.Identity -onEvent :: Member BlacklistStore r => SESNotification -> AppT r () +onEvent :: (Member BlacklistStore r) => SESNotification -> AppT r () onEvent (MailBounce BouncePermanent es) = onPermanentBounce es onEvent (MailBounce BounceTransient es) = onTransientBounce es onEvent (MailBounce BounceUndetermined es) = onUndeterminedBounce es onEvent (MailComplaint es) = onComplaint es -onPermanentBounce :: Member BlacklistStore r => [Email] -> AppT r () +onPermanentBounce :: (Member BlacklistStore r) => [Email] -> AppT r () onPermanentBounce = mapM_ $ \e -> do logEmailEvent "Permanent bounce" e liftSem $ BlacklistStore.insert (userEmailKey e) @@ -48,7 +48,7 @@ onTransientBounce = mapM_ (logEmailEvent "Transient bounce") onUndeterminedBounce :: [Email] -> AppT r () onUndeterminedBounce = mapM_ (logEmailEvent "Undetermined bounce") -onComplaint :: Member BlacklistStore r => [Email] -> AppT r () +onComplaint :: (Member BlacklistStore r) => [Email] -> AppT r () onComplaint = mapM_ $ \e -> do logEmailEvent "Complaint" e liftSem $ BlacklistStore.insert (userEmailKey e) diff --git a/services/brig/src/Brig/App.hs b/services/brig/src/Brig/App.hs index d647ab88957..aa504c79d0a 100644 --- a/services/brig/src/Brig/App.hs +++ b/services/brig/src/Brig/App.hs @@ -582,7 +582,7 @@ newtype HttpClientIO a = HttpClientIO MonadIndexIO ) -runHttpClientIO :: MonadIO m => Env -> HttpClientIO a -> m a +runHttpClientIO :: (MonadIO m) => Env -> HttpClientIO a -> m a runHttpClientIO env = runClient (env ^. casClient) . runHttpT (env ^. httpManager) @@ -636,7 +636,7 @@ qualifyLocal :: (MonadReader Env m) => a -> m (Local a) qualifyLocal a = toLocalUnsafe <$> viewFederationDomain <*> pure a -- FUTUREWORK: rename to 'qualifyLocalPoly' -qualifyLocal' :: (Member (Input (Local ()))) r => a -> Sem r (Local a) +qualifyLocal' :: ((Member (Input (Local ()))) r) => a -> Sem r (Local a) qualifyLocal' a = flip toLocalUnsafe a . tDomain <$> input -- | Convert a qualified value into a local one. Throw if the value is not actually local. diff --git a/services/brig/src/Brig/Budget.hs b/services/brig/src/Brig/Budget.hs index cf952a3ed76..2cd24cdee95 100644 --- a/services/brig/src/Brig/Budget.hs +++ b/services/brig/src/Brig/Budget.hs @@ -58,7 +58,7 @@ newtype BudgetKey = BudgetKey Text -- -- FUTUREWORK: exceptions are not handled very nicely, but it's not clear what it would mean -- to improve this. -withBudget :: MonadClient m => BudgetKey -> Budget -> m a -> m (Budgeted a) +withBudget :: (MonadClient m) => BudgetKey -> Budget -> m a -> m (Budgeted a) withBudget k b ma = do Budget ttl val <- fromMaybe b <$> lookupBudget k let remaining = val - 1 @@ -70,7 +70,7 @@ withBudget k b ma = do pure (BudgetedValue a remaining) -- | Like 'withBudget', but does not decrease budget, only takes a look. -checkBudget :: MonadClient m => BudgetKey -> Budget -> m (Budgeted ()) +checkBudget :: (MonadClient m) => BudgetKey -> Budget -> m (Budgeted ()) checkBudget k b = do Budget ttl val <- fromMaybe b <$> lookupBudget k let remaining = val - 1 @@ -79,12 +79,12 @@ checkBudget k b = do then BudgetExhausted ttl else BudgetedValue () remaining -lookupBudget :: MonadClient m => BudgetKey -> m (Maybe Budget) +lookupBudget :: (MonadClient m) => BudgetKey -> m (Maybe Budget) lookupBudget k = fmap mk <$> query1 budgetSelect (params One (Identity k)) where mk (val, ttl) = Budget (fromIntegral ttl) val -insertBudget :: MonadClient m => BudgetKey -> Budget -> m () +insertBudget :: (MonadClient m) => BudgetKey -> Budget -> m () insertBudget k (Budget ttl val) = retry x5 $ write budgetInsert (params One (k, val, round ttl)) diff --git a/services/brig/src/Brig/Calling/API.hs b/services/brig/src/Brig/Calling/API.hs index 998b92ee874..a02a18da9b9 100644 --- a/services/brig/src/Brig/Calling/API.hs +++ b/services/brig/src/Brig/Calling/API.hs @@ -203,10 +203,10 @@ newConfig env discoveredServers sftStaticUrl mSftEnv limit listAllServers versio genTurnUsername = (fmap (uncurry Public.turnUsername) .) . genUsername genSFTUsername :: Word32 -> MWC.GenIO -> IO Public.SFTUsername genSFTUsername = (fmap (uncurry Public.mkSFTUsername) .) . genUsername - computeCred :: ToByteString a => Digest -> ByteString -> a -> AsciiBase64 + computeCred :: (ToByteString a) => Digest -> ByteString -> a -> AsciiBase64 computeCred dig secret = encodeBase64 . hmacBS dig secret . toByteString' authenticate :: - Member (Embed IO) r => + (Member (Embed IO) r) => Public.SFTServer -> Sem r Public.AuthSFTServer authenticate = diff --git a/services/brig/src/Brig/CanonicalInterpreter.hs b/services/brig/src/Brig/CanonicalInterpreter.hs index e4d1da5f636..a7dbd00267f 100644 --- a/services/brig/src/Brig/CanonicalInterpreter.hs +++ b/services/brig/src/Brig/CanonicalInterpreter.hs @@ -161,7 +161,7 @@ runBrigToIO e (AppT ma) = do ) $ runReaderT ma e -rethrowWaiErrorIO :: Member (Final IO) r => InterpreterFor (Error Wai.Error) r +rethrowWaiErrorIO :: (Member (Final IO) r) => InterpreterFor (Error Wai.Error) r rethrowWaiErrorIO act = do eithError <- errorToIOFinal act case eithError of diff --git a/services/brig/src/Brig/Code.hs b/services/brig/src/Brig/Code.hs index 2ea506aa5e7..7e4aefff3c6 100644 --- a/services/brig/src/Brig/Code.hs +++ b/services/brig/src/Brig/Code.hs @@ -170,7 +170,7 @@ data Gen = Gen genValue :: IO Value } -mkKey :: MonadIO m => CodeFor -> m Key +mkKey :: (MonadIO m) => CodeFor -> m Key mkKey cfor = liftIO $ do Just sha256 <- getDigestByName "SHA256" let uniqueK = case cfor of @@ -179,7 +179,7 @@ mkKey cfor = liftIO $ do pure $ mkKey' sha256 (Text.encodeUtf8 uniqueK) -- | Initialise a 'Code' 'Gen'erator for a given natural key. This generates a link for emails and a 6-digit code for phone. See also: `mk6DigitGen`. -mkGen :: MonadIO m => CodeFor -> m Gen +mkGen :: (MonadIO m) => CodeFor -> m Gen mkGen cfor = liftIO $ do Just sha256 <- getDigestByName "SHA256" pure (initGen sha256 cfor) @@ -188,7 +188,7 @@ mkGen cfor = liftIO $ do initGen d _ = mk6DigitGen' cfor d -- | Initialise a 'Code' 'Gen'erator for a given natural key. This generates a 6-digit code, matter whether it is sent to a phone or to an email address. See also: `mkGen`. -mk6DigitGen :: MonadIO m => CodeFor -> m Gen +mk6DigitGen :: (MonadIO m) => CodeFor -> m Gen mk6DigitGen cfor = liftIO $ do Just sha256 <- getDigestByName "SHA256" pure $ mk6DigitGen' cfor sha256 @@ -213,7 +213,7 @@ mkKey' d = Key . unsafeRange . Ascii.encodeBase64Url . BS.take 15 . digestBS d -- | Generate a new 'Code'. generate :: - MonadIO m => + (MonadIO m) => -- | The 'Gen'erator to use. Gen -> -- | The scope of the generated code. @@ -272,7 +272,7 @@ generate gen scope retries ttl account = do -------------------------------------------------------------------------------- -- Storage -insert :: MonadClient m => Code -> Int -> m (Maybe RetryAfter) +insert :: (MonadClient m) => Code -> Int -> m (Maybe RetryAfter) insert code ttl = do mRetryAfter <- lookupThrottle (codeKey code) (codeScope code) case mRetryAfter of @@ -282,7 +282,7 @@ insert code ttl = do insertInternal code pure Nothing where - insertThrottle :: MonadClient m => Code -> Int -> m () + insertThrottle :: (MonadClient m) => Code -> Int -> m () insertThrottle c t = do let k = codeKey c let s = codeScope c @@ -293,7 +293,7 @@ insert code ttl = do "INSERT INTO vcodes_throttle (key, scope, initial_delay) \ \VALUES (?, ?, ?) USING TTL ?" -insertInternal :: MonadClient m => Code -> m () +insertInternal :: (MonadClient m) => Code -> m () insertInternal c = do let k = codeKey c let s = codeScope c @@ -311,7 +311,7 @@ insertInternal c = do \VALUES (?, ?, ?, ?, ?, ?, ?) USING TTL ?" -- | Check if code generation should be throttled. -lookupThrottle :: MonadClient m => Key -> Scope -> m (Maybe RetryAfter) +lookupThrottle :: (MonadClient m) => Key -> Scope -> m (Maybe RetryAfter) lookupThrottle k s = do fmap (RetryAfter . fromIntegral . runIdentity) <$> retry x1 (query1 cql (params LocalQuorum (k, s))) where @@ -321,7 +321,7 @@ lookupThrottle k s = do \FROM vcodes_throttle WHERE key = ? AND scope = ?" -- | Lookup a pending code. -lookup :: MonadClient m => Key -> Scope -> m (Maybe Code) +lookup :: (MonadClient m) => Key -> Scope -> m (Maybe Code) lookup k s = fmap (toCode k s) <$> retry x1 (query1 cql (params LocalQuorum (k, s))) where cql :: PrepQuery R (Key, Scope) (Value, Int32, Retries, Maybe Email, Maybe Phone, Maybe UUID) @@ -331,7 +331,7 @@ lookup k s = fmap (toCode k s) <$> retry x1 (query1 cql (params LocalQuorum (k, -- | Lookup and verify the code for the given key and scope -- against the given value. -verify :: MonadClient m => Key -> Scope -> Value -> m (Maybe Code) +verify :: (MonadClient m) => Key -> Scope -> Value -> m (Maybe Code) verify k s v = lookup k s >>= maybe (pure Nothing) continue where continue c @@ -342,7 +342,7 @@ verify k s v = lookup k s >>= maybe (pure Nothing) continue | otherwise = pure Nothing -- | Delete a code associated with the given key and scope. -delete :: MonadClient m => Key -> Scope -> m () +delete :: (MonadClient m) => Key -> Scope -> m () delete k s = retry x5 $ write cql (params LocalQuorum (k, s)) where cql :: PrepQuery W (Key, Scope) () diff --git a/services/brig/src/Brig/Data/Activation.hs b/services/brig/src/Brig/Data/Activation.hs index 2afb23725fd..66ab54f85b3 100644 --- a/services/brig/src/Brig/Data/Activation.hs +++ b/services/brig/src/Brig/Data/Activation.hs @@ -141,7 +141,7 @@ activateKey k c u = verifyCode k c >>= pickUser >>= activate -- | Create a new pending activation for a given 'UserKey'. newActivation :: - MonadClient m => + (MonadClient m) => UserKey -> -- | The timeout for the activation code. Timeout -> @@ -166,14 +166,14 @@ newActivation uk timeout u = do <$> randIntegerZeroToNMinusOne 1000000 -- | Lookup an activation code and it's associated owner (if any) for a 'UserKey'. -lookupActivationCode :: MonadClient m => UserKey -> m (Maybe (Maybe UserId, ActivationCode)) +lookupActivationCode :: (MonadClient m) => UserKey -> m (Maybe (Maybe UserId, ActivationCode)) lookupActivationCode k = liftIO (mkActivationKey k) >>= retry x1 . query1 codeSelect . params LocalQuorum . Identity -- | Verify an activation code. verifyCode :: - MonadClient m => + (MonadClient m) => ActivationKey -> ActivationCode -> ExceptT ActivationError m (UserKey, Maybe UserId) @@ -182,9 +182,9 @@ verifyCode key code = do case s of Just (ttl, Ascii t, k, c, u, r) -> if - | c == code -> mkScope t k u - | r >= 1 -> countdown (key, t, k, c, u, r - 1, ttl) >> throwE invalidCode - | otherwise -> revoke >> throwE invalidCode + | c == code -> mkScope t k u + | r >= 1 -> countdown (key, t, k, c, u, r - 1, ttl) >> throwE invalidCode + | otherwise -> revoke >> throwE invalidCode Nothing -> throwE invalidCode where mkScope "email" k u = case parseEmail k of @@ -204,7 +204,7 @@ mkActivationKey k = do let bs = digestBS d' (T.encodeUtf8 $ keyText k) pure . ActivationKey $ Ascii.encodeBase64Url bs -deleteActivationPair :: MonadClient m => ActivationKey -> m () +deleteActivationPair :: (MonadClient m) => ActivationKey -> m () deleteActivationPair = write keyDelete . params LocalQuorum . Identity invalidUser :: ActivationError diff --git a/services/brig/src/Brig/Data/Client.hs b/services/brig/src/Brig/Data/Client.hs index b214ef7ab06..4c03acc49b4 100644 --- a/services/brig/src/Brig/Data/Client.hs +++ b/services/brig/src/Brig/Data/Client.hs @@ -184,7 +184,7 @@ addClientWithReAuthPolicy reAuthPolicy u newId c maxPermClients cps = do clientLastActive = Nothing } -lookupClient :: MonadClient m => UserId -> ClientId -> m (Maybe Client) +lookupClient :: (MonadClient m) => UserId -> ClientId -> m (Maybe Client) lookupClient u c = do keys <- retry x1 (query selectMLSPublicKeys (params LocalQuorum (u, c))) fmap (toClient keys) @@ -195,7 +195,7 @@ lookupClientsBulk uids = liftClient $ do userClientTuples <- pooledMapConcurrentlyN 50 getClientSetWithUser uids pure $ Map.fromList userClientTuples where - getClientSetWithUser :: MonadClient m => UserId -> m (UserId, Imports.Set Client) + getClientSetWithUser :: (MonadClient m) => UserId -> m (UserId, Imports.Set Client) getClientSetWithUser u = fmap ((u,) . Set.fromList) . lookupClients $ u lookupPubClientsBulk :: (MonadClient m) => [UserId] -> m (UserMap (Imports.Set PubClient)) @@ -203,13 +203,13 @@ lookupPubClientsBulk uids = liftClient $ do userClientTuples <- pooledMapConcurrentlyN 50 getClientSetWithUser uids pure $ UserMap $ Map.fromList userClientTuples where - getClientSetWithUser :: MonadClient m => UserId -> m (UserId, Imports.Set PubClient) + getClientSetWithUser :: (MonadClient m) => UserId -> m (UserId, Imports.Set PubClient) getClientSetWithUser u = (u,) . Set.fromList . map toPubClient <$> executeQuery u - executeQuery :: MonadClient m => UserId -> m [(ClientId, Maybe ClientClass)] + executeQuery :: (MonadClient m) => UserId -> m [(ClientId, Maybe ClientClass)] executeQuery u = retry x1 (query selectPubClients (params LocalQuorum (Identity u))) -lookupClients :: MonadClient m => UserId -> m [Client] +lookupClients :: (MonadClient m) => UserId -> m [Client] lookupClients u = do keys <- (\(cid, ss, Blob b) -> (cid, [(ss, LBS.toStrict b)])) @@ -223,23 +223,23 @@ lookupClients u = do updateKeys . toClient [] <$$> retry x1 (query selectClients (params LocalQuorum (Identity u))) -lookupClientIds :: MonadClient m => UserId -> m [ClientId] +lookupClientIds :: (MonadClient m) => UserId -> m [ClientId] lookupClientIds u = map runIdentity <$> retry x1 (query selectClientIds (params LocalQuorum (Identity u))) -lookupUsersClientIds :: MonadClient m => [UserId] -> m [(UserId, Set.Set ClientId)] +lookupUsersClientIds :: (MonadClient m) => [UserId] -> m [(UserId, Set.Set ClientId)] lookupUsersClientIds us = liftClient $ pooledMapConcurrentlyN 16 getClientIds us where getClientIds u = (u,) <$> fmap Set.fromList (lookupClientIds u) -lookupPrekeyIds :: MonadClient m => UserId -> ClientId -> m [PrekeyId] +lookupPrekeyIds :: (MonadClient m) => UserId -> ClientId -> m [PrekeyId] lookupPrekeyIds u c = map runIdentity <$> retry x1 (query selectPrekeyIds (params LocalQuorum (u, c))) -hasClient :: MonadClient m => UserId -> ClientId -> m Bool +hasClient :: (MonadClient m) => UserId -> ClientId -> m Bool hasClient u d = isJust <$> retry x1 (query1 checkClient (params LocalQuorum (u, d))) rmClient :: @@ -255,21 +255,21 @@ rmClient u c = do retry x5 $ write removeClientKeys (params LocalQuorum (u, c)) unlessM (isJust <$> view randomPrekeyLocalLock) $ deleteOptLock u c -updateClientLabel :: MonadClient m => UserId -> ClientId -> Maybe Text -> m () +updateClientLabel :: (MonadClient m) => UserId -> ClientId -> Maybe Text -> m () updateClientLabel u c l = retry x5 $ write updateClientLabelQuery (params LocalQuorum (l, u, c)) -updateClientCapabilities :: MonadClient m => UserId -> ClientId -> Maybe (Imports.Set ClientCapability) -> m () +updateClientCapabilities :: (MonadClient m) => UserId -> ClientId -> Maybe (Imports.Set ClientCapability) -> m () updateClientCapabilities u c fs = retry x5 $ write updateClientCapabilitiesQuery (params LocalQuorum (C.Set . Set.toList <$> fs, u, c)) -- | If the update fails, which can happen if device does not exist, then ignore the error silently. -updateClientLastActive :: MonadClient m => UserId -> ClientId -> UTCTime -> m () +updateClientLastActive :: (MonadClient m) => UserId -> ClientId -> UTCTime -> m () updateClientLastActive u c t = void . retry x5 $ trans updateClientLastActiveQuery (params LocalQuorum (t, u, c)) -updatePrekeys :: MonadClient m => UserId -> ClientId -> [Prekey] -> ExceptT ClientDataError m () +updatePrekeys :: (MonadClient m) => UserId -> ClientId -> [Prekey] -> ExceptT ClientDataError m () updatePrekeys u c pks = do plain <- mapM (hoistEither . fmapL (const MalformedPrekeys) . B64.decode . toByteString' . prekeyKey) pks binary <- liftIO $ zipWithM check pks plain @@ -319,7 +319,7 @@ claimPrekey u c = pure $ Just (ClientPrekey c (Prekey i k)) removeAndReturnPreKey Nothing = pure Nothing - pickRandomPrekey :: MonadIO f => [(PrekeyId, Text)] -> f (Maybe (PrekeyId, Text)) + pickRandomPrekey :: (MonadIO f) => [(PrekeyId, Text)] -> f (Maybe (PrekeyId, Text)) pickRandomPrekey [] = pure Nothing -- unless we only have one key left pickRandomPrekey [pk] = pure $ Just pk @@ -330,7 +330,7 @@ claimPrekey u c = pure $ atMay pks' ind lookupMLSPublicKey :: - MonadClient m => + (MonadClient m) => UserId -> ClientId -> SignatureSchemeTag -> @@ -339,7 +339,7 @@ lookupMLSPublicKey u c ss = (fromBlob . runIdentity) <$$> retry x1 (query1 selectMLSPublicKey (params LocalQuorum (u, c, ss))) addMLSPublicKeys :: - MonadClient m => + (MonadClient m) => UserId -> ClientId -> [(SignatureSchemeTag, ByteString)] -> @@ -347,7 +347,7 @@ addMLSPublicKeys :: addMLSPublicKeys u c = traverse_ (uncurry (addMLSPublicKey u c)) addMLSPublicKey :: - MonadClient m => + (MonadClient m) => UserId -> ClientId -> SignatureSchemeTag -> diff --git a/services/brig/src/Brig/Data/Connection.hs b/services/brig/src/Brig/Data/Connection.hs index ec46f3fe406..ff843f215f4 100644 --- a/services/brig/src/Brig/Data/Connection.hs +++ b/services/brig/src/Brig/Data/Connection.hs @@ -272,7 +272,7 @@ lookupRemoteConnectedUsersC u maxResults = paginateC remoteConnectionSelect (paramsP LocalQuorum (Identity (tUnqualified u)) maxResults) x1 .| C.map (\xs -> map (\x@(d, _, _, _, _, _) -> toRemoteUnsafe d (toRemoteUserConnection u x)) xs) -lookupRemoteConnectedUsersPaginated :: MonadClient m => Local UserId -> Int32 -> m (Page (Remote UserConnection)) +lookupRemoteConnectedUsersPaginated :: (MonadClient m) => Local UserId -> Int32 -> m (Page (Remote UserConnection)) lookupRemoteConnectedUsersPaginated u maxResults = do (\x@(d, _, _, _, _, _) -> toRemoteUnsafe d (toRemoteUserConnection u x)) <$$> retry x1 (paginate remoteConnectionSelect (paramsP LocalQuorum (Identity (tUnqualified u)) maxResults)) diff --git a/services/brig/src/Brig/Data/LoginCode.hs b/services/brig/src/Brig/Data/LoginCode.hs index 1f58dba7cc7..2bb0a86febf 100644 --- a/services/brig/src/Brig/Data/LoginCode.hs +++ b/services/brig/src/Brig/Data/LoginCode.hs @@ -76,10 +76,10 @@ lookupLoginCode u = do pending c now t = PendingLoginCode c (timeout now t) timeout now t = Timeout (t `diffUTCTime` now) -deleteLoginCode :: MonadClient m => UserId -> m () +deleteLoginCode :: (MonadClient m) => UserId -> m () deleteLoginCode u = retry x5 . write codeDelete $ params LocalQuorum (Identity u) -insertLoginCode :: MonadClient m => UserId -> LoginCode -> Int32 -> UTCTime -> m () +insertLoginCode :: (MonadClient m) => UserId -> LoginCode -> Int32 -> UTCTime -> m () insertLoginCode u c n t = retry x5 . write codeInsert $ params LocalQuorum (u, c, n, t, round ttl) -- Queries diff --git a/services/brig/src/Brig/Data/MLS/KeyPackage.hs b/services/brig/src/Brig/Data/MLS/KeyPackage.hs index 7aaccc4d16c..de816cbbbf0 100644 --- a/services/brig/src/Brig/Data/MLS/KeyPackage.hs +++ b/services/brig/src/Brig/Data/MLS/KeyPackage.hs @@ -45,7 +45,7 @@ import Wire.API.MLS.LeafNode import Wire.API.MLS.Serialisation insertKeyPackages :: - MonadClient m => + (MonadClient m) => UserId -> ClientId -> [(KeyPackageRef, CipherSuiteTag, KeyPackageData)] -> @@ -134,7 +134,7 @@ countKeyPackages :: m Int64 countKeyPackages u c suite = fromIntegral . length <$> getNonClaimedKeyPackages u c suite -deleteKeyPackages :: MonadClient m => UserId -> ClientId -> CipherSuiteTag -> [KeyPackageRef] -> m () +deleteKeyPackages :: (MonadClient m) => UserId -> ClientId -> CipherSuiteTag -> [KeyPackageRef] -> m () deleteKeyPackages u c suite refs = retry x5 $ write diff --git a/services/brig/src/Brig/Data/Nonce.hs b/services/brig/src/Brig/Data/Nonce.hs index 8ca18fd1a53..00fda3fbcd5 100644 --- a/services/brig/src/Brig/Data/Nonce.hs +++ b/services/brig/src/Brig/Data/Nonce.hs @@ -28,7 +28,7 @@ import Data.Nonce (Nonce, NonceTtlSecs) import Imports insertNonce :: - MonadClient m => + (MonadClient m) => NonceTtlSecs -> UserId -> Text -> @@ -40,14 +40,14 @@ insertNonce ttl uid key nonce = retry x5 . write insert $ params LocalQuorum (ui insert = "INSERT INTO nonce (user, key, nonce) VALUES (?, ?, ?) USING TTL ?" lookupAndDeleteNonce :: - MonadClient m => + (MonadClient m) => UserId -> Text -> m (Maybe Nonce) lookupAndDeleteNonce uid key = lookupNonce uid key <* deleteNonce uid key lookupNonce :: - MonadClient m => + (MonadClient m) => UserId -> Text -> m (Maybe Nonce) @@ -57,7 +57,7 @@ lookupNonce uid key = (runIdentity <$$>) . retry x5 . query1 get $ params LocalQ get = "SELECT nonce FROM nonce WHERE user = ? AND key = ?" deleteNonce :: - MonadClient m => + (MonadClient m) => UserId -> Text -> m () diff --git a/services/brig/src/Brig/Data/Properties.hs b/services/brig/src/Brig/Data/Properties.hs index b073394584f..6fd099d8620 100644 --- a/services/brig/src/Brig/Data/Properties.hs +++ b/services/brig/src/Brig/Data/Properties.hs @@ -39,7 +39,7 @@ data PropertiesDataError = TooManyProperties insertProperty :: - MonadClient m => + (MonadClient m) => UserId -> PropertyKey -> RawPropertyValue -> @@ -50,23 +50,23 @@ insertProperty u k v = do throwE TooManyProperties lift . retry x5 $ write propertyInsert (params LocalQuorum (u, k, v)) -deleteProperty :: MonadClient m => UserId -> PropertyKey -> m () +deleteProperty :: (MonadClient m) => UserId -> PropertyKey -> m () deleteProperty u k = retry x5 $ write propertyDelete (params LocalQuorum (u, k)) -clearProperties :: MonadClient m => UserId -> m () +clearProperties :: (MonadClient m) => UserId -> m () clearProperties u = retry x5 $ write propertyReset (params LocalQuorum (Identity u)) -lookupProperty :: MonadClient m => UserId -> PropertyKey -> m (Maybe RawPropertyValue) +lookupProperty :: (MonadClient m) => UserId -> PropertyKey -> m (Maybe RawPropertyValue) lookupProperty u k = fmap runIdentity <$> retry x1 (query1 propertySelect (params LocalQuorum (u, k))) -lookupPropertyKeys :: MonadClient m => UserId -> m [PropertyKey] +lookupPropertyKeys :: (MonadClient m) => UserId -> m [PropertyKey] lookupPropertyKeys u = map runIdentity <$> retry x1 (query propertyKeysSelect (params LocalQuorum (Identity u))) -lookupPropertyKeysAndValues :: MonadClient m => UserId -> m [(PropertyKey, RawPropertyValue)] +lookupPropertyKeysAndValues :: (MonadClient m) => UserId -> m [(PropertyKey, RawPropertyValue)] lookupPropertyKeysAndValues u = retry x1 (query propertyKeysValuesSelect (params LocalQuorum (Identity u))) diff --git a/services/brig/src/Brig/Data/User.hs b/services/brig/src/Brig/Data/User.hs index f4b495e1c99..15b83ca054f 100644 --- a/services/brig/src/Brig/Data/User.hs +++ b/services/brig/src/Brig/Data/User.hs @@ -155,7 +155,7 @@ newAccount u inv tid mbHandle = do prots = fromMaybe defSupportedProtocols (newUserSupportedProtocols u) user uid domain l e = User (Qualified uid domain) ident name pict assets colour False l Nothing mbHandle e tid managedBy prots -newAccountInviteViaScim :: MonadReader Env m => UserId -> TeamId -> Maybe Locale -> Name -> Email -> m UserAccount +newAccountInviteViaScim :: (MonadReader Env m) => UserId -> TeamId -> Maybe Locale -> Name -> Email -> m UserAccount newAccountInviteViaScim uid tid locale name email = do defLoc <- setDefaultUserLocale <$> view settings let loc = fromMaybe defLoc locale @@ -180,7 +180,7 @@ newAccountInviteViaScim uid tid locale name email = do defSupportedProtocols -- | Mandatory password authentication. -authenticate :: MonadClient m => UserId -> PlainTextPassword6 -> ExceptT AuthError m () +authenticate :: (MonadClient m) => UserId -> PlainTextPassword6 -> ExceptT AuthError m () authenticate u pw = lift (lookupAuth u) >>= \case Nothing -> throwE AuthInvalidUser @@ -226,7 +226,7 @@ isSamlUser uid = do _ -> pure False insertAccount :: - MonadClient m => + (MonadClient m) => UserAccount -> -- | If a bot: conversation and team -- (if a team conversation) @@ -278,16 +278,16 @@ insertAccount (UserAccount u status) mbConv password activated = retry x5 . batc "INSERT INTO service_team (provider, service, user, conv, team) \ \VALUES (?, ?, ?, ?, ?)" -updateEmail :: MonadClient m => UserId -> Email -> m () +updateEmail :: (MonadClient m) => UserId -> Email -> m () updateEmail u e = retry x5 $ write userEmailUpdate (params LocalQuorum (e, u)) -updateEmailUnvalidated :: MonadClient m => UserId -> Email -> m () +updateEmailUnvalidated :: (MonadClient m) => UserId -> Email -> m () updateEmailUnvalidated u e = retry x5 $ write userEmailUnvalidatedUpdate (params LocalQuorum (e, u)) -updatePhone :: MonadClient m => UserId -> Phone -> m () +updatePhone :: (MonadClient m) => UserId -> Phone -> m () updatePhone u p = retry x5 $ write userPhoneUpdate (params LocalQuorum (p, u)) -updateSSOId :: MonadClient m => UserId -> Maybe UserSSOId -> m Bool +updateSSOId :: (MonadClient m) => UserId -> Maybe UserSSOId -> m Bool updateSSOId u ssoid = do mteamid <- lookupUserTeam u case mteamid of @@ -296,18 +296,18 @@ updateSSOId u ssoid = do pure True Nothing -> pure False -updateManagedBy :: MonadClient m => UserId -> ManagedBy -> m () +updateManagedBy :: (MonadClient m) => UserId -> ManagedBy -> m () updateManagedBy u h = retry x5 $ write userManagedByUpdate (params LocalQuorum (h, u)) -updatePassword :: MonadClient m => UserId -> PlainTextPassword8 -> m () +updatePassword :: (MonadClient m) => UserId -> PlainTextPassword8 -> m () updatePassword u t = do p <- liftIO $ mkSafePassword t retry x5 $ write userPasswordUpdate (params LocalQuorum (p, u)) -updateRichInfo :: MonadClient m => UserId -> RichInfoAssocList -> m () +updateRichInfo :: (MonadClient m) => UserId -> RichInfoAssocList -> m () updateRichInfo u ri = retry x5 $ write userRichInfoUpdate (params LocalQuorum (ri, u)) -updateFeatureConferenceCalling :: MonadClient m => UserId -> Maybe (ApiFt.WithStatusNoLock ApiFt.ConferenceCallingConfig) -> m (Maybe (ApiFt.WithStatusNoLock ApiFt.ConferenceCallingConfig)) +updateFeatureConferenceCalling :: (MonadClient m) => UserId -> Maybe (ApiFt.WithStatusNoLock ApiFt.ConferenceCallingConfig) -> m (Maybe (ApiFt.WithStatusNoLock ApiFt.ConferenceCallingConfig)) updateFeatureConferenceCalling uid mbStatus = do let flag = ApiFt.wssStatus <$> mbStatus retry x5 $ write update (params LocalQuorum (flag, uid)) @@ -316,16 +316,16 @@ updateFeatureConferenceCalling uid mbStatus = do update :: PrepQuery W (Maybe ApiFt.FeatureStatus, UserId) () update = fromString "update user set feature_conference_calling = ? where id = ?" -deleteEmail :: MonadClient m => UserId -> m () +deleteEmail :: (MonadClient m) => UserId -> m () deleteEmail u = retry x5 $ write userEmailDelete (params LocalQuorum (Identity u)) -deleteEmailUnvalidated :: MonadClient m => UserId -> m () +deleteEmailUnvalidated :: (MonadClient m) => UserId -> m () deleteEmailUnvalidated u = retry x5 $ write userEmailUnvalidatedDelete (params LocalQuorum (Identity u)) -deletePhone :: MonadClient m => UserId -> m () +deletePhone :: (MonadClient m) => UserId -> m () deletePhone u = retry x5 $ write userPhoneDelete (params LocalQuorum (Identity u)) -deleteServiceUser :: MonadClient m => ProviderId -> ServiceId -> BotId -> m () +deleteServiceUser :: (MonadClient m) => ProviderId -> ServiceId -> BotId -> m () deleteServiceUser pid sid bid = do lookupServiceUser pid sid bid >>= \case Nothing -> pure () @@ -345,21 +345,21 @@ deleteServiceUser pid sid bid = do "DELETE FROM service_team \ \WHERE provider = ? AND service = ? AND team = ? AND user = ?" -updateStatus :: MonadClient m => UserId -> AccountStatus -> m () +updateStatus :: (MonadClient m) => UserId -> AccountStatus -> m () updateStatus u s = retry x5 $ write userStatusUpdate (params LocalQuorum (s, u)) -userExists :: MonadClient m => UserId -> m Bool +userExists :: (MonadClient m) => UserId -> m Bool userExists uid = isJust <$> retry x1 (query1 idSelect (params LocalQuorum (Identity uid))) -- | Whether the account has been activated by verifying -- an email address or phone number. -isActivated :: MonadClient m => UserId -> m Bool +isActivated :: (MonadClient m) => UserId -> m Bool isActivated u = (== Just (Identity True)) <$> retry x1 (query1 activatedSelect (params LocalQuorum (Identity u))) -filterActive :: MonadClient m => [UserId] -> m [UserId] +filterActive :: (MonadClient m) => [UserId] -> m [UserId] filterActive us = map (view _1) . filter isActiveUser <$> retry x1 (query accountStateSelectAll (params LocalQuorum (Identity us))) @@ -371,13 +371,13 @@ filterActive us = lookupUser :: (MonadClient m, MonadReader Env m) => HavePendingInvitations -> UserId -> m (Maybe User) lookupUser hpi u = listToMaybe <$> lookupUsers hpi [u] -activateUser :: MonadClient m => UserId -> UserIdentity -> m () +activateUser :: (MonadClient m) => UserId -> UserIdentity -> m () activateUser u ident = do let email = emailIdentity ident let phone = phoneIdentity ident retry x5 $ write userActivatedUpdate (params LocalQuorum (email, phone, u)) -deactivateUser :: MonadClient m => UserId -> m () +deactivateUser :: (MonadClient m) => UserId -> m () deactivateUser u = retry x5 $ write userDeactivatedUpdate (params LocalQuorum (Identity u)) @@ -386,28 +386,28 @@ lookupLocale u = do defLoc <- setDefaultUserLocale <$> view settings fmap (toLocale defLoc) <$> retry x1 (query1 localeSelect (params LocalQuorum (Identity u))) -lookupName :: MonadClient m => UserId -> m (Maybe Name) +lookupName :: (MonadClient m) => UserId -> m (Maybe Name) lookupName u = fmap runIdentity <$> retry x1 (query1 nameSelect (params LocalQuorum (Identity u))) -lookupPassword :: MonadClient m => UserId -> m (Maybe Password) +lookupPassword :: (MonadClient m) => UserId -> m (Maybe Password) lookupPassword u = (runIdentity =<<) <$> retry x1 (query1 passwordSelect (params LocalQuorum (Identity u))) -lookupStatus :: MonadClient m => UserId -> m (Maybe AccountStatus) +lookupStatus :: (MonadClient m) => UserId -> m (Maybe AccountStatus) lookupStatus u = (runIdentity =<<) <$> retry x1 (query1 statusSelect (params LocalQuorum (Identity u))) -lookupRichInfo :: MonadClient m => UserId -> m (Maybe RichInfoAssocList) +lookupRichInfo :: (MonadClient m) => UserId -> m (Maybe RichInfoAssocList) lookupRichInfo u = fmap runIdentity <$> retry x1 (query1 richInfoSelect (params LocalQuorum (Identity u))) -- | Returned rich infos are in the same order as users -lookupRichInfoMultiUsers :: MonadClient m => [UserId] -> m [(UserId, RichInfo)] +lookupRichInfoMultiUsers :: (MonadClient m) => [UserId] -> m [(UserId, RichInfo)] lookupRichInfoMultiUsers users = do mapMaybe (\(uid, mbRi) -> (uid,) . RichInfo <$> mbRi) <$> retry x1 (query richInfoSelectMulti (params LocalQuorum (Identity users))) @@ -415,12 +415,12 @@ lookupRichInfoMultiUsers users = do -- | Lookup user (no matter what status) and return 'TeamId'. Safe to use for authorization: -- suspended / deleted / ... users can't login, so no harm done if we authorize them *after* -- successful login. -lookupUserTeam :: MonadClient m => UserId -> m (Maybe TeamId) +lookupUserTeam :: (MonadClient m) => UserId -> m (Maybe TeamId) lookupUserTeam u = (runIdentity =<<) <$> retry x1 (query1 teamSelect (params LocalQuorum (Identity u))) -lookupAuth :: MonadClient m => UserId -> m (Maybe (Maybe Password, AccountStatus)) +lookupAuth :: (MonadClient m) => UserId -> m (Maybe (Maybe Password, AccountStatus)) lookupAuth u = fmap f <$> retry x1 (query1 authSelect (params LocalQuorum (Identity u))) where f (pw, st) = (pw, fromMaybe Active st) @@ -443,7 +443,7 @@ lookupAccounts usrs = do domain <- viewFederationDomain fmap (toUserAccount domain loc) <$> retry x1 (query accountsSelect (params LocalQuorum (Identity usrs))) -lookupServiceUser :: MonadClient m => ProviderId -> ServiceId -> BotId -> m (Maybe (ConvId, Maybe TeamId)) +lookupServiceUser :: (MonadClient m) => ProviderId -> ServiceId -> BotId -> m (Maybe (ConvId, Maybe TeamId)) lookupServiceUser pid sid bid = retry x1 (query1 cql (params LocalQuorum (pid, sid, bid))) where cql :: PrepQuery R (ProviderId, ServiceId, BotId) (ConvId, Maybe TeamId) @@ -453,7 +453,7 @@ lookupServiceUser pid sid bid = retry x1 (query1 cql (params LocalQuorum (pid, s -- | NB: might return a lot of users, and therefore we do streaming here (page-by-page). lookupServiceUsers :: - MonadClient m => + (MonadClient m) => ProviderId -> ServiceId -> ConduitM () [(BotId, ConvId, Maybe TeamId)] m () @@ -466,7 +466,7 @@ lookupServiceUsers pid sid = \WHERE provider = ? AND service = ?" lookupServiceUsersForTeam :: - MonadClient m => + (MonadClient m) => ProviderId -> ServiceId -> TeamId -> @@ -479,7 +479,7 @@ lookupServiceUsersForTeam pid sid tid = "SELECT user, conv FROM service_team \ \WHERE provider = ? AND service = ? AND team = ?" -lookupFeatureConferenceCalling :: MonadClient m => UserId -> m (Maybe (ApiFt.WithStatusNoLock ApiFt.ConferenceCallingConfig)) +lookupFeatureConferenceCalling :: (MonadClient m) => UserId -> m (Maybe (ApiFt.WithStatusNoLock ApiFt.ConferenceCallingConfig)) lookupFeatureConferenceCalling uid = do let q = query1 select (params LocalQuorum (Identity uid)) mStatusValue <- (>>= runIdentity) <$> retry x1 q diff --git a/services/brig/src/Brig/Data/UserKey.hs b/services/brig/src/Brig/Data/UserKey.hs index a1769c68421..15323d0f98d 100644 --- a/services/brig/src/Brig/Data/UserKey.hs +++ b/services/brig/src/Brig/Data/UserKey.hs @@ -58,10 +58,10 @@ foldKey f g k = case k of UserEmailKey ek -> f (emailKeyOrig ek) UserPhoneKey pk -> g (phoneKeyOrig pk) -forEmailKey :: Applicative f => UserKey -> (Email -> f a) -> f (Maybe a) +forEmailKey :: (Applicative f) => UserKey -> (Email -> f a) -> f (Maybe a) forEmailKey k f = foldKey (fmap Just . f) (const (pure Nothing)) k -forPhoneKey :: Applicative f => UserKey -> (Phone -> f a) -> f (Maybe a) +forPhoneKey :: (Applicative f) => UserKey -> (Phone -> f a) -> f (Maybe a) forPhoneKey k f = foldKey (const (pure Nothing)) (fmap Just . f) k -- | Get the normalised text of a 'UserKey'. @@ -77,7 +77,7 @@ keyTextOriginal (UserPhoneKey k) = fromPhone (phoneKeyOrig k) -- | Claim a 'UserKey' for a user. claimKey :: - MonadClient m => + (MonadClient m) => -- | The key to claim. UserKey -> -- | The user claiming the key. @@ -92,7 +92,7 @@ claimKey k u = do -- A key is available if it is not already actived for another user or -- if the other user and the user looking to claim the key are the same. keyAvailable :: - MonadClient m => + (MonadClient m) => -- | The key to check. UserKey -> -- | The user looking to claim the key, if any. @@ -105,16 +105,16 @@ keyAvailable k u = do (Just x, Just y) | x == y -> pure True (Just x, _) -> not <$> User.isActivated x -lookupKey :: MonadClient m => UserKey -> m (Maybe UserId) +lookupKey :: (MonadClient m) => UserKey -> m (Maybe UserId) lookupKey k = fmap runIdentity <$> retry x1 (query1 keySelect (params LocalQuorum (Identity $ keyText k))) -insertKey :: MonadClient m => UserId -> UserKey -> m () +insertKey :: (MonadClient m) => UserId -> UserKey -> m () insertKey u k = do retry x5 $ write keyInsert (params LocalQuorum (keyText k, u)) -deleteKey :: MonadClient m => UserKey -> m () +deleteKey :: (MonadClient m) => UserKey -> m () deleteKey k = do retry x5 $ write keyDelete (params LocalQuorum (Identity $ keyText k)) @@ -126,7 +126,7 @@ deleteKey k = do -- executed several times due to cassandra not supporting transactions) -- `deleteKeyForUser` does not fail for missing keys or keys that belong to -- another user: It always returns `()` as result. -deleteKeyForUser :: MonadClient m => UserId -> UserKey -> m () +deleteKeyForUser :: (MonadClient m) => UserId -> UserKey -> m () deleteKeyForUser uid k = do mbKeyUid <- lookupKey k case mbKeyUid of diff --git a/services/brig/src/Brig/DeleteQueue/Interpreter.hs b/services/brig/src/Brig/DeleteQueue/Interpreter.hs index e55b7453ef5..22e6dd90c73 100644 --- a/services/brig/src/Brig/DeleteQueue/Interpreter.hs +++ b/services/brig/src/Brig/DeleteQueue/Interpreter.hs @@ -49,7 +49,7 @@ enqueue :: Member (Logger (Log.Msg -> Log.Msg)) r, Member (Error ErrorCall) r ) => - ToJSON a => + (ToJSON a) => QueueEnv -> a -> Sem r () diff --git a/services/brig/src/Brig/Effects/BlacklistPhonePrefixStore/Cassandra.hs b/services/brig/src/Brig/Effects/BlacklistPhonePrefixStore/Cassandra.hs index e8c1713f91b..aab51f2831f 100644 --- a/services/brig/src/Brig/Effects/BlacklistPhonePrefixStore/Cassandra.hs +++ b/services/brig/src/Brig/Effects/BlacklistPhonePrefixStore/Cassandra.hs @@ -26,29 +26,29 @@ interpretBlacklistPhonePrefixStoreToCassandra = -------------------------------------------------------------------------------- -- Excluded phone prefixes -insertPrefix :: MonadClient m => ExcludedPrefix -> m () +insertPrefix :: (MonadClient m) => ExcludedPrefix -> m () insertPrefix prefix = retry x5 $ write ins (params LocalQuorum (phonePrefix prefix, comment prefix)) where ins :: PrepQuery W (PhonePrefix, Text) () ins = "INSERT INTO excluded_phones (prefix, comment) VALUES (?, ?)" -deletePrefix :: MonadClient m => PhonePrefix -> m () +deletePrefix :: (MonadClient m) => PhonePrefix -> m () deletePrefix prefix = retry x5 $ write del (params LocalQuorum (Identity prefix)) where del :: PrepQuery W (Identity PhonePrefix) () del = "DELETE FROM excluded_phones WHERE prefix = ?" -getAllPrefixes :: MonadClient m => PhonePrefix -> m [ExcludedPrefix] +getAllPrefixes :: (MonadClient m) => PhonePrefix -> m [ExcludedPrefix] getAllPrefixes prefix = do let prefixes = fromPhonePrefix <$> allPrefixes (fromPhonePrefix prefix) selectPrefixes prefixes -existsAnyPrefix :: MonadClient m => Phone -> m Bool +existsAnyPrefix :: (MonadClient m) => Phone -> m Bool existsAnyPrefix phone = do let prefixes = fromPhonePrefix <$> allPrefixes (fromPhone phone) not . null <$> selectPrefixes prefixes -selectPrefixes :: MonadClient m => [Text] -> m [ExcludedPrefix] +selectPrefixes :: (MonadClient m) => [Text] -> m [ExcludedPrefix] selectPrefixes prefixes = do results <- retry x1 (query sel (params LocalQuorum (Identity $ prefixes))) pure $ uncurry ExcludedPrefix <$> results diff --git a/services/brig/src/Brig/Effects/BlacklistStore/Cassandra.hs b/services/brig/src/Brig/Effects/BlacklistStore/Cassandra.hs index 995926b7040..8cbebdf7ac6 100644 --- a/services/brig/src/Brig/Effects/BlacklistStore/Cassandra.hs +++ b/services/brig/src/Brig/Effects/BlacklistStore/Cassandra.hs @@ -24,15 +24,15 @@ interpretBlacklistStoreToCassandra = -------------------------------------------------------------------------------- -- UserKey blacklisting -insert :: MonadClient m => UserKey -> m () +insert :: (MonadClient m) => UserKey -> m () insert uk = retry x5 $ write keyInsert (params LocalQuorum (Identity $ keyText uk)) -exists :: MonadClient m => UserKey -> m Bool +exists :: (MonadClient m) => UserKey -> m Bool exists uk = (pure . isJust) . fmap runIdentity =<< retry x1 (query1 keySelect (params LocalQuorum (Identity $ keyText uk))) -delete :: MonadClient m => UserKey -> m () +delete :: (MonadClient m) => UserKey -> m () delete uk = retry x5 $ write keyDelete (params LocalQuorum (Identity $ keyText uk)) keyInsert :: PrepQuery W (Identity Text) () diff --git a/services/brig/src/Brig/Effects/CodeStore/Cassandra.hs b/services/brig/src/Brig/Effects/CodeStore/Cassandra.hs index 26d4d2c7f32..f802b432014 100644 --- a/services/brig/src/Brig/Effects/CodeStore/Cassandra.hs +++ b/services/brig/src/Brig/Effects/CodeStore/Cassandra.hs @@ -74,21 +74,21 @@ codeStoreToCassandra = toRecord (prqdCode, prqdUser, prqdRetries, prqdTimeout) = PRQueryData {..} -genEmailCode :: MonadIO m => m PasswordResetCode +genEmailCode :: (MonadIO m) => m PasswordResetCode genEmailCode = PasswordResetCode . encodeBase64Url <$> liftIO (randBytes 24) -genPhoneCode :: MonadIO m => m PasswordResetCode +genPhoneCode :: (MonadIO m) => m PasswordResetCode genPhoneCode = PasswordResetCode . unsafeFromText . pack . printf "%06d" <$> liftIO (randIntegerZeroToNMinusOne 1000000) -mkPwdResetKey :: MonadIO m => UserId -> m PasswordResetKey +mkPwdResetKey :: (MonadIO m) => UserId -> m PasswordResetKey mkPwdResetKey u = do d <- liftIO $ getDigestByName "SHA256" >>= maybe (error "SHA256 not found") pure pure . PasswordResetKey . encodeBase64Url . digestBS d $ toByteString' u interpretClientToIO :: - Member (Final IO) r => + (Member (Final IO) r) => ClientState -> Sem (Embed Cassandra.Client ': r) a -> Sem r a diff --git a/services/brig/src/Brig/Effects/FederationConfigStore/Cassandra.hs b/services/brig/src/Brig/Effects/FederationConfigStore/Cassandra.hs index bc9fcd8f7b6..32b13005e25 100644 --- a/services/brig/src/Brig/Effects/FederationConfigStore/Cassandra.hs +++ b/services/brig/src/Brig/Effects/FederationConfigStore/Cassandra.hs @@ -103,7 +103,7 @@ getFederationConfigs' mFedStrategy cfgs = do maxKnownNodes :: Int maxKnownNodes = 10000 -getFederationConfig' :: MonadClient m => Map Domain FederationDomainConfig -> Domain -> m (Maybe FederationDomainConfig) +getFederationConfig' :: (MonadClient m) => Map Domain FederationDomainConfig -> Domain -> m (Maybe FederationDomainConfig) getFederationConfig' cfgs rDomain = case find ((== rDomain) . domain) cfgs of Just cfg -> pure . Just $ cfg -- the configuration from the file has precedence (if exists there should not be a db entry at all) Nothing -> do @@ -115,7 +115,7 @@ getFederationConfig' cfgs rDomain = case find ((== rDomain) . domain) cfgs of q :: PrepQuery R (Identity Domain) (FederatedUserSearchPolicy, Maybe Int32) q = "SELECT search_policy, restriction FROM federation_remotes WHERE domain = ?" -getFederationRemotesFromDb :: forall m. MonadClient m => m [FederationDomainConfig] +getFederationRemotesFromDb :: forall m. (MonadClient m) => m [FederationDomainConfig] getFederationRemotesFromDb = (\(d, p, r) -> FederationDomainConfig d p r) <$$> qry where qry :: m [(Domain, FederatedUserSearchPolicy, FederationRestriction)] @@ -127,7 +127,7 @@ getFederationRemotesFromDb = (\(d, p, r) -> FederationDomainConfig d p r) <$$> q get :: PrepQuery R () (Domain, FederatedUserSearchPolicy, Maybe Int32) get = fromString $ "SELECT domain, search_policy, restriction FROM federation_remotes LIMIT " <> show maxKnownNodes -addFederationConfig' :: MonadClient m => Map Domain FederationDomainConfig -> FederationDomainConfig -> m AddFederationRemoteResult +addFederationConfig' :: (MonadClient m) => Map Domain FederationDomainConfig -> FederationDomainConfig -> m AddFederationRemoteResult addFederationConfig' cfg (FederationDomainConfig rDomain searchPolicy restriction) = do -- if a domain already exists in a config, we do not allow to add it to the database conflict <- domainExistsInConfig (FederationDomainConfig rDomain searchPolicy restriction) @@ -159,7 +159,7 @@ addFederationConfig' cfg (FederationDomainConfig rDomain searchPolicy restrictio addTeams :: PrepQuery W (Domain, TeamId) () addTeams = "INSERT INTO federation_remote_teams (domain, team) VALUES (?, ?)" -updateFederationConfig' :: MonadClient m => Map Domain FederationDomainConfig -> FederationDomainConfig -> m UpdateFederationResult +updateFederationConfig' :: (MonadClient m) => Map Domain FederationDomainConfig -> FederationDomainConfig -> m UpdateFederationResult updateFederationConfig' cfgs (FederationDomainConfig rDomain searchPolicy restriction) = do -- if a domain already exists in a config, we do not allow update it if rDomain `elem` (domain <$> cfgs) @@ -182,7 +182,7 @@ updateFederationConfig' cfgs (FederationDomainConfig rDomain searchPolicy restri updateConfig :: PrepQuery W (FederatedUserSearchPolicy, Int32, Domain) x updateConfig = "UPDATE federation_remotes SET search_policy = ?, restriction = ? WHERE domain = ? IF EXISTS" - updateTeams :: MonadClient m => m () + updateTeams :: (MonadClient m) => m () updateTeams = retry x5 $ do write dropTeams (params LocalQuorum (Identity rDomain)) case restriction of @@ -196,7 +196,7 @@ updateFederationConfig' cfgs (FederationDomainConfig rDomain searchPolicy restri insertTeam :: PrepQuery W (Domain, TeamId) () insertTeam = "INSERT INTO federation_remote_teams (domain, team) VALUES (?, ?)" -addFederationRemoteTeam' :: MonadClient m => Map Domain FederationDomainConfig -> Domain -> TeamId -> m AddFederationRemoteTeamResult +addFederationRemoteTeam' :: (MonadClient m) => Map Domain FederationDomainConfig -> Domain -> TeamId -> m AddFederationRemoteTeamResult addFederationRemoteTeam' cfgs rDomain tid = do mDom <- getFederationConfig' cfgs rDomain case mDom of @@ -211,14 +211,14 @@ addFederationRemoteTeam' cfgs rDomain tid = do add :: PrepQuery W (Domain, TeamId) () add = "INSERT INTO federation_remote_teams (domain, team) VALUES (?, ?)" -getFederationRemoteTeams' :: MonadClient m => Domain -> m [FederationRemoteTeam] +getFederationRemoteTeams' :: (MonadClient m) => Domain -> m [FederationRemoteTeam] getFederationRemoteTeams' rDomain = do fmap (FederationRemoteTeam . runIdentity) <$> retry x1 (query get (params LocalQuorum (Identity rDomain))) where get :: PrepQuery R (Identity Domain) (Identity TeamId) get = "SELECT team FROM federation_remote_teams WHERE domain = ?" -removeFederationRemoteTeam' :: MonadClient m => Domain -> TeamId -> m () +removeFederationRemoteTeam' :: (MonadClient m) => Domain -> TeamId -> m () removeFederationRemoteTeam' rDomain rteam = retry x1 $ write delete (params LocalQuorum (rDomain, rteam)) where @@ -226,7 +226,7 @@ removeFederationRemoteTeam' rDomain rteam = delete = "DELETE FROM federation_remote_teams WHERE domain = ? AND team = ?" backendFederatesWithImpl :: - MonadClient m => + (MonadClient m) => Remote (Maybe TeamId) -> Map Domain FederationDomainConfig -> Maybe FederationStrategy -> @@ -258,7 +258,7 @@ instance Show RestrictionException where instance Exception RestrictionException -toRestriction :: MonadClient m => Domain -> Int32 -> m FederationRestriction +toRestriction :: (MonadClient m) => Domain -> Int32 -> m FederationRestriction toRestriction _ 0 = pure FederationRestrictionAllowAll toRestriction dom 1 = fmap FederationRestrictionByTeam $ diff --git a/services/brig/src/Brig/Effects/JwtTools.hs b/services/brig/src/Brig/Effects/JwtTools.hs index 1b9a1773413..a344f5b7ae4 100644 --- a/services/brig/src/Brig/Effects/JwtTools.hs +++ b/services/brig/src/Brig/Effects/JwtTools.hs @@ -55,7 +55,7 @@ data JwtTools m a where makeSem ''JwtTools -interpretJwtTools :: Member (Embed IO) r => Sem (JwtTools ': r) a -> Sem r a +interpretJwtTools :: (Member (Embed IO) r) => Sem (JwtTools ': r) a -> Sem r a interpretJwtTools = interpret $ \case GenerateDPoPAccessToken proof cid handle displayName tid nonce uri method skew ex now pem -> mapLeft RustError diff --git a/services/brig/src/Brig/Effects/PublicKeyBundle.hs b/services/brig/src/Brig/Effects/PublicKeyBundle.hs index bd7c680d994..3178d57380f 100644 --- a/services/brig/src/Brig/Effects/PublicKeyBundle.hs +++ b/services/brig/src/Brig/Effects/PublicKeyBundle.hs @@ -14,7 +14,7 @@ data PublicKeyBundle m a where makeSem ''PublicKeyBundle -interpretPublicKeyBundle :: Member (Embed IO) r => Sem (PublicKeyBundle ': r) a -> Sem r a +interpretPublicKeyBundle :: (Member (Embed IO) r) => Sem (PublicKeyBundle ': r) a -> Sem r a interpretPublicKeyBundle = interpret $ \(Get fp) -> do contents :: Either IOException ByteString <- liftIO $ try $ BS.readFile fp pure $ either (const Nothing) fromByteString contents diff --git a/services/brig/src/Brig/Effects/SFT.hs b/services/brig/src/Brig/Effects/SFT.hs index d1cdd9d2cde..04983783d5f 100644 --- a/services/brig/src/Brig/Effects/SFT.hs +++ b/services/brig/src/Brig/Effects/SFT.hs @@ -52,10 +52,10 @@ newtype SFTGetResponse = SFTGetResponse data SFT m a where SFTGetAllServers :: HttpsUrl -> SFT m SFTGetResponse -sftGetAllServers :: Member SFT r => HttpsUrl -> Sem r SFTGetResponse +sftGetAllServers :: (Member SFT r) => HttpsUrl -> Sem r SFTGetResponse sftGetAllServers = send . SFTGetAllServers -interpretSFT :: Members [Embed IO, TinyLog] r => Manager -> Sem (SFT ': r) a -> Sem r a +interpretSFT :: (Members [Embed IO, TinyLog] r) => Manager -> Sem (SFT ': r) a -> Sem r a interpretSFT httpManager = interpret $ \(SFTGetAllServers url) -> do let urlWithPath = ensureHttpsUrl $ (httpsUrl url) {uriPath = "/sft_servers_all.json"} fmap SFTGetResponse . runSftError urlWithPath $ do @@ -66,7 +66,7 @@ interpretSFT httpManager = interpret $ \(SFTGetAllServers url) -> do debug $ Log.field "URLs" (show res) . Log.msg ("Fetched the following server URLs" :: ByteString) pure res -runSftError :: Member TinyLog r => HttpsUrl -> Sem (Error SFTError : r) a -> Sem r (Either SFTError a) +runSftError :: (Member TinyLog r) => HttpsUrl -> Sem (Error SFTError : r) a -> Sem r (Either SFTError a) runSftError urlWithPath act = runError $ act @@ -85,7 +85,7 @@ instance ToSchema AllURLs where <$> unAllURLs .= field "sft_servers_all" (array schema) interpretSFTInMemory :: - Member TinyLog r => + (Member TinyLog r) => Map HttpsUrl SFTGetResponse -> Sem (SFT ': r) a -> Sem r a diff --git a/services/brig/src/Brig/Effects/UserPendingActivationStore.hs b/services/brig/src/Brig/Effects/UserPendingActivationStore.hs index 69a1db7397d..eb7cd15479a 100644 --- a/services/brig/src/Brig/Effects/UserPendingActivationStore.hs +++ b/services/brig/src/Brig/Effects/UserPendingActivationStore.hs @@ -23,5 +23,5 @@ data UserPendingActivationStore p m a where makeSem ''UserPendingActivationStore -remove :: forall p r. Member (UserPendingActivationStore p) r => UserId -> Sem r () +remove :: forall p r. (Member (UserPendingActivationStore p) r) => UserId -> Sem r () remove uid = removeMultiple [uid] diff --git a/services/brig/src/Brig/Effects/UserPendingActivationStore/Cassandra.hs b/services/brig/src/Brig/Effects/UserPendingActivationStore/Cassandra.hs index 44e6431e8e2..67023ee774e 100644 --- a/services/brig/src/Brig/Effects/UserPendingActivationStore/Cassandra.hs +++ b/services/brig/src/Brig/Effects/UserPendingActivationStore/Cassandra.hs @@ -27,14 +27,14 @@ userPendingActivationStoreToCassandra = List (Just ps) -> PC.ipNext ps RemoveMultiple uids -> usersPendingActivationRemoveMultiple uids -usersPendingActivationAdd :: MonadClient m => UserPendingActivation -> m () +usersPendingActivationAdd :: (MonadClient m) => UserPendingActivation -> m () usersPendingActivationAdd (UserPendingActivation uid expiresAt) = do retry x5 . write insertExpiration . params LocalQuorum $ (uid, expiresAt) where insertExpiration :: PrepQuery W (UserId, UTCTime) () insertExpiration = "INSERT INTO users_pending_activation (user, expires_at) VALUES (?, ?)" -usersPendingActivationList :: MonadClient m => m (Page UserPendingActivation) +usersPendingActivationList :: (MonadClient m) => m (Page UserPendingActivation) usersPendingActivationList = do uncurry UserPendingActivation <$$> retry x1 (paginate selectExpired (params LocalQuorum ())) where @@ -42,7 +42,7 @@ usersPendingActivationList = do selectExpired = "SELECT user, expires_at FROM users_pending_activation" -usersPendingActivationRemoveMultiple :: MonadClient m => [UserId] -> m () +usersPendingActivationRemoveMultiple :: (MonadClient m) => [UserId] -> m () usersPendingActivationRemoveMultiple uids = retry x5 . write deleteExpired . params LocalQuorum $ Identity uids where diff --git a/services/brig/src/Brig/IO/Intra.hs b/services/brig/src/Brig/IO/Intra.hs index b550a667ab9..650940bac87 100644 --- a/services/brig/src/Brig/IO/Intra.hs +++ b/services/brig/src/Brig/IO/Intra.hs @@ -192,7 +192,7 @@ onClientEvent orig conn e = do ] updateSearchIndex :: - Member (Embed HttpClientIO) r => + (Member (Embed HttpClientIO) r) => UserId -> UserEvent -> Sem r () diff --git a/services/brig/src/Brig/IO/Logging.hs b/services/brig/src/Brig/IO/Logging.hs index ec733caa119..56b805718bb 100644 --- a/services/brig/src/Brig/IO/Logging.hs +++ b/services/brig/src/Brig/IO/Logging.hs @@ -24,11 +24,16 @@ import System.Logger logConnection :: UserId -> Qualified UserId -> Msg -> Msg logConnection from (Qualified toUser toDomain) = - "connection.from" .= toByteString from - ~~ "connection.to" .= toByteString toUser - ~~ "connection.to_domain" .= toByteString toDomain + "connection.from" + .= toByteString from + ~~ "connection.to" + .= toByteString toUser + ~~ "connection.to_domain" + .= toByteString toDomain logLocalConnection :: UserId -> UserId -> Msg -> Msg logLocalConnection from to = - "connection.from" .= toByteString from - ~~ "connection.to" .= toByteString to + "connection.from" + .= toByteString from + ~~ "connection.to" + .= toByteString to diff --git a/services/brig/src/Brig/Index/Migrations/Types.hs b/services/brig/src/Brig/Index/Migrations/Types.hs index 389868c06eb..7854ce67aae 100644 --- a/services/brig/src/Brig/Index/Migrations/Types.hs +++ b/services/brig/src/Brig/Index/Migrations/Types.hs @@ -62,18 +62,18 @@ instance (MonadIO m, MonadThrow m) => C.MonadClient (MigrationActionT m) where liftClient = liftCassandra localState f = local (\env -> env {cassandraClientState = f $ cassandraClientState env}) -instance MonadIO m => MonadLogger (MigrationActionT m) where +instance (MonadIO m) => MonadLogger (MigrationActionT m) where log level f = do env <- ask Logger.log (logger env) level f -instance MonadIO m => Search.MonadIndexIO (MigrationActionT m) where +instance (MonadIO m) => Search.MonadIndexIO (MigrationActionT m) where liftIndexIO m = do Env {..} <- ask let indexEnv = Search.IndexEnv logger bhEnv Nothing searchIndex Nothing Nothing galleyEndpoint httpManager searchIndexCredentials Search.runIndexIO indexEnv m -instance MonadIO m => ES.MonadBH (MigrationActionT m) where +instance (MonadIO m) => ES.MonadBH (MigrationActionT m) where getBHEnv = bhEnv <$> ask data Env = Env @@ -90,11 +90,11 @@ runMigrationAction :: Env -> MigrationActionT m a -> m a runMigrationAction env action = runReaderT (unMigrationAction action) env -liftCassandra :: MonadIO m => C.Client a -> MigrationActionT m a +liftCassandra :: (MonadIO m) => C.Client a -> MigrationActionT m a liftCassandra m = do env <- ask lift $ C.runClient (cassandraClientState env) m -cleanup :: MonadIO m => Env -> m () +cleanup :: (MonadIO m) => Env -> m () cleanup env = do C.shutdown (cassandraClientState env) diff --git a/services/brig/src/Brig/Provider/API.hs b/services/brig/src/Brig/Provider/API.hs index 56587b0d68f..ee58e2d005a 100644 --- a/services/brig/src/Brig/Provider/API.hs +++ b/services/brig/src/Brig/Provider/API.hs @@ -160,7 +160,7 @@ servicesAPI = :<|> Named @"get-whitelisted-services-by-team-id" searchTeamServiceProfiles :<|> Named @"post-team-whitelist-by-team-id" updateServiceWhitelist -providerAPI :: Member GalleyAPIAccess r => ServerT ProviderAPI (Handler r) +providerAPI :: (Member GalleyAPIAccess r) => ServerT ProviderAPI (Handler r) providerAPI = Named @"provider-register" newAccount :<|> Named @"provider-activate" activateAccountKey @@ -174,13 +174,13 @@ providerAPI = :<|> Named @"provider-get-account" getAccount :<|> Named @"provider-get-profile" getProviderProfile -internalProviderAPI :: Member GalleyAPIAccess r => ServerT BrigIRoutes.ProviderAPI (Handler r) +internalProviderAPI :: (Member GalleyAPIAccess r) => ServerT BrigIRoutes.ProviderAPI (Handler r) internalProviderAPI = Named @"get-provider-activation-code" getActivationCodeH -------------------------------------------------------------------------------- -- Public API (Unauthenticated) -newAccount :: Member GalleyAPIAccess r => Public.NewProvider -> (Handler r) Public.NewProviderResponse +newAccount :: (Member GalleyAPIAccess r) => Public.NewProvider -> (Handler r) Public.NewProviderResponse newAccount new = do guardSecondFactorDisabled Nothing email <- case validateEmail (Public.newProviderEmail new) of @@ -213,7 +213,7 @@ newAccount new = do lift $ sendActivationMail name email key val False pure $ Public.NewProviderResponse pid newPass -activateAccountKey :: Member GalleyAPIAccess r => Code.Key -> Code.Value -> (Handler r) (Maybe Public.ProviderActivationResponse) +activateAccountKey :: (Member GalleyAPIAccess r) => Code.Key -> Code.Value -> (Handler r) (Maybe Public.ProviderActivationResponse) activateAccountKey key val = do guardSecondFactorDisabled Nothing c <- wrapClientE (Code.verify key Code.IdentityVerification val) >>= maybeInvalidCode @@ -236,7 +236,7 @@ activateAccountKey key val = do lift $ sendApprovalConfirmMail name email pure . Just $ Public.ProviderActivationResponse email -getActivationCodeH :: Member GalleyAPIAccess r => Public.Email -> (Handler r) Code.KeyValuePair +getActivationCodeH :: (Member GalleyAPIAccess r) => Public.Email -> (Handler r) Code.KeyValuePair getActivationCodeH e = do guardSecondFactorDisabled Nothing email <- case validateEmail e of @@ -246,7 +246,7 @@ getActivationCodeH e = do code <- wrapClientE $ Code.lookup (Code.genKey gen) Code.IdentityVerification maybe (throwStd activationKeyNotFound) (pure . Code.codeToKeyValuePair) code -login :: Member GalleyAPIAccess r => ProviderLogin -> Handler r ProviderTokenCookie +login :: (Member GalleyAPIAccess r) => ProviderLogin -> Handler r ProviderTokenCookie login l = do guardSecondFactorDisabled Nothing pid <- wrapClientE (DB.lookupKey (mkEmailKey (providerLoginEmail l))) >>= maybeBadCredentials @@ -257,7 +257,7 @@ login l = do s <- view settings pure $ ProviderTokenCookie (ProviderToken token) (not (setCookieInsecure s)) -beginPasswordReset :: Member GalleyAPIAccess r => Public.PasswordReset -> (Handler r) () +beginPasswordReset :: (Member GalleyAPIAccess r) => Public.PasswordReset -> (Handler r) () beginPasswordReset (Public.PasswordReset target) = do guardSecondFactorDisabled Nothing pid <- wrapClientE (DB.lookupKey (mkEmailKey target)) >>= maybeBadCredentials @@ -275,7 +275,7 @@ beginPasswordReset (Public.PasswordReset target) = do tryInsertVerificationCode code $ verificationCodeThrottledError . VerificationCodeThrottled lift $ sendPasswordResetMail target (Code.codeKey code) (Code.codeValue code) -completePasswordReset :: Member GalleyAPIAccess r => Public.CompletePasswordReset -> (Handler r) () +completePasswordReset :: (Member GalleyAPIAccess r) => Public.CompletePasswordReset -> (Handler r) () completePasswordReset (Public.CompletePasswordReset key val newpwd) = do guardSecondFactorDisabled Nothing code <- wrapClientE (Code.verify key Code.PasswordReset val) >>= maybeInvalidCode @@ -292,12 +292,12 @@ completePasswordReset (Public.CompletePasswordReset key val newpwd) = do -------------------------------------------------------------------------------- -- Provider API -getAccount :: Member GalleyAPIAccess r => ProviderId -> (Handler r) (Maybe Public.Provider) +getAccount :: (Member GalleyAPIAccess r) => ProviderId -> (Handler r) (Maybe Public.Provider) getAccount pid = do guardSecondFactorDisabled Nothing wrapClientE $ DB.lookupAccount pid -updateAccountProfile :: Member GalleyAPIAccess r => ProviderId -> Public.UpdateProvider -> (Handler r) () +updateAccountProfile :: (Member GalleyAPIAccess r) => ProviderId -> Public.UpdateProvider -> (Handler r) () updateAccountProfile pid upd = do guardSecondFactorDisabled Nothing _ <- wrapClientE (DB.lookupAccount pid) >>= maybeInvalidProvider @@ -308,7 +308,7 @@ updateAccountProfile pid upd = do (updateProviderUrl upd) (updateProviderDescr upd) -updateAccountEmail :: Member GalleyAPIAccess r => ProviderId -> Public.EmailUpdate -> (Handler r) () +updateAccountEmail :: (Member GalleyAPIAccess r) => ProviderId -> Public.EmailUpdate -> (Handler r) () updateAccountEmail pid (Public.EmailUpdate new) = do guardSecondFactorDisabled Nothing email <- case validateEmail new of @@ -327,7 +327,7 @@ updateAccountEmail pid (Public.EmailUpdate new) = do tryInsertVerificationCode code $ verificationCodeThrottledError . VerificationCodeThrottled lift $ sendActivationMail (Name "name") email (Code.codeKey code) (Code.codeValue code) True -updateAccountPassword :: Member GalleyAPIAccess r => ProviderId -> Public.PasswordChange -> (Handler r) () +updateAccountPassword :: (Member GalleyAPIAccess r) => ProviderId -> Public.PasswordChange -> (Handler r) () updateAccountPassword pid upd = do guardSecondFactorDisabled Nothing pass <- wrapClientE (DB.lookupPassword pid) >>= maybeBadCredentials @@ -338,7 +338,7 @@ updateAccountPassword pid upd = do wrapClientE $ DB.updateAccountPassword pid (newPassword upd) addService :: - Member GalleyAPIAccess r => + (Member GalleyAPIAccess r) => ProviderId -> Public.NewService -> (Handler r) Public.NewServiceResponse @@ -358,13 +358,13 @@ addService pid new = do let rstoken = maybe (Just token) (const Nothing) (newServiceToken new) pure $ Public.NewServiceResponse sid rstoken -listServices :: Member GalleyAPIAccess r => ProviderId -> (Handler r) [Public.Service] +listServices :: (Member GalleyAPIAccess r) => ProviderId -> (Handler r) [Public.Service] listServices pid = do guardSecondFactorDisabled Nothing wrapClientE $ DB.listServices pid getService :: - Member GalleyAPIAccess r => + (Member GalleyAPIAccess r) => ProviderId -> ServiceId -> (Handler r) Public.Service @@ -373,7 +373,7 @@ getService pid sid = do wrapClientE (DB.lookupService pid sid) >>= maybeServiceNotFound updateService :: - Member GalleyAPIAccess r => + (Member GalleyAPIAccess r) => ProviderId -> ServiceId -> Public.UpdateService -> @@ -407,7 +407,7 @@ updateService pid sid upd = do (serviceEnabled svc) updateServiceConn :: - Member GalleyAPIAccess r => + (Member GalleyAPIAccess r) => ProviderId -> ServiceId -> Public.UpdateServiceConn -> @@ -524,17 +524,17 @@ deleteAccount pid del = do -------------------------------------------------------------------------------- -- User API -getProviderProfile :: Member GalleyAPIAccess r => UserId -> ProviderId -> (Handler r) (Maybe Public.ProviderProfile) +getProviderProfile :: (Member GalleyAPIAccess r) => UserId -> ProviderId -> (Handler r) (Maybe Public.ProviderProfile) getProviderProfile _ pid = do guardSecondFactorDisabled Nothing wrapClientE (DB.lookupAccountProfile pid) -listServiceProfiles :: Member GalleyAPIAccess r => UserId -> ProviderId -> (Handler r) [Public.ServiceProfile] +listServiceProfiles :: (Member GalleyAPIAccess r) => UserId -> ProviderId -> (Handler r) [Public.ServiceProfile] listServiceProfiles _ pid = do guardSecondFactorDisabled Nothing wrapClientE $ DB.listServiceProfiles pid -getServiceProfile :: Member GalleyAPIAccess r => UserId -> ProviderId -> ServiceId -> (Handler r) Public.ServiceProfile +getServiceProfile :: (Member GalleyAPIAccess r) => UserId -> ProviderId -> ServiceId -> (Handler r) Public.ServiceProfile getServiceProfile _ pid sid = do guardSecondFactorDisabled Nothing wrapClientE (DB.lookupServiceProfile pid sid) >>= maybeServiceNotFound @@ -543,7 +543,7 @@ getServiceProfile _ pid sid = do -- pagination here, we need both 'start' and 'prefix'. -- -- Also see Note [buggy pagination]. -searchServiceProfiles :: Member GalleyAPIAccess r => UserId -> Maybe (Public.QueryAnyTags 1 3) -> Maybe Text -> Maybe (Range 10 100 Int32) -> (Handler r) Public.ServiceProfilePage +searchServiceProfiles :: (Member GalleyAPIAccess r) => UserId -> Maybe (Public.QueryAnyTags 1 3) -> Maybe Text -> Maybe (Range 10 100 Int32) -> (Handler r) Public.ServiceProfilePage searchServiceProfiles _ Nothing (Just start) mSize = do guardSecondFactorDisabled Nothing prefix :: Range 1 128 Text <- rangeChecked start @@ -577,14 +577,14 @@ searchTeamServiceProfiles uid tid prefix mFilterDisabled mSize = do -- Get search results wrapClientE $ DB.paginateServiceWhitelist tid prefix filterDisabled (fromRange size) -getServiceTagList :: Member GalleyAPIAccess r => UserId -> (Handler r) Public.ServiceTagList +getServiceTagList :: (Member GalleyAPIAccess r) => UserId -> (Handler r) Public.ServiceTagList getServiceTagList _ = do guardSecondFactorDisabled Nothing pure (Public.ServiceTagList allTags) where allTags = [(minBound :: Public.ServiceTag) ..] -updateServiceWhitelist :: Member GalleyAPIAccess r => UserId -> ConnId -> TeamId -> Public.UpdateServiceWhitelist -> (Handler r) UpdateServiceWhitelistResp +updateServiceWhitelist :: (Member GalleyAPIAccess r) => UserId -> ConnId -> TeamId -> Public.UpdateServiceWhitelist -> (Handler r) UpdateServiceWhitelistResp updateServiceWhitelist uid con tid upd = do guardSecondFactorDisabled (Just uid) let pid = updateServiceWhitelistProvider upd @@ -621,7 +621,7 @@ updateServiceWhitelist uid con tid upd = do -------------------------------------------------------------------------------- -- Bot API -addBot :: Member GalleyAPIAccess r => UserId -> ConnId -> ConvId -> Public.AddBot -> (Handler r) Public.AddBotResponse +addBot :: (Member GalleyAPIAccess r) => UserId -> ConnId -> ConvId -> Public.AddBot -> (Handler r) Public.AddBotResponse addBot zuid zcon cid add = do guardSecondFactorDisabled (Just zuid) zusr <- lift (wrapClient $ User.lookupUser NoPendingInvitations zuid) >>= maybeInvalidUser @@ -705,7 +705,7 @@ addBot zuid zcon cid add = do Public.rsAddBotEvent = ev } -removeBot :: Member GalleyAPIAccess r => UserId -> ConnId -> ConvId -> BotId -> (Handler r) (Maybe Public.RemoveBotResponse) +removeBot :: (Member GalleyAPIAccess r) => UserId -> ConnId -> ConvId -> BotId -> (Handler r) (Maybe Public.RemoveBotResponse) removeBot zusr zcon cid bid = do guardSecondFactorDisabled (Just zusr) -- Get the conversation and check preconditions @@ -738,12 +738,12 @@ botGetSelf bot = do p <- lift $ wrapClient $ User.lookupUser NoPendingInvitations (botUserId bot) maybe (throwStd (errorToWai @'E.UserNotFound)) (\u -> pure $ Public.mkUserProfile EmailVisibleToSelf u UserLegalHoldNoConsent) p -botGetClient :: Member GalleyAPIAccess r => BotId -> (Handler r) (Maybe Public.Client) +botGetClient :: (Member GalleyAPIAccess r) => BotId -> (Handler r) (Maybe Public.Client) botGetClient bot = do guardSecondFactorDisabled (Just (botUserId bot)) lift $ listToMaybe <$> wrapClient (User.lookupClients (botUserId bot)) -botListPrekeys :: Member GalleyAPIAccess r => BotId -> (Handler r) [Public.PrekeyId] +botListPrekeys :: (Member GalleyAPIAccess r) => BotId -> (Handler r) [Public.PrekeyId] botListPrekeys bot = do guardSecondFactorDisabled (Just (botUserId bot)) clt <- lift $ listToMaybe <$> wrapClient (User.lookupClients (botUserId bot)) @@ -751,7 +751,7 @@ botListPrekeys bot = do Nothing -> pure [] Just ci -> lift (wrapClient $ User.lookupPrekeyIds (botUserId bot) ci) -botUpdatePrekeys :: Member GalleyAPIAccess r => BotId -> Public.UpdateBotPrekeys -> (Handler r) () +botUpdatePrekeys :: (Member GalleyAPIAccess r) => BotId -> Public.UpdateBotPrekeys -> (Handler r) () botUpdatePrekeys bot upd = do guardSecondFactorDisabled (Just (botUserId bot)) clt <- lift $ listToMaybe <$> wrapClient (User.lookupClients (botUserId bot)) @@ -776,20 +776,20 @@ botClaimUsersPrekeys _ body = do throwStd (errorToWai @'E.TooManyClients) Client.claimLocalMultiPrekeyBundles UnprotectedBot body !>> clientError -botListUserProfiles :: Member GalleyAPIAccess r => BotId -> (CommaSeparatedList UserId) -> (Handler r) [Public.BotUserView] +botListUserProfiles :: (Member GalleyAPIAccess r) => BotId -> (CommaSeparatedList UserId) -> (Handler r) [Public.BotUserView] botListUserProfiles _ uids = do guardSecondFactorDisabled Nothing -- should we check all user ids? us <- lift . wrapClient $ User.lookupUsers NoPendingInvitations (fromCommaSeparatedList uids) pure (map mkBotUserView us) -botGetUserClients :: Member GalleyAPIAccess r => BotId -> UserId -> (Handler r) [Public.PubClient] +botGetUserClients :: (Member GalleyAPIAccess r) => BotId -> UserId -> (Handler r) [Public.PubClient] botGetUserClients _ uid = do guardSecondFactorDisabled (Just uid) lift $ pubClient <$$> wrapClient (User.lookupClients uid) where pubClient c = Public.PubClient (clientId c) (clientClass c) -botDeleteSelf :: Member GalleyAPIAccess r => BotId -> ConvId -> (Handler r) () +botDeleteSelf :: (Member GalleyAPIAccess r) => BotId -> ConvId -> (Handler r) () botDeleteSelf bid cid = do guardSecondFactorDisabled (Just (botUserId bid)) bot <- lift . wrapClient $ User.lookupUser NoPendingInvitations (botUserId bid) @@ -803,7 +803,7 @@ botDeleteSelf bid cid = do -- | If second factor auth is enabled, make sure that end-points that don't support it, but should, are blocked completely. -- (This is a workaround until we have 2FA for those end-points as well.) guardSecondFactorDisabled :: - Member GalleyAPIAccess r => + (Member GalleyAPIAccess r) => Maybe UserId -> ExceptT Error (AppT r) () guardSecondFactorDisabled mbUserId = do @@ -850,7 +850,7 @@ deleteBot zusr zcon bid cid = do void $ runExceptT $ User.updateStatus buid Deleted pure ev -validateServiceKey :: MonadIO m => Public.ServiceKeyPEM -> m (Maybe (Public.ServiceKey, Fingerprint Rsa)) +validateServiceKey :: (MonadIO m) => Public.ServiceKeyPEM -> m (Maybe (Public.ServiceKey, Fingerprint Rsa)) validateServiceKey pem = liftIO $ readPublicKey >>= \pk -> @@ -882,25 +882,25 @@ mkBotUserView u = Ext.botUserViewTeam = userTeam u } -maybeInvalidProvider :: Monad m => Maybe a -> (ExceptT Error m) a +maybeInvalidProvider :: (Monad m) => Maybe a -> (ExceptT Error m) a maybeInvalidProvider = maybe (throwStd (errorToWai @'E.ProviderNotFound)) pure -maybeInvalidCode :: Monad m => Maybe a -> (ExceptT Error m) a +maybeInvalidCode :: (Monad m) => Maybe a -> (ExceptT Error m) a maybeInvalidCode = maybe (throwStd (errorToWai @'E.InvalidCode)) pure -maybeServiceNotFound :: Monad m => Maybe a -> (ExceptT Error m) a +maybeServiceNotFound :: (Monad m) => Maybe a -> (ExceptT Error m) a maybeServiceNotFound = maybe (throwStd (errorToWai @'E.ServiceNotFound)) pure -maybeConvNotFound :: Monad m => Maybe a -> (ExceptT Error m) a +maybeConvNotFound :: (Monad m) => Maybe a -> (ExceptT Error m) a maybeConvNotFound = maybe (throwStd (notFound "Conversation not found")) pure -maybeBadCredentials :: Monad m => Maybe a -> (ExceptT Error m) a +maybeBadCredentials :: (Monad m) => Maybe a -> (ExceptT Error m) a maybeBadCredentials = maybe (throwStd (errorToWai @'E.BadCredentials)) pure -maybeInvalidServiceKey :: Monad m => Maybe a -> (ExceptT Error m) a +maybeInvalidServiceKey :: (Monad m) => Maybe a -> (ExceptT Error m) a maybeInvalidServiceKey = maybe (throwStd (errorToWai @'E.InvalidServiceKey)) pure -maybeInvalidUser :: Monad m => Maybe a -> (ExceptT Error m) a +maybeInvalidUser :: (Monad m) => Maybe a -> (ExceptT Error m) a maybeInvalidUser = maybe (throwStd (errorToWai @'E.InvalidUser)) pure rangeChecked :: (KnownNat n, KnownNat m, Within a n m, Monad monad) => a -> (ExceptT Error monad) (Range n m a) @@ -919,5 +919,5 @@ serviceError :: RPC.ServiceError -> Wai.Error serviceError (RPC.ServiceUnavailableWith str) = badGatewayWith str serviceError RPC.ServiceBotConflict = tooManyBots -randServiceToken :: MonadIO m => m Public.ServiceToken +randServiceToken :: (MonadIO m) => m Public.ServiceToken randServiceToken = ServiceToken . Ascii.encodeBase64Url <$> liftIO (randBytes 18) diff --git a/services/brig/src/Brig/Provider/DB.hs b/services/brig/src/Brig/Provider/DB.hs index 77aefc29ea5..9d25bbc570a 100644 --- a/services/brig/src/Brig/Provider/DB.hs +++ b/services/brig/src/Brig/Provider/DB.hs @@ -42,7 +42,7 @@ type RangedServiceTags = Range 0 3 (Set.Set ServiceTag) -- Providers insertAccount :: - MonadClient m => + (MonadClient m) => Name -> Password -> HttpsUrl -> @@ -57,7 +57,7 @@ insertAccount name pass url descr = do cql = "INSERT INTO provider (id, name, password, url, descr) VALUES (?, ?, ?, ?, ?)" updateAccountProfile :: - MonadClient m => + (MonadClient m) => ProviderId -> Maybe Name -> Maybe HttpsUrl -> @@ -79,7 +79,7 @@ updateAccountProfile p name url descr = retry x5 . batch $ do -- | Lookup the raw account data of a (possibly unverified) provider. lookupAccountData :: - MonadClient m => + (MonadClient m) => ProviderId -> m (Maybe (Name, Maybe Email, HttpsUrl, Text)) lookupAccountData p = retry x1 $ query1 cql $ params LocalQuorum (Identity p) @@ -88,7 +88,7 @@ lookupAccountData p = retry x1 $ query1 cql $ params LocalQuorum (Identity p) cql = "SELECT name, email, url, descr FROM provider WHERE id = ?" lookupAccount :: - MonadClient m => + (MonadClient m) => ProviderId -> m (Maybe Provider) lookupAccount p = (>>= mk) <$> lookupAccountData p @@ -98,13 +98,13 @@ lookupAccount p = (>>= mk) <$> lookupAccountData p mk (n, Just e, u, d) = Just $! Provider p n e u d lookupAccountProfile :: - MonadClient m => + (MonadClient m) => ProviderId -> m (Maybe ProviderProfile) lookupAccountProfile p = fmap ProviderProfile <$> lookupAccount p lookupPassword :: - MonadClient m => + (MonadClient m) => ProviderId -> m (Maybe Password) lookupPassword p = @@ -117,7 +117,7 @@ lookupPassword p = cql = "SELECT password FROM provider WHERE id = ?" deleteAccount :: - MonadClient m => + (MonadClient m) => ProviderId -> m () deleteAccount pid = retry x5 $ write cql $ params LocalQuorum (Identity pid) @@ -126,7 +126,7 @@ deleteAccount pid = retry x5 $ write cql $ params LocalQuorum (Identity pid) cql = "DELETE FROM provider WHERE id = ?" updateAccountPassword :: - MonadClient m => + (MonadClient m) => ProviderId -> PlainTextPassword6 -> m () @@ -141,7 +141,7 @@ updateAccountPassword pid pwd = do -- Unique (Natural) Keys insertKey :: - MonadClient m => + (MonadClient m) => ProviderId -> Maybe EmailKey -> EmailKey -> @@ -163,7 +163,7 @@ insertKey p old new = retry x5 . batch $ do cqlEmail = {- `IF EXISTS`, but that requires benchmarking -} "UPDATE provider SET email = ? WHERE id = ?" lookupKey :: - MonadClient m => + (MonadClient m) => EmailKey -> m (Maybe ProviderId) lookupKey k = @@ -175,7 +175,7 @@ lookupKey k = cql :: PrepQuery R (Identity Text) (Identity ProviderId) cql = "SELECT provider FROM provider_keys WHERE key = ?" -deleteKey :: MonadClient m => EmailKey -> m () +deleteKey :: (MonadClient m) => EmailKey -> m () deleteKey k = retry x5 $ write cql $ params LocalQuorum (Identity (emailKeyUniq k)) where cql :: PrepQuery W (Identity Text) () @@ -185,7 +185,7 @@ deleteKey k = retry x5 $ write cql $ params LocalQuorum (Identity (emailKeyUniq -- Services insertService :: - MonadClient m => + (MonadClient m) => ProviderId -> Name -> Text -> @@ -230,7 +230,7 @@ insertService pid name summary descr url token key fprint assets tags = do \VALUES (?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?)" lookupService :: - MonadClient m => + (MonadClient m) => ProviderId -> ServiceId -> m (Maybe Service) @@ -252,7 +252,7 @@ lookupService pid sid = Service sid name (fromMaybe mempty summary) descr url toks keys assets (Set.fromList (fromSet tags)) enabled listServices :: - MonadClient m => + (MonadClient m) => ProviderId -> m [Service] listServices p = @@ -274,7 +274,7 @@ listServices p = in Service sid name (fromMaybe mempty summary) descr url toks keys assets tags' enabled updateService :: - MonadClient m => + (MonadClient m) => ProviderId -> ServiceId -> Name -> @@ -319,7 +319,7 @@ updateService pid sid svcName svcTags nameChange summary descr assets tagsChange -- NB: can take a significant amount of time if many teams were using the service deleteService :: - MonadClient m => + (MonadClient m) => ProviderId -> ServiceId -> Name -> @@ -346,7 +346,7 @@ deleteService pid sid name tags = do -- | Note: Consistency = One lookupServiceProfile :: - MonadClient m => + (MonadClient m) => ProviderId -> ServiceId -> m (Maybe ServiceProfile) @@ -366,7 +366,7 @@ lookupServiceProfile p s = -- | Note: Consistency = One listServiceProfiles :: - MonadClient m => + (MonadClient m) => ProviderId -> m [ServiceProfile] listServiceProfiles p = @@ -401,7 +401,7 @@ data ServiceConn = ServiceConn -- | Lookup the connection information of a service. lookupServiceConn :: - MonadClient m => + (MonadClient m) => ProviderId -> ServiceId -> m (Maybe ServiceConn) @@ -419,7 +419,7 @@ lookupServiceConn pid sid = -- | Update connection information of a service. updateServiceConn :: - MonadClient m => + (MonadClient m) => ProviderId -> ServiceId -> Maybe HttpsUrl -> @@ -453,7 +453,7 @@ updateServiceConn pid sid url tokens keys enabled = retry x5 . batch $ do -- Service "Indexes" (tag and prefix); contain only enabled services insertServiceIndexes :: - MonadClient m => + (MonadClient m) => ProviderId -> ServiceId -> Name -> @@ -467,7 +467,7 @@ insertServiceIndexes pid sid name tags = insertServiceTags pid sid name tags deleteServiceIndexes :: - MonadClient m => + (MonadClient m) => ProviderId -> ServiceId -> Name -> @@ -572,7 +572,7 @@ type IndexRow = (Name, ProviderId, ServiceId) -- | Note: Consistency = One paginateServiceTags :: - MonadClient m => + (MonadClient m) => QueryAnyTags 1 3 -> Maybe Text -> Int32 -> @@ -657,7 +657,7 @@ updateServicePrefix pid sid oldName newName = do insertServicePrefix pid sid newName paginateServiceNames :: - MonadClient m => + (MonadClient m) => Maybe (Range 1 128 Text) -> Int32 -> Maybe ProviderId -> @@ -713,13 +713,13 @@ filterPrefix prefix p = do more = allValid && hasMore p in p {hasMore = more, result = prefixed} -resolveRow :: MonadClient m => IndexRow -> m (Maybe ServiceProfile) +resolveRow :: (MonadClient m) => IndexRow -> m (Maybe ServiceProfile) resolveRow (_, pid, sid) = lookupServiceProfile pid sid -------------------------------------------------------------------------------- -- Service whitelist -insertServiceWhitelist :: MonadClient m => TeamId -> ProviderId -> ServiceId -> m () +insertServiceWhitelist :: (MonadClient m) => TeamId -> ProviderId -> ServiceId -> m () insertServiceWhitelist tid pid sid = retry x5 . batch $ do addPrepQuery insert1 (tid, pid, sid) @@ -739,7 +739,7 @@ insertServiceWhitelist tid pid sid = -- -- NB: Can take a significant amount of time if many teams were using the service -deleteServiceWhitelist :: MonadClient m => Maybe TeamId -> ProviderId -> ServiceId -> m () +deleteServiceWhitelist :: (MonadClient m) => Maybe TeamId -> ProviderId -> ServiceId -> m () deleteServiceWhitelist mbTid pid sid = case mbTid of Nothing -> do teams <- retry x5 $ query lookupRev $ params LocalQuorum (pid, sid) @@ -775,7 +775,7 @@ deleteServiceWhitelist mbTid pid sid = case mbTid of -- paginateServiceWhitelist :: - MonadClient m => + (MonadClient m) => -- | Team for which to list the services TeamId -> -- | Prefix @@ -817,7 +817,7 @@ paginateServiceWhitelist tid mbPrefix filterDisabled size = liftClient $ do | otherwise = id getServiceWhitelistStatus :: - MonadClient m => + (MonadClient m) => TeamId -> ProviderId -> ServiceId -> diff --git a/services/brig/src/Brig/Provider/RPC.hs b/services/brig/src/Brig/Provider/RPC.hs index a95873c5ccd..f8abba06133 100644 --- a/services/brig/src/Brig/Provider/RPC.hs +++ b/services/brig/src/Brig/Provider/RPC.hs @@ -111,7 +111,7 @@ extReq scon ps = url = httpsUrl (sconBaseUrl scon) tok = List1.head (sconAuthTokens scon) -extHandleAll :: MonadCatch m => (SomeException -> m a) -> m a -> m a +extHandleAll :: (MonadCatch m) => (SomeException -> m a) -> m a -> m a extHandleAll f ma = catches ma diff --git a/services/brig/src/Brig/Queue/Stomp.hs b/services/brig/src/Brig/Queue/Stomp.hs index 0ec44a75f24..d6d8c3abfca 100644 --- a/services/brig/src/Brig/Queue/Stomp.hs +++ b/services/brig/src/Brig/Queue/Stomp.hs @@ -180,7 +180,7 @@ listen b q callback = ------------------------------------------------------------------------------- -- Utilities -iconv :: FromJSON a => Text -> InBound a +iconv :: (FromJSON a) => Text -> InBound a iconv queue _ _ _ bs = case Aeson.eitherDecode (BL.fromStrict bs) of Right x -> pure x @@ -188,7 +188,7 @@ iconv queue _ _ _ bs = convertError $ "Error when parsing message from STOMP queue " <> unpack queue <> ": " <> e -oconv :: ToJSON a => OutBound a +oconv :: (ToJSON a) => OutBound a oconv = pure . BL.toStrict . Aeson.encode jsonType :: MIME.Type diff --git a/services/brig/src/Brig/Team/API.hs b/services/brig/src/Brig/Team/API.hs index c488e657111..4dc9e8d5b42 100644 --- a/services/brig/src/Brig/Team/API.hs +++ b/services/brig/src/Brig/Team/API.hs @@ -102,7 +102,7 @@ servantAPI = :<|> Named @"head-team-invitations" headInvitationByEmail :<|> Named @"get-team-size" teamSizePublic -teamSizePublic :: Member GalleyAPIAccess r => UserId -> TeamId -> (Handler r) TeamSize +teamSizePublic :: (Member GalleyAPIAccess r) => UserId -> TeamId -> (Handler r) TeamSize teamSizePublic uid tid = do ensurePermissions uid tid [AddTeamMember] -- limit this to team admins to reduce risk of involuntary DOS attacks teamSize tid @@ -280,19 +280,19 @@ createInvitation' tid mUid inviteeRole mbInviterUid fromEmail body = do timeout (newInv, code) <$ sendInvitationMail inviteeEmail tid fromEmail code locale -deleteInvitation :: Member GalleyAPIAccess r => UserId -> TeamId -> InvitationId -> (Handler r) () +deleteInvitation :: (Member GalleyAPIAccess r) => UserId -> TeamId -> InvitationId -> (Handler r) () deleteInvitation uid tid iid = do ensurePermissions uid tid [AddTeamMember] lift $ wrapClient $ DB.deleteInvitation tid iid -listInvitations :: Member GalleyAPIAccess r => UserId -> TeamId -> Maybe InvitationId -> Maybe (Range 1 500 Int32) -> (Handler r) Public.InvitationList +listInvitations :: (Member GalleyAPIAccess r) => UserId -> TeamId -> Maybe InvitationId -> Maybe (Range 1 500 Int32) -> (Handler r) Public.InvitationList listInvitations uid tid start mSize = do ensurePermissions uid tid [AddTeamMember] showInvitationUrl <- lift $ liftSem $ GalleyAPIAccess.getExposeInvitationURLsToTeamAdmin tid rs <- lift $ wrapClient $ DB.lookupInvitations showInvitationUrl tid start (fromMaybe (unsafeRange 100) mSize) pure $! Public.InvitationList (DB.resultList rs) (DB.resultHasMore rs) -getInvitation :: Member GalleyAPIAccess r => UserId -> TeamId -> InvitationId -> (Handler r) (Maybe Public.Invitation) +getInvitation :: (Member GalleyAPIAccess r) => UserId -> TeamId -> InvitationId -> (Handler r) (Maybe Public.Invitation) getInvitation uid tid iid = do ensurePermissions uid tid [AddTeamMember] showInvitationUrl <- lift $ liftSem $ GalleyAPIAccess.getExposeInvitationURLsToTeamAdmin tid diff --git a/services/brig/src/Brig/Team/DB.hs b/services/brig/src/Brig/Team/DB.hs index ec22f1f6d81..b848464e30d 100644 --- a/services/brig/src/Brig/Team/DB.hs +++ b/services/brig/src/Brig/Team/DB.hs @@ -148,7 +148,7 @@ lookupInvitationByCode showUrl i = Just InvitationInfo {..} -> lookupInvitation showUrl iiTeam iiInvId _ -> pure Nothing -lookupInvitationCode :: MonadClient m => TeamId -> InvitationId -> m (Maybe InvitationCode) +lookupInvitationCode :: (MonadClient m) => TeamId -> InvitationId -> m (Maybe InvitationCode) lookupInvitationCode t r = fmap runIdentity <$> retry x1 (query1 cqlInvitationCode (params LocalQuorum (t, r))) @@ -156,7 +156,7 @@ lookupInvitationCode t r = cqlInvitationCode :: PrepQuery R (TeamId, InvitationId) (Identity InvitationCode) cqlInvitationCode = "SELECT code FROM team_invitation WHERE team = ? AND id = ?" -lookupInvitationCodeEmail :: MonadClient m => TeamId -> InvitationId -> m (Maybe (InvitationCode, Email)) +lookupInvitationCodeEmail :: (MonadClient m) => TeamId -> InvitationId -> m (Maybe (InvitationCode, Email)) lookupInvitationCodeEmail t r = retry x1 (query1 cqlInvitationCodeEmail (params LocalQuorum (t, r))) where cqlInvitationCodeEmail :: PrepQuery R (TeamId, InvitationId) (InvitationCode, Email) @@ -190,7 +190,7 @@ lookupInvitations showUrl team start (fromRange -> size) = do cqlSelectFrom :: PrepQuery R (TeamId, InvitationId) (TeamId, Maybe Role, InvitationId, UTCTimeMillis, Maybe UserId, Email, Maybe Name, Maybe Phone, InvitationCode) cqlSelectFrom = "SELECT team, role, id, created_at, created_by, email, name, phone, code FROM team_invitation WHERE team = ? AND id > ? ORDER BY id ASC" -deleteInvitation :: MonadClient m => TeamId -> InvitationId -> m () +deleteInvitation :: (MonadClient m) => TeamId -> InvitationId -> m () deleteInvitation t i = do codeEmail <- lookupInvitationCodeEmail t i case codeEmail of @@ -220,7 +220,7 @@ deleteInvitations t = cqlSelect :: PrepQuery R (Identity TeamId) (Identity InvitationId) cqlSelect = "SELECT id FROM team_invitation WHERE team = ? ORDER BY id ASC" -lookupInvitationInfo :: MonadClient m => InvitationCode -> m (Maybe InvitationInfo) +lookupInvitationInfo :: (MonadClient m) => InvitationCode -> m (Maybe InvitationInfo) lookupInvitationInfo ic@(InvitationCode c) | c == mempty = pure Nothing | otherwise = @@ -262,7 +262,7 @@ lookupInvitationInfoByEmail email = do cqlInvitationEmail :: PrepQuery R (Identity Email) (TeamId, InvitationId, InvitationCode) cqlInvitationEmail = "SELECT team, invitation, code FROM team_invitation_email WHERE email = ?" -countInvitations :: MonadClient m => TeamId -> m Int64 +countInvitations :: (MonadClient m) => TeamId -> m Int64 countInvitations t = maybe 0 runIdentity <$> retry x1 (query1 cqlSelect (params LocalQuorum (Identity t))) @@ -311,7 +311,7 @@ mkInviteUrl ShowInvitationUrl team (InvitationCode c) = do replace "code" = toText c replace x = x - parseHttpsUrl :: Log.MonadLogger m => Text -> m (Maybe (URIRef Absolute)) + parseHttpsUrl :: (Log.MonadLogger m) => Text -> m (Maybe (URIRef Absolute)) parseHttpsUrl url = either (\e -> logError url e >> pure Nothing) (pure . Just) $ parseURI laxURIParserOptions (encodeUtf8 url) diff --git a/services/brig/src/Brig/Team/Util.hs b/services/brig/src/Brig/Team/Util.hs index bf7a3d0da85..20a677b79a8 100644 --- a/services/brig/src/Brig/Team/Util.hs +++ b/services/brig/src/Brig/Team/Util.hs @@ -54,7 +54,7 @@ ensurePermissions u t perms = do -- | Privilege escalation detection (make sure no `RoleMember` user creates a `RoleOwner`). -- -- There is some code duplication with 'Galley.API.Teams.ensureNotElevated'. -ensurePermissionToAddUser :: Member GalleyAPIAccess r => UserId -> TeamId -> Permissions -> ExceptT Error (AppT r) () +ensurePermissionToAddUser :: (Member GalleyAPIAccess r) => UserId -> TeamId -> Permissions -> ExceptT Error (AppT r) () ensurePermissionToAddUser u t inviteePerms = do minviter <- lift $ liftSem $ GalleyAPIAccess.getTeamMember u t unless (check minviter) $ diff --git a/services/brig/src/Brig/User/API/Search.hs b/services/brig/src/Brig/User/API/Search.hs index 4d9ae68862c..afb00c1efd6 100644 --- a/services/brig/src/Brig/User/API/Search.hs +++ b/services/brig/src/Brig/User/API/Search.hs @@ -175,7 +175,7 @@ searchLocally searcherId searchTerm maybeMaxResults = do <$$> HandleAPI.getLocalHandleInfo lsearcherId handle teamUserSearch :: - Member GalleyAPIAccess r => + (Member GalleyAPIAccess r) => UserId -> TeamId -> Maybe Text -> diff --git a/services/brig/src/Brig/User/Auth.hs b/services/brig/src/Brig/User/Auth.hs index 12447d3e336..1ec0faa86e4 100644 --- a/services/brig/src/Brig/User/Auth.hs +++ b/services/brig/src/Brig/User/Auth.hs @@ -58,7 +58,6 @@ import Brig.ZAuth qualified as ZAuth import Cassandra import Control.Error hiding (bool) import Control.Lens (to, view) -import Control.Monad.Except import Data.ByteString.Conversion (toByteString) import Data.Handle (Handle) import Data.Id @@ -119,7 +118,7 @@ sendLoginCode phone call force = do pure c lookupLoginCode :: - Member TinyLog r => + (Member TinyLog r) => Phone -> AppT r (Maybe PendingLoginCode) lookupLoginCode phone = @@ -175,7 +174,7 @@ login (SmsLogin (SmsLoginData phone code label)) typ = do verifyCode :: forall r. - Member GalleyAPIAccess r => + (Member GalleyAPIAccess r) => Maybe Code.Value -> VerificationAction -> UserId -> @@ -215,7 +214,7 @@ checkRetryLimit :: (MonadClient m, MonadReader Env m) => UserId -> ExceptT Login checkRetryLimit = withRetryLimit checkBudget withRetryLimit :: - MonadReader Env m => + (MonadReader Env m) => (BudgetKey -> Budget -> ExceptT LoginError m (Budgeted ())) -> UserId -> ExceptT LoginError m () @@ -300,7 +299,7 @@ catchSuspendInactiveUser uid errval = do lift $ runExceptT (changeSingleAccountStatus uid Suspended) >>= explicitlyIgnoreErrors throwE errval where - explicitlyIgnoreErrors :: Monad m => Either AccountStatusError () -> m () + explicitlyIgnoreErrors :: (Monad m) => Either AccountStatusError () -> m () explicitlyIgnoreErrors = \case Left InvalidAccountStatus -> pure () Left AccountNotFound -> pure () @@ -402,7 +401,7 @@ validateTokens uts at = do where -- FUTUREWORK: There is surely a better way to do this getFirstSuccessOrFirstFail :: - Monad m => + (Monad m) => List1 (Either ZAuth.Failure (UserId, Cookie (ZAuth.Token u))) -> ExceptT ZAuth.Failure m (UserId, Cookie (ZAuth.Token u)) getFirstSuccessOrFirstFail tks = case (lefts $ NE.toList $ List1.toNonEmpty tks, rights $ NE.toList $ List1.toNonEmpty tks) of @@ -479,7 +478,7 @@ legalHoldLogin (LegalHoldLogin uid pw label) typ = do !>> LegalHoldLoginError assertLegalHoldEnabled :: - Member GalleyAPIAccess r => + (Member GalleyAPIAccess r) => TeamId -> ExceptT LegalHoldLoginError (AppT r) () assertLegalHoldEnabled tid = do @@ -488,6 +487,6 @@ assertLegalHoldEnabled tid = do FeatureStatusDisabled -> throwE LegalHoldLoginLegalHoldNotEnabled FeatureStatusEnabled -> pure () -checkClientId :: MonadClient m => UserId -> ClientId -> ExceptT ZAuth.Failure m () +checkClientId :: (MonadClient m) => UserId -> ClientId -> ExceptT ZAuth.Failure m () checkClientId uid cid = lookupClient uid cid >>= maybe (throwE ZAuth.Invalid) (const (pure ())) diff --git a/services/brig/src/Brig/User/Auth/Cookie.hs b/services/brig/src/Brig/User/Auth/Cookie.hs index ebed216d947..5eeacc27ed3 100644 --- a/services/brig/src/Brig/User/Auth/Cookie.hs +++ b/services/brig/src/Brig/User/Auth/Cookie.hs @@ -214,16 +214,16 @@ lookupCookie t = do where setToken c = c {cookieValue = t} -listCookies :: MonadClient m => UserId -> [CookieLabel] -> m [Cookie ()] +listCookies :: (MonadClient m) => UserId -> [CookieLabel] -> m [Cookie ()] listCookies u [] = DB.listCookies u listCookies u ll = filter byLabel <$> DB.listCookies u where byLabel c = maybe False (`elem` ll) (cookieLabel c) -revokeAllCookies :: MonadClient m => UserId -> m () +revokeAllCookies :: (MonadClient m) => UserId -> m () revokeAllCookies u = revokeCookies u [] [] -revokeCookies :: MonadClient m => UserId -> [CookieId] -> [CookieLabel] -> m () +revokeCookies :: (MonadClient m) => UserId -> [CookieId] -> [CookieLabel] -> m () revokeCookies u [] [] = DB.deleteAllCookies u revokeCookies u ids labels = do cc <- filter matching <$> DB.listCookies u diff --git a/services/brig/src/Brig/User/Auth/DB/Cookie.hs b/services/brig/src/Brig/User/Auth/DB/Cookie.hs index c0d43ef2341..b4198bc0e98 100644 --- a/services/brig/src/Brig/User/Auth/DB/Cookie.hs +++ b/services/brig/src/Brig/User/Auth/DB/Cookie.hs @@ -29,7 +29,7 @@ import Wire.API.User.Auth newtype TTL = TTL {ttlSeconds :: Int32} deriving (Cql) -insertCookie :: MonadClient m => UserId -> Cookie a -> Maybe TTL -> m () +insertCookie :: (MonadClient m) => UserId -> Cookie a -> Maybe TTL -> m () insertCookie u ck ttl = let i = cookieId ck x = cookieExpires ck @@ -45,7 +45,7 @@ insertCookie u ck ttl = "INSERT INTO user_cookies (user, expires, id, type, created, label, succ_id) \ \VALUES (?, ?, ?, ?, ?, ?, ?) USING TTL ?" -lookupCookie :: MonadClient m => UserId -> UTCTime -> CookieId -> m (Maybe (Cookie ())) +lookupCookie :: (MonadClient m) => UserId -> UTCTime -> CookieId -> m (Maybe (Cookie ())) lookupCookie u t c = fmap mkCookie <$> retry x1 (query1 cql (params LocalQuorum (u, t, c))) where @@ -65,7 +65,7 @@ lookupCookie u t c = \FROM user_cookies \ \WHERE user = ? AND expires = ? AND id = ?" -listCookies :: MonadClient m => UserId -> m [Cookie ()] +listCookies :: (MonadClient m) => UserId -> m [Cookie ()] listCookies u = map toCookie <$> retry x1 (query cql (params LocalQuorum (Identity u))) where @@ -87,7 +87,7 @@ listCookies u = cookieValue = () } -deleteCookies :: MonadClient m => UserId -> [Cookie a] -> m () +deleteCookies :: (MonadClient m) => UserId -> [Cookie a] -> m () deleteCookies u cs = retry x5 . batch $ do setType BatchUnLogged setConsistency LocalQuorum @@ -96,7 +96,7 @@ deleteCookies u cs = retry x5 . batch $ do cql :: PrepQuery W (UserId, UTCTime, CookieId) () cql = "DELETE FROM user_cookies WHERE user = ? AND expires = ? AND id = ?" -deleteAllCookies :: MonadClient m => UserId -> m () +deleteAllCookies :: (MonadClient m) => UserId -> m () deleteAllCookies u = retry x5 (write cql (params LocalQuorum (Identity u))) where cql :: PrepQuery W (Identity UserId) () diff --git a/services/brig/src/Brig/User/Search/Index.hs b/services/brig/src/Brig/User/Search/Index.hs index b9c098eb4c4..a02cb3b192e 100644 --- a/services/brig/src/Brig/User/Search/Index.hs +++ b/services/brig/src/Brig/User/Search/Index.hs @@ -132,10 +132,10 @@ newtype IndexIO a = IndexIO (ReaderT IndexEnv IO a) MonadMonitor ) -runIndexIO :: MonadIO m => IndexEnv -> IndexIO a -> m a +runIndexIO :: (MonadIO m) => IndexEnv -> IndexIO a -> m a runIndexIO e (IndexIO m) = liftIO $ runReaderT m e -class MonadIO m => MonadIndexIO m where +class (MonadIO m) => MonadIndexIO m where liftIndexIO :: IndexIO a -> m a instance MonadIndexIO IndexIO where @@ -233,7 +233,7 @@ updateIndex (IndexUpdateUsers updateType ius) = liftIndexIO $ do creds <- asks idxCredentials pure $ maybe [] ((: []) . mkBasicAuthHeader) creds - encodeJSONToString :: ToJSON a => a -> Builder + encodeJSONToString :: (ToJSON a) => a -> Builder encodeJSONToString = fromEncoding . toEncoding bulkEncode iu = bulkMeta (view (iuUserId . re _TextId) iu) (docVersion (_iuVersion iu)) @@ -296,25 +296,25 @@ updateSearchVisibilityInbound status = liftIndexIO $ do -------------------------------------------------------------------------------- -- Administrative -refreshIndex :: MonadIndexIO m => m () +refreshIndex :: (MonadIndexIO m) => m () refreshIndex = liftIndexIO $ do idx <- asks idxName void $ ES.refreshIndex idx createIndexIfNotPresent :: - MonadIndexIO m => + (MonadIndexIO m) => CreateIndexSettings -> m () createIndexIfNotPresent = createIndex' False createIndex :: - MonadIndexIO m => + (MonadIndexIO m) => CreateIndexSettings -> m () createIndex = createIndex' True createIndex' :: - MonadIndexIO m => + (MonadIndexIO m) => -- | Fail if index alredy exists Bool -> CreateIndexSettings -> @@ -368,7 +368,7 @@ analysisSettings = ] in ES.Analysis analyzerDef mempty filterDef mempty -updateMapping :: MonadIndexIO m => m () +updateMapping :: (MonadIndexIO m) => m () updateMapping = liftIndexIO $ do idx <- asks idxName ex <- ES.indexExists idx @@ -382,7 +382,7 @@ updateMapping = liftIndexIO $ do ES.putMapping idx (ES.MappingName "user") indexMapping resetIndex :: - MonadIndexIO m => + (MonadIndexIO m) => CreateIndexSettings -> m () resetIndex ciSettings = liftIndexIO $ do @@ -433,7 +433,7 @@ indexUpdateToVersionControl :: IndexDocUpdateType -> (ES.ExternalDocVersion -> E indexUpdateToVersionControl IndexUpdateIfNewerVersion = ES.ExternalGT indexUpdateToVersionControl IndexUpdateIfSameOrNewerVersion = ES.ExternalGTE -traceES :: MonadIndexIO m => ByteString -> IndexIO ES.Reply -> m ES.Reply +traceES :: (MonadIndexIO m) => ByteString -> IndexIO ES.Reply -> m ES.Reply traceES descr act = liftIndexIO $ do info (msg descr) r <- act @@ -810,7 +810,7 @@ type ReindexRow = teamInReindexRow :: ReindexRow -> Maybe TeamId teamInReindexRow (_f1, f2, _f3, _f4, _f5, _f6, _f7, _f8, _f9, _f10, _f11, _f12, _f13, _f14, _f15, _f16, _f17, _f18, _f19, _f20, _f21, _f22) = f2 -reindexRowToIndexUser :: forall m. MonadThrow m => ReindexRow -> SearchVisibilityInbound -> m IndexUser +reindexRowToIndexUser :: forall m. (MonadThrow m) => ReindexRow -> SearchVisibilityInbound -> m IndexUser reindexRowToIndexUser ( u, mteam, diff --git a/services/brig/src/Brig/User/Search/SearchIndex.hs b/services/brig/src/Brig/User/Search/SearchIndex.hs index d9803fff6b5..82b76637976 100644 --- a/services/brig/src/Brig/User/Search/SearchIndex.hs +++ b/services/brig/src/Brig/User/Search/SearchIndex.hs @@ -29,7 +29,6 @@ import Brig.Types.Search import Brig.User.Search.Index import Control.Lens hiding (setting, (#), (.=)) import Control.Monad.Catch (MonadThrow, throwM) -import Control.Monad.Except import Data.Domain (Domain) import Data.Handle (Handle (fromHandle)) import Data.Id @@ -91,7 +90,7 @@ queryIndex (IndexQuery q f _) s = do searchHasMore = Nothing } -userDocToContact :: MonadThrow m => Domain -> UserDoc -> m Contact +userDocToContact :: (MonadThrow m) => Domain -> UserDoc -> m Contact userDocToContact localDomain UserDoc {..} = do let contactQualifiedId = Qualified udId localDomain contactName <- maybe (throwM $ IndexError "Name not found") (pure . fromName) udName @@ -149,8 +148,9 @@ mkUserQuery :: SearchSetting -> ES.Query -> IndexQuery Contact mkUserQuery setting q = IndexQuery q - ( ES.Filter . ES.QueryBoolQuery $ - boolQuery + ( ES.Filter + . ES.QueryBoolQuery + $ boolQuery { ES.boolQueryMustNotMatch = maybeToList $ matchSelf setting, ES.boolQueryMustMatch = [ restrictSearchSpace setting, diff --git a/services/brig/src/Brig/User/Search/TeamSize.hs b/services/brig/src/Brig/User/Search/TeamSize.hs index 1fd23bbf1c3..dce653ab03b 100644 --- a/services/brig/src/Brig/User/Search/TeamSize.hs +++ b/services/brig/src/Brig/User/Search/TeamSize.hs @@ -29,7 +29,7 @@ import Data.Id import Database.Bloodhound qualified as ES import Imports hiding (log, searchable) -teamSize :: MonadIndexIO m => TeamId -> m TeamSize +teamSize :: (MonadIndexIO m) => TeamId -> m TeamSize teamSize t = liftIndexIO $ do indexName <- asks idxName countResEither <- ES.countByIndex indexName (ES.CountQuery query) diff --git a/services/brig/src/Brig/ZAuth.hs b/services/brig/src/Brig/ZAuth.hs index 14e714bd331..9eaf2cba30a 100644 --- a/services/brig/src/Brig/ZAuth.hs +++ b/services/brig/src/Brig/ZAuth.hs @@ -110,13 +110,13 @@ import Wire.API.User.Auth qualified as Auth newtype ZAuth a = ZAuth {unZAuth :: ReaderT Env IO a} deriving (Functor, Applicative, Monad, MonadIO, MonadReader Env) -class MonadIO m => MonadZAuth m where +class (MonadIO m) => MonadZAuth m where liftZAuth :: ZAuth a -> m a instance MonadZAuth ZAuth where liftZAuth = id -runZAuth :: MonadIO m => Env -> ZAuth a -> m a +runZAuth :: (MonadIO m) => Env -> ZAuth a -> m a runZAuth e za = liftIO $ runReaderT (unZAuth za) e data Settings = Settings @@ -217,7 +217,7 @@ makeLenses ''Env localSettings :: (Settings -> Settings) -> ZAuth a -> ZAuth a localSettings f za = ZAuth (local (over settings f) (unZAuth za)) -readKeys :: Read k => FilePath -> IO (Maybe (NonEmpty k)) +readKeys :: (Read k) => FilePath -> IO (Maybe (NonEmpty k)) readKeys fp = nonEmpty . map read . filter (not . null) . lines <$> readFile fp mkEnv :: NonEmpty SecretKey -> NonEmpty PublicKey -> Settings -> IO Env @@ -227,7 +227,7 @@ mkEnv sk pk sets = do pure $! Env zc zv sets class (UserTokenLike u, AccessTokenLike a) => TokenPair u a where - newAccessToken :: MonadZAuth m => Token u -> m (Token a) + newAccessToken :: (MonadZAuth m) => Token u -> m (Token a) instance TokenPair User Access where newAccessToken = newAccessToken' @@ -238,7 +238,7 @@ instance TokenPair LegalHoldUser LegalHoldAccess where class (FromByteString (Token a), ToByteString a) => AccessTokenLike a where accessTokenOf :: Token a -> UserId accessTokenClient :: Token a -> Maybe ClientId - renewAccessToken :: MonadZAuth m => Maybe ClientId -> Token a -> m (Token a) + renewAccessToken :: (MonadZAuth m) => Maybe ClientId -> Token a -> m (Token a) settingsTTL :: Proxy a -> Lens' Settings Integer instance AccessTokenLike Access where @@ -257,9 +257,9 @@ class (FromByteString (Token u), ToByteString u) => UserTokenLike u where userTokenOf :: Token u -> UserId userTokenClient :: Token u -> Maybe ClientId mkSomeToken :: Token u -> Auth.SomeUserToken - mkUserToken :: MonadZAuth m => UserId -> Maybe ClientId -> Word32 -> UTCTime -> m (Token u) + mkUserToken :: (MonadZAuth m) => UserId -> Maybe ClientId -> Word32 -> UTCTime -> m (Token u) userTokenRand :: Token u -> Word32 - newUserToken :: MonadZAuth m => UserId -> Maybe ClientId -> m (Token u) + newUserToken :: (MonadZAuth m) => UserId -> Maybe ClientId -> m (Token u) newSessionToken :: (MonadThrow m, MonadZAuth m) => UserId -> Maybe ClientId -> m (Token u) userTTL :: Proxy u -> Lens' Settings Integer zauthType :: Type -- see libs/zauth/src/Token.hs @@ -286,14 +286,14 @@ instance UserTokenLike LegalHoldUser where userTTL _ = legalHoldUserTokenTimeout . legalHoldUserTokenTimeoutSeconds zauthType = LU -mkUserToken' :: MonadZAuth m => UserId -> Maybe ClientId -> Word32 -> UTCTime -> m (Token User) +mkUserToken' :: (MonadZAuth m) => UserId -> Maybe ClientId -> Word32 -> UTCTime -> m (Token User) mkUserToken' u cid r t = liftZAuth $ do z <- ask liftIO $ ZC.runCreate (z ^. private) (z ^. settings . keyIndex) $ ZC.newToken (utcTimeToPOSIXSeconds t) U Nothing (mkUser (toUUID u) (fmap clientToText cid) r) -newUserToken' :: MonadZAuth m => UserId -> Maybe ClientId -> m (Token User) +newUserToken' :: (MonadZAuth m) => UserId -> Maybe ClientId -> m (Token User) newUserToken' u c = liftZAuth $ do z <- ask r <- liftIO randomValue @@ -302,7 +302,7 @@ newUserToken' u c = liftZAuth $ do let UserTokenTimeout ttl = z ^. settings . userTokenTimeout in ZC.userToken ttl (toUUID u) (fmap clientToText c) r -newSessionToken' :: MonadZAuth m => UserId -> Maybe ClientId -> m (Token User) +newSessionToken' :: (MonadZAuth m) => UserId -> Maybe ClientId -> m (Token User) newSessionToken' u c = liftZAuth $ do z <- ask r <- liftIO randomValue @@ -311,7 +311,7 @@ newSessionToken' u c = liftZAuth $ do let SessionTokenTimeout ttl = z ^. settings . sessionTokenTimeout in ZC.sessionToken ttl (toUUID u) (fmap clientToText c) r -newAccessToken' :: MonadZAuth m => Token User -> m (Token Access) +newAccessToken' :: (MonadZAuth m) => Token User -> m (Token Access) newAccessToken' xt = liftZAuth $ do z <- ask liftIO $ @@ -319,7 +319,7 @@ newAccessToken' xt = liftZAuth $ do let AccessTokenTimeout ttl = z ^. settings . accessTokenTimeout in ZC.accessToken1 ttl (xt ^. body . user) (xt ^. body . client) -renewAccessToken' :: MonadZAuth m => Maybe ClientId -> Token Access -> m (Token Access) +renewAccessToken' :: (MonadZAuth m) => Maybe ClientId -> Token Access -> m (Token Access) renewAccessToken' mcid old = liftZAuth $ do z <- ask liftIO $ @@ -333,14 +333,14 @@ renewAccessToken' mcid old = liftZAuth $ do $ (old ^. body) ) -newBotToken :: MonadZAuth m => ProviderId -> BotId -> ConvId -> m (Token Bot) +newBotToken :: (MonadZAuth m) => ProviderId -> BotId -> ConvId -> m (Token Bot) newBotToken pid bid cid = liftZAuth $ do z <- ask liftIO $ ZC.runCreate (z ^. private) (z ^. settings . keyIndex) $ ZC.botToken (toUUID pid) (toUUID (botUserId bid)) (toUUID cid) -newProviderToken :: MonadZAuth m => ProviderId -> m (Token Provider) +newProviderToken :: (MonadZAuth m) => ProviderId -> m (Token Provider) newProviderToken pid = liftZAuth $ do z <- ask liftIO $ @@ -355,7 +355,7 @@ newProviderToken pid = liftZAuth $ do -- Possibly some duplication could be removed. -- See https://github.com/wireapp/wire-server/pull/761/files#r318612423 mkLegalHoldUserToken :: - MonadZAuth m => + (MonadZAuth m) => UserId -> Maybe ClientId -> Word32 -> @@ -371,7 +371,7 @@ mkLegalHoldUserToken u c r t = liftZAuth $ do Nothing (mkLegalHoldUser (toUUID u) (fmap clientToText c) r) -newLegalHoldUserToken :: MonadZAuth m => UserId -> Maybe ClientId -> m (Token LegalHoldUser) +newLegalHoldUserToken :: (MonadZAuth m) => UserId -> Maybe ClientId -> m (Token LegalHoldUser) newLegalHoldUserToken u c = liftZAuth $ do z <- ask r <- liftIO randomValue @@ -380,7 +380,7 @@ newLegalHoldUserToken u c = liftZAuth $ do let LegalHoldUserTokenTimeout ttl = z ^. settings . legalHoldUserTokenTimeout in ZC.legalHoldUserToken ttl (toUUID u) (fmap clientToText c) r -newLegalHoldAccessToken :: MonadZAuth m => Token LegalHoldUser -> m (Token LegalHoldAccess) +newLegalHoldAccessToken :: (MonadZAuth m) => Token LegalHoldUser -> m (Token LegalHoldAccess) newLegalHoldAccessToken xt = liftZAuth $ do z <- ask liftIO $ @@ -392,7 +392,7 @@ newLegalHoldAccessToken xt = liftZAuth $ do (xt ^. body . legalHoldUser . client) renewLegalHoldAccessToken :: - MonadZAuth m => + (MonadZAuth m) => Maybe ClientId -> Token LegalHoldAccess -> m (Token LegalHoldAccess) diff --git a/services/brig/test/integration/API/Calling.hs b/services/brig/test/integration/API/Calling.hs index c8008d01cb6..442dcfca55b 100644 --- a/services/brig/test/integration/API/Calling.hs +++ b/services/brig/test/integration/API/Calling.hs @@ -125,7 +125,7 @@ testSFTUnavailable b opts domain = do (cfg ^. rtcConfSftServersAll) modifyAndAssert :: - HasCallStack => + (HasCallStack) => Brig -> UserId -> (UserId -> Brig -> Http RTCConfiguration) -> @@ -212,7 +212,7 @@ testCallsConfigV2SRV b opts = do ] ) -assertConfiguration :: HasCallStack => RTCConfiguration -> NonEmpty TurnURI -> Http () +assertConfiguration :: (HasCallStack) => RTCConfiguration -> NonEmpty TurnURI -> Http () assertConfiguration cfg expected = do let actual = concatMap (toList . view iceURLs) $ toList $ cfg ^. rtcConfIceServers liftIO $ assertEqual "Expected adverstised TURN servers to match actual ones" (sort $ toList expected) (sort actual) @@ -220,10 +220,10 @@ assertConfiguration cfg expected = do getTurnConfigurationV1 :: UserId -> Brig -> Http RTCConfiguration getTurnConfigurationV1 = getAndValidateTurnConfiguration "" -getTurnConfigurationV2 :: HasCallStack => UserId -> Brig -> ((MonadHttp m, MonadIO m, MonadCatch m) => m RTCConfiguration) +getTurnConfigurationV2 :: (HasCallStack) => UserId -> Brig -> ((MonadHttp m, MonadIO m, MonadCatch m) => m RTCConfiguration) getTurnConfigurationV2 = getAndValidateTurnConfiguration "v2" -getTurnConfiguration :: ByteString -> UserId -> Brig -> (MonadHttp m => m (Response (Maybe LB.ByteString))) +getTurnConfiguration :: ByteString -> UserId -> Brig -> ((MonadHttp m) => m (Response (Maybe LB.ByteString))) getTurnConfiguration suffix u b = get ( b @@ -232,7 +232,7 @@ getTurnConfiguration suffix u b = . zConn "conn" ) -getAndValidateTurnConfiguration :: HasCallStack => ByteString -> UserId -> Brig -> ((MonadIO m, MonadHttp m, MonadCatch m) => m RTCConfiguration) +getAndValidateTurnConfiguration :: (HasCallStack) => ByteString -> UserId -> Brig -> ((MonadIO m, MonadHttp m, MonadCatch m) => m RTCConfiguration) getAndValidateTurnConfiguration suffix u b = responseJsonError =<< (getTurnConfiguration suffix u b Int -> UserId -> Brig -> Http RTCConfiguration +getAndValidateTurnConfigurationLimit :: (HasCallStack) => Int -> UserId -> Brig -> Http RTCConfiguration getAndValidateTurnConfigurationLimit limit u b = responseJsonError =<< (getTurnConfigurationV2Limit limit u b Domain -> Either Handle Name -> Maybe (Qualified UserId) -> FederatedUserSearchPolicy -> WaiTest.Session () + let expectSearch :: (HasCallStack) => Domain -> Either Handle Name -> Maybe (Qualified UserId) -> FederatedUserSearchPolicy -> WaiTest.Session () expectSearch domain handleOrName mExpectedUser expectedSearchPolicy = do let squery = either fromHandle fromName handleOrName searchResponse <- diff --git a/services/brig/test/integration/API/MLS/Util.hs b/services/brig/test/integration/API/MLS/Util.hs index c2725fd0a3d..445ca6875fb 100644 --- a/services/brig/test/integration/API/MLS/Util.hs +++ b/services/brig/test/integration/API/MLS/Util.hs @@ -57,8 +57,8 @@ cliCmd tmp qcid cmnds = ["--store", tmp (show qcid <> ".db")] <> cmnds initStore :: - HasCallStack => - MonadIO m => + (HasCallStack) => + (MonadIO m) => FilePath -> ClientIdentity -> m () @@ -67,8 +67,8 @@ initStore tmp qcid = do cliCmd tmp qcid ["init", show qcid] generateKeyPackage :: - HasCallStack => - MonadIO m => + (HasCallStack) => + (MonadIO m) => FilePath -> ClientIdentity -> Maybe Timeout -> @@ -84,7 +84,7 @@ generateKeyPackage tmp qcid lifetime = do pure (kp, ref) uploadKeyPackages :: - HasCallStack => + (HasCallStack) => Brig -> FilePath -> KeyingInfo -> @@ -119,7 +119,7 @@ uploadKeyPackages brig tmp KeyingInfo {..} u c n = do !!! const (case kiSetKey of SetKey -> 201; DontSetKey -> 400) === statusCode -getKeyPackageCount :: HasCallStack => Brig -> Qualified UserId -> ClientId -> Http KeyPackageCount +getKeyPackageCount :: (HasCallStack) => Brig -> Qualified UserId -> ClientId -> Http KeyPackageCount getKeyPackageCount brig u c = responseJsonError =<< get @@ -130,7 +130,7 @@ getKeyPackageCount brig u c = ByteString -> IO a +decodeMLSError :: (ParseMLS a) => ByteString -> IO a decodeMLSError s = case decodeMLS' s of Left e -> assertFailure ("Could not parse MLS object: " <> Text.unpack e) Right x -> pure x diff --git a/services/brig/test/integration/API/OAuth.hs b/services/brig/test/integration/API/OAuth.hs index cd08aae8317..3b3eba50b38 100644 --- a/services/brig/test/integration/API/OAuth.hs +++ b/services/brig/test/integration/API/OAuth.hs @@ -472,7 +472,7 @@ testRefreshTokenMaxActiveTokens opts db brig = tokens <- C.runClient db (lookupOAuthRefreshTokens uid) liftIO $ assertBool testMsg $ [rid3, rid] `hasSameElems` (refreshTokenId <$> tokens) where - extractRefreshTokenId :: MonadIO m => JWK -> OAuthRefreshToken -> m OAuthRefreshTokenId + extractRefreshTokenId :: (MonadIO m) => JWK -> OAuthRefreshToken -> m OAuthRefreshTokenId extractRefreshTokenId jwk rt = do fromMaybe (error "invalid sub") . hcsSub <$> liftIO (verifyRefreshToken jwk (unOAuthToken rt)) @@ -732,10 +732,10 @@ verifyRefreshToken jwk jwt = fromRight (error "invalid jwt or jwk") <$> runJOSE (verifyClaims (defaultJWTValidationSettings (const True)) jwk jwt :: JOSE JWTError IO ClaimsSet) -authHeader :: ToHttpApiData a => a -> Request -> Request +authHeader :: (ToHttpApiData a) => a -> Request -> Request authHeader = bearer "Authorization" -bearer :: ToHttpApiData a => HeaderName -> a -> Request -> Request +bearer :: (ToHttpApiData a) => HeaderName -> a -> Request -> Request bearer name = header name . toHeader . Bearer newOAuthClientRequestBody :: Text -> Text -> OAuthClientConfig @@ -845,7 +845,7 @@ mkUrl = fromMaybe (error "invalid url") . fromByteString revokeOAuthRefreshToken :: (MonadHttp m) => Brig -> OAuthRevokeRefreshTokenRequest -> m ResponseLBS revokeOAuthRefreshToken brig req = post (brig . paths ["oauth", "revoke"] . json req) -instance ToHttpApiData a => ToHttpApiData (Bearer a) where +instance (ToHttpApiData a) => ToHttpApiData (Bearer a) where toHeader = (<>) "Bearer " . toHeader . unBearer toUrlPiece = T.decodeUtf8 . toHeader diff --git a/services/brig/test/integration/API/Provider.hs b/services/brig/test/integration/API/Provider.hs index 0d4bf057042..f3a0873d447 100644 --- a/services/brig/test/integration/API/Provider.hs +++ b/services/brig/test/integration/API/Provider.hs @@ -465,7 +465,7 @@ testListServices config db brig = do -- This is how we're going to call our /services endpoint. Every time we -- would call it twice (with tags and without) and assert that results -- match. - let search :: HasCallStack => Name -> Http ServiceProfilePage + let search :: (HasCallStack) => Name -> Http ServiceProfilePage search name = do r1 <- searchServices brig 20 uid (Just name) Nothing r2 <- searchServices brig 20 uid (Just name) (Just (match1 SocialTag)) @@ -480,7 +480,7 @@ testListServices config db brig = do pure r1 -- This function searches for a prefix and check that the results match -- our known list of services - let searchAndCheck :: HasCallStack => Name -> Http [ServiceProfile] + let searchAndCheck :: (HasCallStack) => Name -> Http [ServiceProfile] searchAndCheck name = do result <- search name assertServiceDetails ("name " <> show name) (select name services) result @@ -923,7 +923,7 @@ testSearchWhitelist config db brig galley = do -- endpoint. Every time we call it twice (with filter_disabled=false and -- without) and assert that results match – which should always be the -- case since in this test we won't have any disabled services. - let search :: HasCallStack => Maybe Text -> Http ServiceProfilePage + let search :: (HasCallStack) => Maybe Text -> Http ServiceProfilePage search mbName = do r1 <- searchServiceWhitelist brig 20 uid tid mbName r2 <- searchServiceWhitelistAll brig 20 uid tid mbName @@ -950,7 +950,7 @@ testSearchWhitelist config db brig galley = do liftIO $ assertEqual "has more" True (serviceProfilePageHasMore page) -- This function searches for a prefix and check that the results match -- our known list of services - let searchAndCheck :: HasCallStack => Name -> Http [ServiceProfile] + let searchAndCheck :: (HasCallStack) => Name -> Http [ServiceProfile] searchAndCheck (Name name) = do result <- search (Just name) assertServiceDetails ("name " <> show name) (select name services) result @@ -1646,7 +1646,7 @@ getUserClients brig bid uid = -------------------------------------------------------------------------------- -- DB Operations -lookupCode :: MonadIO m => DB.ClientState -> Code.Gen -> Code.Scope -> m (Maybe Code.Code) +lookupCode :: (MonadIO m) => DB.ClientState -> Code.Gen -> Code.Scope -> m (Maybe Code.Code) lookupCode db gen = liftIO . DB.runClient db . Code.lookup (Code.genKey gen) -------------------------------------------------------------------------------- @@ -1710,7 +1710,7 @@ testRegisterProvider db' brig = do assertEqual "description" defProviderDescr (providerDescr p) assertEqual "profile" (ProviderProfile p) pp -randomProvider :: HasCallStack => DB.ClientState -> Brig -> Http Provider +randomProvider :: (HasCallStack) => DB.ClientState -> Brig -> Http Provider randomProvider db brig = do email <- randomEmail gen <- Code.mkGen (Code.ForEmail email) @@ -1729,7 +1729,7 @@ randomProvider db brig = do let Just prv = responseJsonMaybe _rs pure prv -addGetService :: HasCallStack => Brig -> ProviderId -> NewService -> Http Service +addGetService :: (HasCallStack) => Brig -> ProviderId -> NewService -> Http Service addGetService brig pid new = do _rs <- addService brig pid new Brig -> ProviderId -> ServiceId -> Http () +enableService :: (HasCallStack) => Brig -> ProviderId -> ServiceId -> Http () enableService brig pid sid = do let upd = (mkUpdateServiceConn defProviderPassword) @@ -1747,7 +1747,7 @@ enableService brig pid sid = do updateServiceConn brig pid sid upd !!! const 200 === statusCode -disableService :: HasCallStack => Brig -> ProviderId -> ServiceId -> Http () +disableService :: (HasCallStack) => Brig -> ProviderId -> ServiceId -> Http () disableService brig pid sid = do let upd = (mkUpdateServiceConn defProviderPassword) @@ -1757,7 +1757,7 @@ disableService brig pid sid = do !!! const 200 === statusCode whitelistServiceNginz :: - HasCallStack => + (HasCallStack) => Nginz -> -- | Team owner User -> @@ -1787,7 +1787,7 @@ updateServiceWhitelistNginz nginz user tid upd = do . body (RequestBodyLBS (encode upd)) whitelistService :: - HasCallStack => + (HasCallStack) => Brig -> -- | Team owner UserId -> @@ -1803,7 +1803,7 @@ whitelistService brig uid tid pid sid = const 200 === statusCode dewhitelistService :: - HasCallStack => + (HasCallStack) => Brig -> -- | Team owner UserId -> @@ -1818,7 +1818,7 @@ dewhitelistService brig uid tid pid sid = -- TODO: allow both 200 and 204 here and use it in 'testWhitelistEvents' const 200 === statusCode -defNewService :: MonadIO m => Config -> m NewService +defNewService :: (MonadIO m) => Config -> m NewService defNewService config = liftIO $ do key <- readServiceKey (publicKey config) pure @@ -1879,32 +1879,32 @@ defServiceAssets = -- TODO: defServiceToken :: ServiceToken -readServiceKey :: MonadIO m => FilePath -> m ServiceKeyPEM +readServiceKey :: (MonadIO m) => FilePath -> m ServiceKeyPEM readServiceKey fp = liftIO $ do bs <- BS.readFile fp let Right [k] = pemParseBS bs pure (ServiceKeyPEM k) -randServiceKey :: MonadIO m => m ServiceKeyPEM +randServiceKey :: (MonadIO m) => m ServiceKeyPEM randServiceKey = liftIO $ do kp <- generateRSAKey' 4096 65537 Right [k] <- pemParseBS . C8.pack <$> writePublicKey kp pure (ServiceKeyPEM k) -waitFor :: MonadIO m => Timeout -> (a -> Bool) -> m a -> m a +waitFor :: (MonadIO m) => Timeout -> (a -> Bool) -> m a -> m a waitFor t f ma = do a <- ma if - | f a -> pure a - | t <= 0 -> liftIO $ throwM TimedOut - | otherwise -> do - liftIO $ threadDelay (1 # Second) - waitFor (t - 1 # Second) f ma + | f a -> pure a + | t <= 0 -> liftIO $ throwM TimedOut + | otherwise -> do + liftIO $ threadDelay (1 # Second) + waitFor (t - 1 # Second) f ma withFreePortAnyAddr :: (MonadMask m, MonadIO m) => ((Warp.Port, Socket) -> m a) -> m a withFreePortAnyAddr = bracket openFreePortAnyAddr (liftIO . Socket.close . snd) -openFreePortAnyAddr :: MonadIO m => m (Warp.Port, Socket) +openFreePortAnyAddr :: (MonadIO m) => m (Warp.Port, Socket) openFreePortAnyAddr = liftIO $ bindRandomPortTCP "*" -- | Run a test case with an external service application. @@ -2145,7 +2145,7 @@ mkMessage fromc rcps = ] where mk (u, c, m) = (text u, HashMap.singleton (text c) m) - text :: ToByteString a => a -> Text + text :: (ToByteString a) => a -> Text text = fromJust . fromByteString . toByteString' -- | A list of 20 services, all having names that begin with the given prefix. @@ -2322,7 +2322,7 @@ testMessageBotUtil quid uc cid pid sid sref buf brig galley cannon = do wsAssertMemberLeave ws qcid (tUntagged lbuid) [tUntagged lbuid] prepareBotUsersTeam :: - HasCallStack => + (HasCallStack) => Brig -> Galley -> ServiceRef -> @@ -2352,7 +2352,7 @@ testWhitelistNginz config db brig nginz = withTestService config db brig defServ whitelistServiceNginz nginz adminUser tid pid sid addBotConv :: - HasCallStack => + (HasCallStack) => Domain -> Brig -> WS.Cannon -> @@ -2389,7 +2389,7 @@ addBotConv localDomain brig cannon uid1 uid2 cid pid sid buf = do -- | Given some endpoint that can search for services by name prefix, check -- that it doesn't break when service name changes. searchAndAssertNameChange :: - HasCallStack => + (HasCallStack) => Brig -> -- | Service provider ProviderId -> @@ -2455,7 +2455,7 @@ assertServiceDetails testName expected page = liftIO $ do -- | Call the endpoint that searches through all services. searchServices :: - HasCallStack => + (HasCallStack) => Brig -> Int -> UserId -> @@ -2478,7 +2478,7 @@ searchServices brig size uid mbStart mbTags = case (mbStart, mbTags) of -- | Call the endpoint that searches through whitelisted services. searchServiceWhitelist :: - HasCallStack => + (HasCallStack) => Brig -> Int -> UserId -> @@ -2494,7 +2494,7 @@ searchServiceWhitelist brig size uid tid mbStart = -- | Call the endpoint that searches through whitelisted services, and don't -- filter out disabled services. searchServiceWhitelistAll :: - HasCallStack => + (HasCallStack) => Brig -> Int -> UserId -> diff --git a/services/brig/test/integration/API/RichInfo/Util.hs b/services/brig/test/integration/API/RichInfo/Util.hs index 896f90735b8..5dae93d4168 100644 --- a/services/brig/test/integration/API/RichInfo/Util.hs +++ b/services/brig/test/integration/API/RichInfo/Util.hs @@ -29,7 +29,7 @@ import Util import Wire.API.User.RichInfo getRichInfo :: - HasCallStack => + (HasCallStack) => Brig -> -- | The user who is performing the query UserId -> @@ -44,16 +44,16 @@ getRichInfo brig self uid = do . zUser self ) if - | statusCode r == 200 -> Right <$> responseJsonError r - | statusCode r `elem` [403, 404] -> pure . Left . statusCode $ r - | otherwise -> - error $ - "expected status code 200, 403, or 404, got: " <> show (statusCode r) + | statusCode r == 200 -> Right <$> responseJsonError r + | statusCode r `elem` [403, 404] -> pure . Left . statusCode $ r + | otherwise -> + error $ + "expected status code 200, 403, or 404, got: " <> show (statusCode r) -- | This contacts an internal end-point. Note the asymmetry between this and the external -- GET end-point in the body: here we need to wrap the 'RichInfo' in a 'RichInfoUpdate'. putRichInfo :: - HasCallStack => + (HasCallStack) => Brig -> -- | The user whose rich info is being updated UserId -> diff --git a/services/brig/test/integration/API/Search.hs b/services/brig/test/integration/API/Search.hs index 6ffe569c113..54111e832f5 100644 --- a/services/brig/test/integration/API/Search.hs +++ b/services/brig/test/integration/API/Search.hs @@ -151,7 +151,7 @@ tests opts mgr galley brig = do type TestConstraints m = (MonadFail m, MonadCatch m, MonadIO m, MonadHttp m) -testSearchWithUnvalidatedEmail :: TestConstraints m => Brig -> m () +testSearchWithUnvalidatedEmail :: (TestConstraints m) => Brig -> m () testSearchWithUnvalidatedEmail brig = do (tid, owner, user : _) <- createPopulatedBindingTeamWithNamesAndHandles brig 1 let uid = userId user @@ -180,18 +180,18 @@ testSearchWithUnvalidatedEmail brig = do assertBool "unvalidated email should be null" (isNothing . Search.teamContactEmailUnvalidated $ tc) ) where - searchAndCheckResult :: TestConstraints m => Brig -> TeamId -> UserId -> UserId -> (Search.TeamContact -> Assertion) -> m () + searchAndCheckResult :: (TestConstraints m) => Brig -> TeamId -> UserId -> UserId -> (Search.TeamContact -> Assertion) -> m () searchAndCheckResult b tid ownerId userToSearchFor assertion = executeTeamUserSearch b tid ownerId Nothing Nothing Nothing Nothing >>= checkResult userToSearchFor assertion . searchResults - checkResult :: TestConstraints m => UserId -> (Search.TeamContact -> Assertion) -> [Search.TeamContact] -> m () + checkResult :: (TestConstraints m) => UserId -> (Search.TeamContact -> Assertion) -> [Search.TeamContact] -> m () checkResult userToSearchFor assertion results = liftIO $ do let mbTeamContact = find ((==) userToSearchFor . Search.teamContactUserId) results case mbTeamContact of Nothing -> fail "no team contact found" Just teamContact -> assertion teamContact -testSearchByName :: TestConstraints m => Brig -> m () +testSearchByName :: (TestConstraints m) => Brig -> m () testSearchByName brig = do u1 <- randomUser brig u2 <- randomUser brig @@ -206,7 +206,7 @@ testSearchByName brig = do assertCan'tFind brig uid1 quid1 (fromName (userDisplayName u1)) assertCan'tFind brig uid2 quid2 (fromName (userDisplayName u2)) -testSearchByLastOrMiddleName :: TestConstraints m => Brig -> m () +testSearchByLastOrMiddleName :: (TestConstraints m) => Brig -> m () testSearchByLastOrMiddleName brig = do searcher <- userId <$> randomUser brig firstName <- randomHandle @@ -220,7 +220,7 @@ testSearchByLastOrMiddleName brig = do assertCanFind brig searcher searched lastName assertCanFind brig searcher searched (firstName <> " " <> lastName) -testSearchNonAsciiNames :: TestConstraints m => Brig -> m () +testSearchNonAsciiNames :: (TestConstraints m) => Brig -> m () testSearchNonAsciiNames brig = do searcher <- userId <$> randomUser brig suffix <- randomHandle @@ -231,7 +231,7 @@ testSearchNonAsciiNames brig = do -- This is pathetic transliteration, but it is what we have. assertCanFind brig searcher searched ("saktimana" <> suffix) -testSearchCJK :: TestConstraints m => Brig -> m () +testSearchCJK :: (TestConstraints m) => Brig -> m () testSearchCJK brig = do searcher <- randomUser brig user <- createUser' True "藤崎詩織" brig @@ -248,7 +248,7 @@ testSearchCJK brig = do assertCanFind brig (User.userId searcher) user''.userQualifiedId "ジョン" assertCanFind brig (User.userId searcher) user''.userQualifiedId "じょん" -testSearchWithUmlaut :: TestConstraints m => Brig -> m () +testSearchWithUmlaut :: (TestConstraints m) => Brig -> m () testSearchWithUmlaut brig = do searcher <- randomUser brig user <- createUser' True "Özi Müller" brig @@ -256,7 +256,7 @@ testSearchWithUmlaut brig = do assertCanFind brig (User.userId searcher) user.userQualifiedId "ozi muller" assertCanFind brig (User.userId searcher) user.userQualifiedId "Özi Müller" -testSearchByHandle :: TestConstraints m => Brig -> m () +testSearchByHandle :: (TestConstraints m) => Brig -> m () testSearchByHandle brig = do u1 <- randomUserWithHandle brig u2 <- randomUser brig @@ -266,7 +266,7 @@ testSearchByHandle brig = do Just h = fromHandle <$> userHandle u1 assertCanFind brig uid2 quid1 h -testSearchEmpty :: TestConstraints m => Brig -> m () +testSearchEmpty :: (TestConstraints m) => Brig -> m () testSearchEmpty brig = do -- This user exists just in case empty string starts matching everything _someUser <- randomUserWithHandle brig @@ -275,7 +275,7 @@ testSearchEmpty brig = do res <- searchResults <$> executeSearch brig (userId searcher) "" liftIO $ assertEqual "nothing should be returned" [] res -testSearchSize :: TestConstraints m => Brig -> Bool -> m () +testSearchSize :: (TestConstraints m) => Brig -> Bool -> m () testSearchSize brig exactHandleInTeam = do (handleMatch, searchTerm) <- if exactHandleInTeam @@ -304,7 +304,7 @@ testSearchSize brig exactHandleInTeam = do Nothing (find ((userQualifiedId handleMatch ==) . contactQualifiedId) (tail res)) -testSearchNoMatch :: TestConstraints m => Brig -> m () +testSearchNoMatch :: (TestConstraints m) => Brig -> m () testSearchNoMatch brig = do u1 <- randomUser brig _ <- randomUser brig @@ -314,7 +314,7 @@ testSearchNoMatch brig = do result <- searchResults <$> executeSearch brig uid1 "nomatch" liftIO $ assertEqual "Expected 0 results" 0 (length result) -testSearchNoExtraResults :: TestConstraints m => Brig -> m () +testSearchNoExtraResults :: (TestConstraints m) => Brig -> m () testSearchNoExtraResults brig = do u1 <- randomUser brig u2 <- randomUser brig @@ -355,7 +355,7 @@ testReindex brig = do -- See also the "cassandra writetime hypothesis": -- https://wearezeta.atlassian.net/browse/BE-523 -- https://github.com/wireapp/wire-server/pull/1798#issuecomment-933174913 -_testOrderName :: TestConstraints m => Brig -> m () +_testOrderName :: (TestConstraints m) => Brig -> m () _testOrderName brig = do searcher <- userId <$> randomUser brig Name searchedWord <- randomNameWithMaxLen 122 @@ -372,7 +372,7 @@ _testOrderName brig = do expectedOrder resultUIds -testOrderHandle :: TestConstraints m => Brig -> m () +testOrderHandle :: (TestConstraints m) => Brig -> m () testOrderHandle brig = do searcher <- userId <$> randomUser brig searchedWord <- randomHandle @@ -390,7 +390,7 @@ testOrderHandle brig = do expectedOrder resultUIds -testSearchTeamMemberAsNonMemberDisplayName :: TestConstraints m => Manager -> Brig -> Galley -> FeatureStatus -> m () +testSearchTeamMemberAsNonMemberDisplayName :: (TestConstraints m) => Manager -> Brig -> Galley -> FeatureStatus -> m () testSearchTeamMemberAsNonMemberDisplayName mgr brig galley inboundVisibility = do nonTeamMember <- randomUser brig (tid, _, [teamMember, teamBTargetReindexedAfter]) <- createPopulatedBindingTeamWithNamesAndHandles brig 2 @@ -401,7 +401,7 @@ testSearchTeamMemberAsNonMemberDisplayName mgr brig galley inboundVisibility = d assertCan'tFind brig (userId nonTeamMember) (userQualifiedId teamMember) (fromName (userDisplayName teamMember)) assertCan'tFind brig (userId nonTeamMember) (userQualifiedId teamBTargetReindexedAfter) (fromName (userDisplayName teamBTargetReindexedAfter)) -testSearchTeamMemberAsNonMemberExactHandle :: TestConstraints m => Manager -> Brig -> Galley -> FeatureStatus -> m () +testSearchTeamMemberAsNonMemberExactHandle :: (TestConstraints m) => Manager -> Brig -> Galley -> FeatureStatus -> m () testSearchTeamMemberAsNonMemberExactHandle mgr brig galley inboundVisibility = do nonTeamMember <- randomUser brig (tid, _, [teamMember, teamMemberReindexedAfter]) <- createPopulatedBindingTeamWithNamesAndHandles brig 2 @@ -415,7 +415,7 @@ testSearchTeamMemberAsNonMemberExactHandle mgr brig galley inboundVisibility = d assertCanFind brig (userId nonTeamMember) (userQualifiedId teamMember) (fromHandle teamMemberHandle) assertCanFind brig (userId nonTeamMember) (userQualifiedId teamMemberReindexedAfter) (fromHandle teamMemberReindexedAfterHandle) -testSearchTeamMemberAsOtherMemberDisplayName :: TestConstraints m => Manager -> Brig -> Galley -> FeatureStatus -> m () +testSearchTeamMemberAsOtherMemberDisplayName :: (TestConstraints m) => Manager -> Brig -> Galley -> FeatureStatus -> m () testSearchTeamMemberAsOtherMemberDisplayName mgr brig galley inboundVisibility = do (_, _, [teamBSearcher]) <- createPopulatedBindingTeamWithNamesAndHandles brig 1 (tidA, _, [teamATarget, teamATargetReindexedAfter]) <- createPopulatedBindingTeamWithNamesAndHandles brig 2 @@ -433,7 +433,7 @@ testSearchTeamMemberAsOtherMemberDisplayName mgr brig galley inboundVisibility = FeatureStatusEnabled -> assertCanFind FeatureStatusDisabled -> assertCan'tFind -testSearchTeamMemberAsOtherMemberExactHandle :: TestConstraints m => Manager -> Brig -> Galley -> FeatureStatus -> m () +testSearchTeamMemberAsOtherMemberExactHandle :: (TestConstraints m) => Manager -> Brig -> Galley -> FeatureStatus -> m () testSearchTeamMemberAsOtherMemberExactHandle mgr brig galley inboundVisibility = do (_, _, [teamASearcher]) <- createPopulatedBindingTeamWithNamesAndHandles brig 1 (tidA, _, [teamATarget, teamATargetReindexedAfter]) <- createPopulatedBindingTeamWithNamesAndHandles brig 2 @@ -444,21 +444,21 @@ testSearchTeamMemberAsOtherMemberExactHandle mgr brig galley inboundVisibility = assertCanFind brig (userId teamASearcher) (userQualifiedId teamATarget) (fromHandle teamATargetHandle) assertCanFind brig (userId teamASearcher) (userQualifiedId teamATargetReindexedAfter) (fromHandle (fromJust (userHandle teamATargetReindexedAfter'))) -testSearchTeamMemberAsSameMember :: TestConstraints m => Manager -> Brig -> Galley -> FeatureStatus -> m () +testSearchTeamMemberAsSameMember :: (TestConstraints m) => Manager -> Brig -> Galley -> FeatureStatus -> m () testSearchTeamMemberAsSameMember mgr brig galley inboundVisibility = do (tid, _, [teamASearcher, teamATarget]) <- createPopulatedBindingTeam brig 2 circumventSettingsOverride mgr $ setTeamSearchVisibilityInboundAvailable galley tid inboundVisibility refreshIndex brig assertCanFind brig (userId teamASearcher) (userQualifiedId teamATarget) (fromName (userDisplayName teamATarget)) -testSeachNonMemberAsTeamMember :: TestConstraints m => Brig -> m () +testSeachNonMemberAsTeamMember :: (TestConstraints m) => Brig -> m () testSeachNonMemberAsTeamMember brig = do nonTeamMember <- randomUser brig (_, _, [teamMember]) <- createPopulatedBindingTeam brig 1 refreshIndex brig assertCanFind brig (userId teamMember) (userQualifiedId nonTeamMember) (fromName (userDisplayName nonTeamMember)) -testSearchOrderingAsTeamMemberExactMatch :: TestConstraints m => Brig -> m () +testSearchOrderingAsTeamMemberExactMatch :: (TestConstraints m) => Brig -> m () testSearchOrderingAsTeamMemberExactMatch brig = do searchedName <- randomName mapM_ (\(_ :: Int) -> createUser' True (fromName searchedName) brig) [0 .. 99] @@ -471,7 +471,7 @@ testSearchOrderingAsTeamMemberExactMatch brig = do Nothing -> assertFailure "team mate not found in search" Just teamSearcheeIndex -> assertEqual "teammate is not the first result" 0 teamSearcheeIndex -testSearchOrderingAsTeamMemberPrefixMatch :: TestConstraints m => Brig -> m () +testSearchOrderingAsTeamMemberPrefixMatch :: (TestConstraints m) => Brig -> m () testSearchOrderingAsTeamMemberPrefixMatch brig = do searchedName <- randomNameWithMaxLen 122 -- 6 characters for "suffix" mapM_ (\(i :: Int) -> createUser' True (fromName searchedName <> Text.pack (show i)) brig) [0 .. 99] @@ -484,7 +484,7 @@ testSearchOrderingAsTeamMemberPrefixMatch brig = do Nothing -> assertFailure "team mate not found in search" Just teamSearcheeIndex -> assertEqual "teammate is not the first result" 0 teamSearcheeIndex -testSearchOrderingAsTeamMemberWorseNameMatch :: TestConstraints m => Brig -> m () +testSearchOrderingAsTeamMemberWorseNameMatch :: (TestConstraints m) => Brig -> m () testSearchOrderingAsTeamMemberWorseNameMatch brig = do searchedTerm <- randomHandle _ <- createUser' True searchedTerm brig @@ -497,7 +497,7 @@ testSearchOrderingAsTeamMemberWorseNameMatch brig = do Nothing -> assertFailure "team mate not found in search" Just teamSearcheeIndex -> assertEqual "teammate is not the first result" 0 teamSearcheeIndex -testSearchOrderingAsTeamMemberWorseHandleMatch :: TestConstraints m => Brig -> m () +testSearchOrderingAsTeamMemberWorseHandleMatch :: (TestConstraints m) => Brig -> m () testSearchOrderingAsTeamMemberWorseHandleMatch brig = do searchedTerm <- randomHandle nonTeamSearchee <- createUser' True searchedTerm brig @@ -514,7 +514,7 @@ testSearchOrderingAsTeamMemberWorseHandleMatch brig = do Nothing -> assertFailure "team mate not found in search" Just teamSearcheeIndex -> assertEqual "teammate is not the second result" 1 teamSearcheeIndex -testSearchSameTeamOnly :: TestConstraints m => Brig -> Opt.Opts -> m () +testSearchSameTeamOnly :: (TestConstraints m) => Brig -> Opt.Opts -> m () testSearchSameTeamOnly brig opts = do nonTeamMember' <- randomUser brig nonTeamMember <- setRandomHandle brig nonTeamMember' @@ -557,7 +557,7 @@ testSearchNonMemberOutboundOnlyByHandle brig ((_, _, teamAMember), (_, _, _), no let teamMemberAHandle = fromMaybe (error "nonTeamMember must have a handle") (userHandle nonTeamMember) assertCanFind brig (userId teamAMember) (userQualifiedId nonTeamMember) (fromHandle teamMemberAHandle) -testSearchWithDomain :: TestConstraints m => Brig -> m () +testSearchWithDomain :: (TestConstraints m) => Brig -> m () testSearchWithDomain brig = do searcher <- randomUser brig searchee <- randomUser brig @@ -571,7 +571,7 @@ testSearchWithDomain brig = do -- | WARNING: this test only tests that brig will indeed make a call to federator -- (i.e. does the correct if/else branching based on the domain), -- it does not test any of the federation API details. This needs to be tested separately. -testSearchOtherDomain :: TestConstraints m => Opt.Opts -> Brig -> m () +testSearchOtherDomain :: (TestConstraints m) => Opt.Opts -> Brig -> m () testSearchOtherDomain opts brig = do user <- randomUser brig -- We cannot assert on a real federated request here, so we make a request to @@ -732,7 +732,7 @@ testWithBothIndices opts mgr name f = do test mgr "old-index" $ withOldIndex opts f ] -testWithBothIndicesAndOpts :: Opt.Opts -> Manager -> TestName -> (HasCallStack => Opt.Opts -> Http ()) -> TestTree +testWithBothIndicesAndOpts :: Opt.Opts -> Manager -> TestName -> ((HasCallStack) => Opt.Opts -> Http ()) -> TestTree testWithBothIndicesAndOpts opts mgr name f = testGroup name diff --git a/services/brig/test/integration/API/Search/Util.hs b/services/brig/test/integration/API/Search/Util.hs index 3141b4be83f..9f8c83b34e0 100644 --- a/services/brig/test/integration/API/Search/Util.hs +++ b/services/brig/test/integration/API/Search/Util.hs @@ -49,7 +49,7 @@ executeSearch' brig self q maybeDomain maybeSize = do Brig -> UserId -> Text -> Maybe Domain -> Maybe Int -> m ResponseLBS +searchRequest :: (MonadHttp m) => Brig -> UserId -> Text -> Maybe Domain -> Maybe Int -> m ResponseLBS searchRequest brig self q maybeDomain maybeSize = do get ( brig diff --git a/services/brig/test/integration/API/Settings.hs b/services/brig/test/integration/API/Settings.hs index f600817a0e8..1d350b08868 100644 --- a/services/brig/test/integration/API/Settings.hs +++ b/services/brig/test/integration/API/Settings.hs @@ -98,7 +98,7 @@ expectEmailVisible EmailVisibleToSelf = \case DifferentTeam -> False NoTeam -> False -jsonField :: FromJSON a => Key -> Value -> Maybe a +jsonField :: (FromJSON a) => Key -> Value -> Maybe a jsonField f u = u ^? key f >>= maybeFromJSON testUsersEmailVisibleIffExpected :: Opts -> Brig -> Galley -> ViewingUserIs -> EmailVisibilityConfig -> Http () diff --git a/services/brig/test/integration/API/Team.hs b/services/brig/test/integration/API/Team.hs index 5b56b4f414b..bac96f9d766 100644 --- a/services/brig/test/integration/API/Team.hs +++ b/services/brig/test/integration/API/Team.hs @@ -153,7 +153,7 @@ testTeamSize brig req = do SearchUtil.refreshIndex brig assertSize tid owner expectedSize where - assertSize :: HasCallStack => TeamId -> UserId -> Natural -> Http () + assertSize :: (HasCallStack) => TeamId -> UserId -> Natural -> Http () assertSize tid uid expectedSize = void $ get (req tid uid) Brig -> Galley -> Http () +testInvitationRoles :: (HasCallStack) => Brig -> Galley -> Http () testInvitationRoles brig galley = do (owner, tid) <- createUserWithTeam brig -- owner creates a member alice. @@ -467,7 +467,7 @@ testInvitationEmailAndPhoneAccepted brig galley = do -- | FUTUREWORK: this is an alternative helper to 'createPopulatedBindingTeam'. it has been -- added concurrently, and the two should probably be consolidated. createAndVerifyInvitation :: - HasCallStack => + (HasCallStack) => (InvitationCode -> RequestBody) -> InvitationRequest -> Brig -> @@ -730,7 +730,7 @@ testInvitationTooManyMembers brig galley (TeamSizeLimit limit) = do const 403 === statusCode const (Just "too-many-team-members") === fmap Error.label . responseJsonMaybe -testInvitationPaging :: HasCallStack => Opt.Opts -> Brig -> Http () +testInvitationPaging :: (HasCallStack) => Opt.Opts -> Brig -> Http () testInvitationPaging opts brig = do before <- liftIO $ toUTCTimeMillis . addUTCTime (-1) <$> getCurrentTime (uid, tid) <- createUserWithTeam brig @@ -744,7 +744,7 @@ testInvitationPaging opts brig = do postInvitation brig tid uid (invite email) !!! const 201 === statusCode pure email after1ms <- liftIO $ toUTCTimeMillis . addUTCTime 1 <$> getCurrentTime - let getPages :: HasCallStack => Int -> Maybe InvitationId -> Int -> Http [[Invitation]] + let getPages :: (HasCallStack) => Int -> Maybe InvitationId -> Int -> Http [[Invitation]] getPages count start step = do let range = queryRange (toByteString' <$> start) (Just step) r <- @@ -755,7 +755,7 @@ testInvitationPaging opts brig = do if more then (invs :) <$> getPages (count + step) (fmap inInvitation . listToMaybe . reverse $ invs) step else pure [invs] - let checkSize :: HasCallStack => Int -> [Int] -> Http () + let checkSize :: (HasCallStack) => Int -> [Int] -> Http () checkSize pageSize expectedSizes = getPages 0 Nothing pageSize >>= \invss -> liftIO $ do assertEqual "page sizes" expectedSizes (take (length expectedSizes) (map length invss)) diff --git a/services/brig/test/integration/API/Team/Util.hs b/services/brig/test/integration/API/Team/Util.hs index 7fff7162fa9..61ab960962f 100644 --- a/services/brig/test/integration/API/Team/Util.hs +++ b/services/brig/test/integration/API/Team/Util.hs @@ -203,7 +203,7 @@ inviteAndRegisterUser u tid brig = do liftIO $ assertEqual "Team ID in self profile and team table do not match" selfTeam (Just tid) pure invitee -updatePermissions :: HasCallStack => UserId -> TeamId -> (UserId, Permissions) -> Galley -> Http () +updatePermissions :: (HasCallStack) => UserId -> TeamId -> (UserId, Permissions) -> Galley -> Http () updatePermissions from tid (to, perm) galley = put ( galley @@ -217,10 +217,10 @@ updatePermissions from tid (to, perm) galley = where changeMember = Member.mkNewTeamMember to perm Nothing -createTeamConv :: HasCallStack => Galley -> TeamId -> UserId -> [UserId] -> Maybe Milliseconds -> Http ConvId +createTeamConv :: (HasCallStack) => Galley -> TeamId -> UserId -> [UserId] -> Maybe Milliseconds -> Http ConvId createTeamConv = createTeamConvWithRole roleNameWireAdmin -createTeamConvWithRole :: HasCallStack => RoleName -> Galley -> TeamId -> UserId -> [UserId] -> Maybe Milliseconds -> Http ConvId +createTeamConvWithRole :: (HasCallStack) => RoleName -> Galley -> TeamId -> UserId -> [UserId] -> Maybe Milliseconds -> Http ConvId createTeamConvWithRole role g tid u us mtimer = do let tinfo = Just $ ConvTeamInfo tid let conv = @@ -250,7 +250,7 @@ createTeamConvWithRole role g tid u us mtimer = do fromByteString $ getHeader' "Location" r -deleteTeamConv :: HasCallStack => Galley -> TeamId -> ConvId -> UserId -> Http () +deleteTeamConv :: (HasCallStack) => Galley -> TeamId -> ConvId -> UserId -> Http () deleteTeamConv g tid cid u = do delete ( g @@ -261,7 +261,7 @@ deleteTeamConv g tid cid u = do !!! const 200 === statusCode -deleteTeam :: HasCallStack => Galley -> TeamId -> UserId -> Http () +deleteTeam :: (HasCallStack) => Galley -> TeamId -> UserId -> Http () deleteTeam g tid u = do delete ( g @@ -276,7 +276,7 @@ deleteTeam g tid u = do newTeam :: BindingNewTeam newTeam = BindingNewTeam $ newNewTeam (unsafeRange "teamName") DefaultIcon -putLegalHoldEnabled :: HasCallStack => TeamId -> FeatureStatus -> Galley -> Http () +putLegalHoldEnabled :: (HasCallStack) => TeamId -> FeatureStatus -> Galley -> Http () putLegalHoldEnabled tid enabled g = do void . put $ g @@ -285,7 +285,7 @@ putLegalHoldEnabled tid enabled g = do . lbytes (encode (Public.WithStatusNoLock enabled Public.LegalholdConfig Public.FeatureTTLUnlimited)) . expect2xx -putLHWhitelistTeam :: HasCallStack => Galley -> TeamId -> Http ResponseLBS +putLHWhitelistTeam :: (HasCallStack) => Galley -> TeamId -> Http ResponseLBS putLHWhitelistTeam galley tid = do put ( galley @@ -420,7 +420,7 @@ getInvitationCode brig t ref = do let lbs = fromMaybe "" $ responseBody r pure $ fromByteString (maybe (error "No code?") T.encodeUtf8 (lbs ^? key "code" . _String)) -assertNoInvitationCode :: HasCallStack => Brig -> TeamId -> InvitationId -> (MonadIO m, MonadHttp m, MonadCatch m) => m () +assertNoInvitationCode :: (HasCallStack) => Brig -> TeamId -> InvitationId -> (MonadIO m, MonadHttp m, MonadCatch m) => m () assertNoInvitationCode brig t i = get ( brig @@ -457,7 +457,7 @@ setTeamTeamSearchVisibilityAvailable galley tid status = !!! do const 200 === statusCode -setTeamSearchVisibility :: HasCallStack => Galley -> TeamId -> TeamSearchVisibility -> Http () +setTeamSearchVisibility :: (HasCallStack) => Galley -> TeamId -> TeamSearchVisibility -> Http () setTeamSearchVisibility galley tid typ = put ( galley diff --git a/services/brig/test/integration/API/TeamUserSearch.hs b/services/brig/test/integration/API/TeamUserSearch.hs index 84e2a8a3701..a1ac62c58b3 100644 --- a/services/brig/test/integration/API/TeamUserSearch.hs +++ b/services/brig/test/integration/API/TeamUserSearch.hs @@ -53,7 +53,7 @@ tests opts mgr _galley brig = do where testWithNewIndex name f = test mgr name $ withSettingsOverrides opts f -testSearchByEmail :: TestConstraints m => Brig -> m (TeamId, UserId, User) -> Bool -> m () +testSearchByEmail :: (TestConstraints m) => Brig -> m (TeamId, UserId, User) -> Bool -> m () testSearchByEmail brig mkSearcherAndSearchee canFind = do (tid, searcher, searchee) <- mkSearcherAndSearchee eml <- randomEmail @@ -63,14 +63,14 @@ testSearchByEmail brig mkSearcherAndSearchee canFind = do let check = if canFind then assertTeamUserSearchCanFind else assertTeamUserSearchCannotFind check brig tid searcher (userId searchee) (fromEmail eml) -testSearchByEmailSameTeam :: TestConstraints m => Brig -> m () +testSearchByEmailSameTeam :: (TestConstraints m) => Brig -> m () testSearchByEmailSameTeam brig = do let mkSearcherAndSearchee = do (tid, userId -> ownerId, [u1]) <- createPopulatedBindingTeamWithNamesAndHandles brig 1 pure (tid, ownerId, u1) testSearchByEmail brig mkSearcherAndSearchee True -assertTeamUserSearchCanFind :: TestConstraints m => Brig -> TeamId -> UserId -> UserId -> Text -> m () +assertTeamUserSearchCanFind :: (TestConstraints m) => Brig -> TeamId -> UserId -> UserId -> Text -> m () assertTeamUserSearchCanFind brig teamid self expected q = do r <- searchResults <$> executeTeamUserSearch brig teamid self (Just q) Nothing Nothing Nothing liftIO $ do @@ -79,14 +79,14 @@ assertTeamUserSearchCanFind brig teamid self expected q = do assertBool ("User not in results for query: " <> show q) $ expected `elem` map teamContactUserId r -assertTeamUserSearchCannotFind :: TestConstraints m => Brig -> TeamId -> UserId -> UserId -> Text -> m () +assertTeamUserSearchCannotFind :: (TestConstraints m) => Brig -> TeamId -> UserId -> UserId -> Text -> m () assertTeamUserSearchCannotFind brig teamid self expected q = do r <- searchResults <$> executeTeamUserSearch brig teamid self (Just q) Nothing Nothing Nothing liftIO $ do assertBool ("User shouldn't be present in results for query: " <> show q) $ expected `notElem` map teamContactUserId r -testEmptyQuerySorted :: TestConstraints m => Brig -> m () +testEmptyQuerySorted :: (TestConstraints m) => Brig -> m () testEmptyQuerySorted brig = do (tid, userId -> ownerId, users) <- createPopulatedBindingTeamWithNamesAndHandles brig 4 refreshIndex brig @@ -99,7 +99,7 @@ testEmptyQuerySorted brig = do (sort (fmap teamContactUserId r)) liftIO $ assertEqual "sorted team contacts" (sortOn Down creationDates) creationDates -testSort :: TestConstraints m => Brig -> m () +testSort :: (TestConstraints m) => Brig -> m () testSort brig = do (tid, userId -> ownerId, usersImplicitOrder) <- createPopulatedBindingTeamWithNamesAndHandles brig 4 -- Shuffle here to guard against false positives in this test. @@ -131,7 +131,7 @@ testSort brig = do -- Creating test users for these cases is hard, so we skip it. -- This test checks that the search query at least succeeds and returns the users of the team (without testing correct order). -testSortCallSucceeds :: TestConstraints m => Brig -> m () +testSortCallSucceeds :: (TestConstraints m) => Brig -> m () testSortCallSucceeds brig = do (tid, userId -> ownerId, users) <- createPopulatedBindingTeamWithNamesAndHandles brig 4 refreshIndex brig @@ -140,7 +140,7 @@ testSortCallSucceeds brig = do r <- searchResults <$> executeTeamUserSearch brig tid ownerId Nothing Nothing (Just tuSortBy) (Just SortOrderAsc) liftIO $ assertEqual ("length of users sorted by " <> cs (toByteString tuSortBy)) n (length r) -testEmptyQuerySortedWithPagination :: TestConstraints m => Brig -> m () +testEmptyQuerySortedWithPagination :: (TestConstraints m) => Brig -> m () testEmptyQuerySortedWithPagination brig = do (tid, userId -> ownerId, _) <- createPopulatedBindingTeamWithNamesAndHandles brig 20 refreshIndex brig diff --git a/services/brig/test/integration/API/User/Account.hs b/services/brig/test/integration/API/User/Account.hs index fa5f3277db8..3a9047d1f92 100644 --- a/services/brig/test/integration/API/User/Account.hs +++ b/services/brig/test/integration/API/User/Account.hs @@ -570,11 +570,11 @@ testActivateWithExpiry _ brig timeout = do awaitExpiry (round timeout + 5) kc activate brig kc !!! const 404 === statusCode where - actualBody :: HasCallStack => ResponseLBS -> Maybe (Maybe UserIdentity, Bool) + actualBody :: (HasCallStack) => ResponseLBS -> Maybe (Maybe UserIdentity, Bool) actualBody rs = do a <- responseJsonMaybe rs Just (Just (activatedIdentity a), activatedFirst a) - awaitExpiry :: HasCallStack => Int -> ActivationPair -> Http () + awaitExpiry :: (HasCallStack) => Int -> ActivationPair -> Http () awaitExpiry n kc = do liftIO $ threadDelay 1000000 r <- activate brig kc @@ -739,7 +739,7 @@ testMultipleUsersUnqualified brig = do Set.fromList . map (field "name" &&& field "email") <$> responseJsonMaybe r - field :: FromJSON a => Key -> Value -> Maybe a + field :: (FromJSON a) => Key -> Value -> Maybe a field f u = u ^? key f >>= maybeFromJSON testMultipleUsersV3 :: Brig -> Http () @@ -771,7 +771,7 @@ testMultipleUsersV3 brig = do Set.fromList . map (field "name" &&& field "email") <$> responseJsonMaybe r - field :: FromJSON a => Key -> Value -> Maybe a + field :: (FromJSON a) => Key -> Value -> Maybe a field f u = u ^? key f >>= maybeFromJSON testMultipleUsers :: Opt.Opts -> Brig -> Http () @@ -889,10 +889,10 @@ testCreateUserAnonExpiry b = do deleted :: ResponseLBS -> Maybe Bool deleted r = field "deleted" =<< responseJsonMaybe r - field :: FromJSON a => Key -> Value -> Maybe a + field :: (FromJSON a) => Key -> Value -> Maybe a field f u = u ^? key f >>= maybeFromJSON -testUserUpdate :: HasCallStack => Brig -> Cannon -> UserJournalWatcher -> Http () +testUserUpdate :: (HasCallStack) => Brig -> Cannon -> UserJournalWatcher -> Http () testUserUpdate brig cannon userJournalWatcher = do aliceUser <- randomUser brig Util.assertUserActivateJournaled userJournalWatcher aliceUser "user create alice" @@ -1480,7 +1480,7 @@ testUpdateSSOId brig galley = do . Bilge.json (UserSSOId (mkSampleUref "1" "1")) ) !!! const 404 === statusCode - let go :: HasCallStack => User -> UserSSOId -> Http () + let go :: (HasCallStack) => User -> UserSSOId -> Http () go user ssoid = do let uid = userId user put @@ -1678,7 +1678,7 @@ testDeleteUserWithNoUser brig = do !!! do const 404 === statusCode -testDeleteUserWithNotDeletedUser :: HasCallStack => Brig -> Cannon -> UserJournalWatcher -> Http () +testDeleteUserWithNotDeletedUser :: (HasCallStack) => Brig -> Cannon -> UserJournalWatcher -> Http () testDeleteUserWithNotDeletedUser brig cannon userJournalWatcher = do u <- randomUser brig Util.assertUserActivateJournaled userJournalWatcher u "user activate testDeleteUserWithNotDeletedUser" diff --git a/services/brig/test/integration/API/User/Auth.hs b/services/brig/test/integration/API/User/Auth.hs index a03af8237bc..d45863fcb19 100644 --- a/services/brig/test/integration/API/User/Auth.hs +++ b/services/brig/test/integration/API/User/Auth.hs @@ -76,7 +76,7 @@ import Wire.API.User.Client -- with this are failing then assumption that -- 'whitelist-teams-and-implicit-consent' is set in all test environments is no -- longer correct. -onlyIfLhWhitelisted :: MonadIO m => m () -> m () +onlyIfLhWhitelisted :: (MonadIO m) => m () -> m () onlyIfLhWhitelisted action = do let isGalleyLegalholdFeatureWhitelist = True if isGalleyLegalholdFeatureWhitelist @@ -193,7 +193,7 @@ testLoginWith6CharPassword brig db = do writeDirectlyToDB uid pw = liftIO (runClient db (updatePassword uid pw >> revokeAllCookies uid)) - updatePassword :: MonadClient m => UserId -> PlainTextPassword6 -> m () + updatePassword :: (MonadClient m) => UserId -> PlainTextPassword6 -> m () updatePassword u t = do p <- liftIO $ mkSafePassword t retry x5 $ write userPasswordUpdate (params LocalQuorum (p, u)) @@ -204,10 +204,10 @@ testLoginWith6CharPassword brig db = do -------------------------------------------------------------------------------- -- ZAuth test environment for generating arbitrary tokens. -randomAccessToken :: forall u a. ZAuth.TokenPair u a => ZAuth (ZAuth.Token a) +randomAccessToken :: forall u a. (ZAuth.TokenPair u a) => ZAuth (ZAuth.Token a) randomAccessToken = randomUserToken @u >>= ZAuth.newAccessToken -randomUserToken :: ZAuth.UserTokenLike u => ZAuth (ZAuth.Token u) +randomUserToken :: (ZAuth.UserTokenLike u) => ZAuth (ZAuth.Token u) randomUserToken = do r <- Id <$> liftIO UUID.nextRandom ZAuth.newUserToken r Nothing @@ -302,7 +302,7 @@ testNginzMultipleCookies :: Opts.Opts -> Brig -> Nginz -> Http () testNginzMultipleCookies o b n = do u <- randomUser b let Just email = userEmail u - dologin :: HasCallStack => Http ResponseLBS + dologin :: (HasCallStack) => Http ResponseLBS dologin = login n (defEmailLogin email) PersistentCookie c {cookie_value = "ThisIsNotAZauthCookie"}) . decodeCookie <$> dologin badCookie1 <- (\c -> c {cookie_value = "SKsjKQbiqxuEugGMWVbq02fNEA7QFdNmTiSa1Y0YMgaEP5tWl3nYHWlIrM5F8Tt7Cfn2Of738C7oeiY8xzPHAB==.v=1.k=1.d=1.t=u.l=.u=13da31b4-c6bb-4561-8fed-07e728fa6cc5.r=f844b420"}) . decodeCookie <$> dologin @@ -478,7 +478,7 @@ testThrottleLogins conf b = do -- successfully log in again. Furthermore, the test asserts that another -- unrelated user can successfully log-in in parallel to the failed attempts of -- the aforementioned user. -testLimitRetries :: HasCallStack => Opts.Opts -> Brig -> Http () +testLimitRetries :: (HasCallStack) => Opts.Opts -> Brig -> Http () testLimitRetries conf brig = do let Just opts = Opts.setLimitFailedLogins . Opts.optSettings $ conf unless (Opts.timeout opts <= 30) $ @@ -535,7 +535,7 @@ testRegularUserLegalHoldLogin brig = do legalHoldLogin brig (LegalHoldLogin uid (Just defPassword) Nothing) PersistentCookie !!! do const 403 === statusCode -testTeamUserLegalHoldLogin :: HasCallStack => Brig -> Galley -> Http () +testTeamUserLegalHoldLogin :: (HasCallStack) => Brig -> Galley -> Http () testTeamUserLegalHoldLogin brig galley = do -- create team user Alice (alice, tid) <- createUserWithTeam brig @@ -652,7 +652,7 @@ testNoUserSsoLogin brig = do -- The testInvalidCookie test conforms to the following testing standards: -- -- Test that invalid and expired tokens do not work. -testInvalidCookie :: forall u. ZAuth.UserTokenLike u => ZAuth.Env -> Brig -> Http () +testInvalidCookie :: forall u. (ZAuth.UserTokenLike u) => ZAuth.Env -> Brig -> Http () testInvalidCookie z b = do -- Syntactically invalid post (unversioned . b . path "/access" . cookieRaw "zuid" "xxx") !!! do @@ -682,7 +682,7 @@ testInvalidToken z b = do const 403 === statusCode const (Just "Invalid access token") =~= responseBody -testMissingCookie :: forall u a. ZAuth.TokenPair u a => ZAuth.Env -> Brig -> Http () +testMissingCookie :: forall u a. (ZAuth.TokenPair u a) => ZAuth.Env -> Brig -> Http () testMissingCookie z b = do -- Missing cookie, i.e. token refresh mandates a cookie. post (unversioned . b . path "/access") @@ -698,7 +698,7 @@ testMissingCookie z b = do const (Just "Missing cookie") =~= responseBody const (Just "invalid-credentials") =~= responseBody -testUnknownCookie :: forall u. ZAuth.UserTokenLike u => ZAuth.Env -> Brig -> Http () +testUnknownCookie :: forall u. (ZAuth.UserTokenLike u) => ZAuth.Env -> Brig -> Http () testUnknownCookie z b = do -- Valid cookie but unknown to the server. t <- toByteString' <$> runZAuth z (randomUserToken @u) @@ -1064,7 +1064,7 @@ testNewSessionCookie config b = do const 200 === statusCode const Nothing === getHeader "Set-Cookie" -testSuspendInactiveUsers :: HasCallStack => Opts.Opts -> Brig -> CookieType -> String -> Http () +testSuspendInactiveUsers :: (HasCallStack) => Opts.Opts -> Brig -> CookieType -> String -> Http () testSuspendInactiveUsers config brig cookieType endPoint = do -- (context information: cookies are stored by user, not by device; so if there is a -- cookie that is old, it means none of the devices of the user has used it for a request.) @@ -1278,10 +1278,10 @@ getCookieId c = (CookieId . ZAuth.userTokenRand @u) (fromByteString (cookie_value c)) -listCookies :: HasCallStack => Brig -> UserId -> Http [Auth.Cookie ()] +listCookies :: (HasCallStack) => Brig -> UserId -> Http [Auth.Cookie ()] listCookies b u = listCookiesWithLabel b u [] -listCookiesWithLabel :: HasCallStack => Brig -> UserId -> [CookieLabel] -> Http [Auth.Cookie ()] +listCookiesWithLabel :: (HasCallStack) => Brig -> UserId -> [CookieLabel] -> Http [Auth.Cookie ()] listCookiesWithLabel b u l = do rs <- get @@ -1299,7 +1299,7 @@ listCookiesWithLabel b u l = do -- | Check that the cookie returned after login is sane. -- -- Doesn't check everything, just some basic properties. -assertSanePersistentCookie :: forall u. ZAuth.UserTokenLike u => Http.Cookie -> Assertion +assertSanePersistentCookie :: forall u. (ZAuth.UserTokenLike u) => Http.Cookie -> Assertion assertSanePersistentCookie ck = do assertBool "type" (cookie_persistent ck) assertBool "http-only" (cookie_http_only ck) @@ -1312,7 +1312,7 @@ assertSanePersistentCookie ck = do -- | Check that the access token returned after login is sane. assertSaneAccessToken :: - ZAuth.AccessTokenLike a => + (ZAuth.AccessTokenLike a) => -- | Some moment in time before the user was created UTCTime -> UserId -> @@ -1334,5 +1334,5 @@ remJson p l ids = "ids" .= ids ] -wait :: MonadIO m => m () +wait :: (MonadIO m) => m () wait = liftIO $ threadDelay 1000000 diff --git a/services/brig/test/integration/API/User/Client.hs b/services/brig/test/integration/API/User/Client.hs index b7bbd4c2cd1..cf4172263bc 100644 --- a/services/brig/test/integration/API/User/Client.hs +++ b/services/brig/test/integration/API/User/Client.hs @@ -1165,7 +1165,7 @@ testUpdateClient opts brig = do const (Just "label") === (clientLabel <=< responseJsonMaybe) -- update supported client capabilities work - let checkUpdate :: HasCallStack => Maybe [ClientCapability] -> Bool -> [ClientCapability] -> Http () + let checkUpdate :: (HasCallStack) => Maybe [ClientCapability] -> Bool -> [ClientCapability] -> Http () checkUpdate capsIn respStatusOk capsOut = do let update'' = defUpdateClient {updateClientCapabilities = Set.fromList <$> capsIn} put @@ -1193,13 +1193,13 @@ testUpdateClient opts brig = do -- update supported client capabilities don't break prekeys or label do - let checkClientLabel :: HasCallStack => Http () + let checkClientLabel :: (HasCallStack) => Http () checkClientLabel = do getClient brig uid (clientId c) !!! do const 200 === statusCode const (Just label) === (clientLabel <=< responseJsonMaybe) - flushClientPrekey :: HasCallStack => Http (Maybe ClientPrekey) + flushClientPrekey :: (HasCallStack) => Http (Maybe ClientPrekey) flushClientPrekey = do responseJsonMaybe <$> ( get @@ -1208,7 +1208,7 @@ testUpdateClient opts brig = do === statusCode ) - checkClientPrekeys :: HasCallStack => Prekey -> Http () + checkClientPrekeys :: (HasCallStack) => Prekey -> Http () checkClientPrekeys expectedPrekey = do flushClientPrekey >>= \case Nothing -> error "unexpected." @@ -1285,7 +1285,7 @@ testMissingClient brig = do -- brig) have registered it. Add second temporary client, check -- again. (NB: temp clients replace each other, there can always be -- at most one per account.) -testAddMultipleTemporary :: HasCallStack => Brig -> Galley -> Cannon -> Http () +testAddMultipleTemporary :: (HasCallStack) => Brig -> Galley -> Cannon -> Http () testAddMultipleTemporary brig galley cannon = do uid <- userId <$> randomUser brig let clt1 = diff --git a/services/brig/test/integration/API/User/PasswordReset.hs b/services/brig/test/integration/API/User/PasswordReset.hs index 55f19b34c28..9a5c69987ec 100644 --- a/services/brig/test/integration/API/User/PasswordReset.hs +++ b/services/brig/test/integration/API/User/PasswordReset.hs @@ -111,7 +111,7 @@ testPasswordResetInvalidPasswordLength brig cs = do addJsonKey key val (Object xs) = KeyMap.insert key val xs addJsonKey _ _ _ = error "invalid JSON object" - postCompletePasswordReset :: Object -> MonadHttp m => m ResponseLBS + postCompletePasswordReset :: Object -> (MonadHttp m) => m ResponseLBS postCompletePasswordReset bdy = post ( brig diff --git a/services/brig/test/integration/API/User/Property.hs b/services/brig/test/integration/API/User/Property.hs index fd16f35793f..071ea2d356d 100644 --- a/services/brig/test/integration/API/User/Property.hs +++ b/services/brig/test/integration/API/User/Property.hs @@ -149,7 +149,7 @@ testPropertyLimits opts brig = do const 403 === statusCode const (Just "too-many-properties") === fmap Error.label . responseJsonMaybe -testSizeLimits :: HasCallStack => Opt.Opts -> Brig -> Http () +testSizeLimits :: (HasCallStack) => Opt.Opts -> Brig -> Http () testSizeLimits opts brig = do let maxKeyLen = fromIntegral $ fromMaybe defMaxKeyLen . setPropertyMaxKeyLen $ optSettings opts maxValueLen = fromIntegral $ fromMaybe defMaxValueLen . setPropertyMaxValueLen $ optSettings opts diff --git a/services/brig/test/integration/API/User/RichInfo.hs b/services/brig/test/integration/API/User/RichInfo.hs index 49d4957246b..cad0d8053b6 100644 --- a/services/brig/test/integration/API/User/RichInfo.hs +++ b/services/brig/test/integration/API/User/RichInfo.hs @@ -114,7 +114,7 @@ testDedupeDuplicateFieldNames brig = do ri <- getRichInfo brig owner owner liftIO $ assertEqual "duplicate rich info fields" (Right deduped) ri -testRichInfoSizeLimit :: HasCallStack => Brig -> Opt.Opts -> Http () +testRichInfoSizeLimit :: (HasCallStack) => Brig -> Opt.Opts -> Http () testRichInfoSizeLimit brig conf = do let maxSize :: Int = setRichInfoLimit $ optSettings conf (owner, _) <- createUserWithTeam brig diff --git a/services/brig/test/integration/API/User/Util.hs b/services/brig/test/integration/API/User/Util.hs index da62d9d228f..882735a1e48 100644 --- a/services/brig/test/integration/API/User/Util.hs +++ b/services/brig/test/integration/API/User/Util.hs @@ -156,7 +156,7 @@ createRandomPhoneUser brig = do const (Just phn) === (userPhone <=< responseJsonMaybe) pure (uid, phn) -initiatePasswordReset :: Brig -> Email -> MonadHttp m => m ResponseLBS +initiatePasswordReset :: Brig -> Email -> (MonadHttp m) => m ResponseLBS initiatePasswordReset brig email = post ( brig @@ -190,7 +190,7 @@ initiateEmailUpdateLogin brig email loginCreds uid = do pure (decodeCookie rsp, decodeToken rsp) initiateEmailUpdateCreds brig email (cky, tok) uid -initiateEmailUpdateCreds :: Brig -> Email -> (Bilge.Cookie, Brig.ZAuth.Token ZAuth.Access) -> UserId -> MonadHttp m => m ResponseLBS +initiateEmailUpdateCreds :: Brig -> Email -> (Bilge.Cookie, Brig.ZAuth.Token ZAuth.Access) -> UserId -> (MonadHttp m) => m ResponseLBS initiateEmailUpdateCreds brig email (cky, tok) uid = do put $ unversioned @@ -201,7 +201,7 @@ initiateEmailUpdateCreds brig email (cky, tok) uid = do . zUser uid . Bilge.json (EmailUpdate email) -initiateEmailUpdateNoSend :: Brig -> Email -> UserId -> MonadHttp m => m ResponseLBS +initiateEmailUpdateNoSend :: Brig -> Email -> UserId -> (MonadHttp m) => m ResponseLBS initiateEmailUpdateNoSend brig email uid = let emailUpdate = RequestBodyLBS . encode $ EmailUpdate email in put (brig . path "/i/self/email" . contentJson . zUser uid . body emailUpdate) @@ -225,7 +225,7 @@ preparePasswordReset brig cState email uid newpw = do where runSem = liftIO . runFinal @IO . interpretClientToIO cState . codeStoreToCassandra @DB.Client -completePasswordReset :: Brig -> CompletePasswordReset -> MonadHttp m => m ResponseLBS +completePasswordReset :: Brig -> CompletePasswordReset -> (MonadHttp m) => m ResponseLBS completePasswordReset brig passwordResetData = post ( brig @@ -238,7 +238,7 @@ removeBlacklist :: Brig -> Email -> (MonadIO m, MonadHttp m) => m () removeBlacklist brig email = void $ delete (brig . path "/i/users/blacklist" . queryItem "email" (toByteString' email)) -getClient :: Brig -> UserId -> ClientId -> MonadHttp m => m ResponseLBS +getClient :: Brig -> UserId -> ClientId -> (MonadHttp m) => m ResponseLBS getClient brig u c = get $ brig @@ -259,14 +259,14 @@ putClient brig uid c keys = . zUser uid . json (UpdateClient [] Nothing Nothing Nothing keys) -getClientCapabilities :: Brig -> UserId -> ClientId -> MonadHttp m => m ResponseLBS +getClientCapabilities :: Brig -> UserId -> ClientId -> (MonadHttp m) => m ResponseLBS getClientCapabilities brig u c = get $ brig . paths ["clients", toByteString' c, "capabilities"] . zUser u -getUserClientsUnqualified :: Brig -> UserId -> MonadHttp m => m ResponseLBS +getUserClientsUnqualified :: Brig -> UserId -> (MonadHttp m) => m ResponseLBS getUserClientsUnqualified brig uid = get $ apiVersion "v1" @@ -274,14 +274,14 @@ getUserClientsUnqualified brig uid = . paths ["users", toByteString' uid, "clients"] . zUser uid -getUserClientsQualified :: Brig -> UserId -> Domain -> UserId -> MonadHttp m => m ResponseLBS +getUserClientsQualified :: Brig -> UserId -> Domain -> UserId -> (MonadHttp m) => m ResponseLBS getUserClientsQualified brig zusr domain uid = get $ brig . paths ["users", toByteString' domain, toByteString' uid, "clients"] . zUser zusr -deleteClient :: Brig -> UserId -> ClientId -> Maybe Text -> MonadHttp m => m ResponseLBS +deleteClient :: Brig -> UserId -> ClientId -> Maybe Text -> (MonadHttp m) => m ResponseLBS deleteClient brig u c pw = delete $ brig @@ -295,7 +295,7 @@ deleteClient brig u c pw = RequestBodyLBS . encode . object . maybeToList $ fmap ("password" .=) pw -listConnections :: HasCallStack => Brig -> UserId -> MonadHttp m => m ResponseLBS +listConnections :: (HasCallStack) => Brig -> UserId -> (MonadHttp m) => m ResponseLBS listConnections brig u = get $ apiVersion "v1" @@ -320,14 +320,14 @@ listAllConnections brig u size state = ] ) -getConnectionQualified :: MonadHttp m => Brig -> UserId -> Qualified UserId -> m ResponseLBS +getConnectionQualified :: (MonadHttp m) => Brig -> UserId -> Qualified UserId -> m ResponseLBS getConnectionQualified brig from (Qualified toUser toDomain) = get $ brig . paths ["connections", toByteString' toDomain, toByteString' toUser] . zUser from -setProperty :: Brig -> UserId -> ByteString -> Value -> MonadHttp m => m ResponseLBS +setProperty :: Brig -> UserId -> ByteString -> Value -> (MonadHttp m) => m ResponseLBS setProperty brig u k v = put $ brig @@ -337,14 +337,14 @@ setProperty brig u k v = . contentJson . body (RequestBodyLBS $ encode v) -getProperty :: Brig -> UserId -> ByteString -> MonadHttp m => m ResponseLBS +getProperty :: Brig -> UserId -> ByteString -> (MonadHttp m) => m ResponseLBS getProperty brig u k = get $ brig . paths ["/properties", k] . zUser u -deleteProperty :: Brig -> UserId -> ByteString -> MonadHttp m => m ResponseLBS +deleteProperty :: Brig -> UserId -> ByteString -> (MonadHttp m) => m ResponseLBS deleteProperty brig u k = delete $ brig @@ -381,7 +381,7 @@ assertConnectionQualified brig u1 qu2 rel = const (Right rel) === fmap ucStatus . responseJsonEither receiveConnectionAction :: - HasCallStack => + (HasCallStack) => Brig -> FedClient 'Brig -> UserId -> @@ -399,7 +399,7 @@ receiveConnectionAction brig fedBrigClient uid1 quid2 action expectedReaction ex assertConnectionQualified brig uid1 quid2 expectedRel sendConnectionAction :: - HasCallStack => + (HasCallStack) => Brig -> Opts -> UserId -> @@ -426,7 +426,7 @@ sendConnectionAction brig opts uid1 quid2 reaction expectedRel = do assertConnectionQualified brig uid1 quid2 expectedRel sendConnectionUpdateAction :: - HasCallStack => + (HasCallStack) => Brig -> Opts -> UserId -> @@ -472,7 +472,7 @@ uploadAsset c usr sts dat = do === statusCode downloadAsset :: - MonadHttp m => + (MonadHttp m) => CargoHold -> UserId -> Qualified AssetKey -> @@ -485,7 +485,7 @@ downloadAsset c usr ast = . zConn "conn" ) -requestLegalHoldDevice :: Brig -> UserId -> UserId -> LastPrekey -> MonadHttp m => m ResponseLBS +requestLegalHoldDevice :: Brig -> UserId -> UserId -> LastPrekey -> (MonadHttp m) => m ResponseLBS requestLegalHoldDevice brig requesterId targetUserId lastPrekey' = post $ brig @@ -497,7 +497,7 @@ requestLegalHoldDevice brig requesterId targetUserId lastPrekey' = RequestBodyLBS . encode $ LegalHoldClientRequest requesterId lastPrekey' -deleteLegalHoldDevice :: Brig -> UserId -> MonadHttp m => m ResponseLBS +deleteLegalHoldDevice :: Brig -> UserId -> (MonadHttp m) => m ResponseLBS deleteLegalHoldDevice brig uid = delete $ brig @@ -558,11 +558,11 @@ setTeamFeatureLockStatus :: setTeamFeatureLockStatus galley tid status = put (galley . paths ["i", "teams", toByteString' tid, "features", Public.featureNameBS @cfg, toByteString' status]) !!! const 200 === statusCode -lookupCode :: MonadIO m => DB.ClientState -> Code.Key -> Code.Scope -> m (Maybe Code.Code) +lookupCode :: (MonadIO m) => DB.ClientState -> Code.Key -> Code.Scope -> m (Maybe Code.Code) lookupCode db k = liftIO . DB.runClient db . Code.lookup k getNonce :: - MonadHttp m => + (MonadHttp m) => Brig -> UserId -> ClientId -> @@ -570,7 +570,7 @@ getNonce :: getNonce = nonce get headNonce :: - MonadHttp m => + (MonadHttp m) => Brig -> UserId -> ClientId -> @@ -586,7 +586,7 @@ nonce m brig uid cid = ) headNonceNginz :: - MonadHttp m => + (MonadHttp m) => Nginz -> ZAuth.Token ZAuth.Access -> ClientId -> diff --git a/services/brig/test/integration/API/UserPendingActivation.hs b/services/brig/test/integration/API/UserPendingActivation.hs index db47762b6e4..81f6e995c51 100644 --- a/services/brig/test/integration/API/UserPendingActivation.hs +++ b/services/brig/test/integration/API/UserPendingActivation.hs @@ -118,18 +118,18 @@ createUserStep spar' brig' tok tid scimUser email = do Just inviteeCode <- getInvitationCode brig' tid (inInvitation inv) pure (scimStoredUser, inv, inviteeCode) -assertUserExist :: HasCallStack => String -> ClientState -> UserId -> Bool -> HttpT IO () +assertUserExist :: (HasCallStack) => String -> ClientState -> UserId -> Bool -> HttpT IO () assertUserExist msg db' uid shouldExist = liftIO $ do exists <- aFewTimes 12 (runClient db' (userExists uid)) (== shouldExist) assertEqual msg shouldExist exists -waitUserExpiration :: MonadUnliftIO m => Opts -> m () +waitUserExpiration :: (MonadUnliftIO m) => Opts -> m () waitUserExpiration opts' = do let timeoutSecs = round @Double . realToFrac . setTeamInvitationTimeout . optSettings $ opts' Control.Exception.assert (timeoutSecs < 30) $ do threadDelay $ (timeoutSecs + 3) * 1_000_000 -userExists :: MonadClient m => UserId -> m Bool +userExists :: (MonadClient m) => UserId -> m Bool userExists uid = do x <- retry x1 (query1 usersSelect (params LocalQuorum (Identity uid))) pure $ @@ -156,8 +156,9 @@ createUserWithTeamDisableSSO brg gly = do e <- randomEmail n <- UUID.toString <$> liftIO UUID.nextRandom let p = - RequestBodyLBS . Aeson.encode $ - object + RequestBodyLBS + . Aeson.encode + $ object [ "name" .= n, "email" .= fromEmail e, "password" .= defPassword, @@ -209,7 +210,7 @@ randomScimUserWithSubjectAndRichInfo richInfo = do ) _ -> error "randomScimUserWithSubject: impossible" pure - ( (Scim.User.empty userSchemas ("scimuser_" <> suffix) (ScimUserExtra richInfo)) + ( (Scim.User.empty @SparTag userSchemas ("scimuser_" <> suffix) (ScimUserExtra richInfo)) { Scim.User.displayName = Just ("ScimUser" <> suffix), Scim.User.externalId = Just externalId, Scim.User.emails = emails, @@ -218,7 +219,7 @@ randomScimUserWithSubjectAndRichInfo richInfo = do subj ) -randomScimEmail :: MonadRandom m => m Email.Email +randomScimEmail :: (MonadRandom m) => m Email.Email randomScimEmail = do let typ :: Maybe Text = Nothing -- TODO: where should we catch users with more than one @@ -230,7 +231,7 @@ randomScimEmail = do pure . Email.EmailAddress2 $ Email.unsafeEmailAddress localpart domainpart pure Email.Email {..} -randomScimPhone :: MonadRandom m => m Phone.Phone +randomScimPhone :: (MonadRandom m) => m Phone.Phone randomScimPhone = do let typ :: Maybe Text = Nothing value :: Maybe Text <- do @@ -242,7 +243,7 @@ randomScimPhone = do -- | Create a user. createUser :: - HasCallStack => + (HasCallStack) => Spar -> ScimToken -> Scim.User.User SparTag -> @@ -329,7 +330,7 @@ createToken_ spar userid payload = do -- | Create a SCIM token. createToken :: - HasCallStack => + (HasCallStack) => Spar -> UserId -> CreateScimToken -> diff --git a/services/brig/test/integration/Federation/End2end.hs b/services/brig/test/integration/Federation/End2end.hs index cf1beffc23c..a19f1bc328b 100644 --- a/services/brig/test/integration/Federation/End2end.hs +++ b/services/brig/test/integration/Federation/End2end.hs @@ -191,7 +191,7 @@ testClaimMultiPrekeyBundleSuccess brig1 brig2 = do mkClients = Set.fromList . map prekeyClient mkClientMap :: [ClientPrekey] -> Map ClientId (Maybe Prekey) mkClientMap = Map.fromList . map (prekeyClient &&& Just . prekeyData) - qmap :: Ord a => [(Qualified a, b)] -> Map Domain (Map a b) + qmap :: (Ord a) => [(Qualified a, b)] -> Map Domain (Map a b) qmap = fmap Map.fromList . indexQualified . map (sequenceAOf _1) c1 <- generateClientPrekeys brig1 prekeys1 c2 <- generateClientPrekeys brig2 prekeys2 @@ -593,7 +593,7 @@ claimRemoteKeyPackages brig1 brig2 = do @?= Set.fromList [(bob, c) | c <- bobClients] testRemoteTypingIndicator :: - HasCallStack => + (HasCallStack) => Brig -> Brig -> Galley -> diff --git a/services/brig/test/integration/Federation/Util.hs b/services/brig/test/integration/Federation/Util.hs index 4a1376e8686..ace4d04fbbe 100644 --- a/services/brig/test/integration/Federation/Util.hs +++ b/services/brig/test/integration/Federation/Util.hs @@ -117,7 +117,7 @@ connectUsersEnd2End brig1 brig2 quid1 quid2 = do putConnectionQualified brig2 (qUnqualified quid2) quid1 Accepted !!! const 200 === statusCode -sendCommitBundle :: HasCallStack => FilePath -> FilePath -> Maybe FilePath -> Galley -> UserId -> ClientId -> ByteString -> Http () +sendCommitBundle :: (HasCallStack) => FilePath -> FilePath -> Maybe FilePath -> Galley -> UserId -> ClientId -> ByteString -> Http () sendCommitBundle tmp subGroupStateFn welcomeFn galley uid cid commit = do subGroupStateRaw <- liftIO $ BS.readFile $ tmp subGroupStateFn subGroupState <- either (liftIO . assertFailure . T.unpack) pure . decodeMLS' $ subGroupStateRaw diff --git a/services/brig/test/integration/SMTP.hs b/services/brig/test/integration/SMTP.hs index 6acc1288230..4b77600a328 100644 --- a/services/brig/test/integration/SMTP.hs +++ b/services/brig/test/integration/SMTP.hs @@ -224,10 +224,10 @@ delayingApp delay = $> Postie.Accepted ) -everDelayingTCPServer :: HasCallStack => Socket -> IO a -> IO a +everDelayingTCPServer :: (HasCallStack) => Socket -> IO a -> IO a everDelayingTCPServer sock action = listen sock 1024 >> action -withRandomPortAndSocket :: MonadIO m => ((PortNumber, Socket) -> IO a) -> m a +withRandomPortAndSocket :: (MonadIO m) => ((PortNumber, Socket) -> IO a) -> m a withRandomPortAndSocket action = liftIO $ bracket diff --git a/services/brig/test/integration/Util.hs b/services/brig/test/integration/Util.hs index e39db21d288..1db3e2ec90a 100644 --- a/services/brig/test/integration/Util.hs +++ b/services/brig/test/integration/Util.hs @@ -195,16 +195,17 @@ runFedClient (FedClient mgr ep) domain = Right res -> pure res Left err -> assertFailure $ "Servant client failed with: " <> show err - makeClientRequest :: Domain -> Servant.BaseUrl -> Servant.Request -> HTTP.Request - makeClientRequest originDomain burl req = - let req' = Servant.defaultMakeClientRequest burl req - in req' - { HTTP.requestHeaders = - HTTP.requestHeaders req' - <> [ (originDomainHeaderName, toByteString' originDomain), - (versionHeader, toByteString' (versionInt (maxBound :: Version))) - ] - } + makeClientRequest :: Domain -> Servant.BaseUrl -> Servant.Request -> IO HTTP.Request + makeClientRequest originDomain burl req = do + req' <- Servant.defaultMakeClientRequest burl req + pure + req' + { HTTP.requestHeaders = + HTTP.requestHeaders req' + <> [ (originDomainHeaderName, toByteString' originDomain), + (versionHeader, toByteString' (versionInt (maxBound :: Version))) + ] + } instance ToJSON SESBounceType where toJSON BounceUndetermined = String "Undetermined" @@ -272,7 +273,7 @@ localAndRemoteUserWithConvId brig shouldBeLocal = do fakeRemoteUser :: (HasCallStack, MonadIO m) => m (Qualified UserId) fakeRemoteUser = Qualified <$> randomId <*> pure (Domain "far-away.example.com") -randomClient :: MonadIO m => m ClientId +randomClient :: (MonadIO m) => m ClientId randomClient = liftIO $ generate arbitrary randomUser :: @@ -309,28 +310,28 @@ createUser' hasPwd name brig = do Text -> Email -> Brig -> Http User +createUserWithEmail :: (HasCallStack) => Text -> Email -> Brig -> Http User createUserWithEmail name email brig = do r <- postUserWithEmail True True name (Just email) False Nothing Nothing brig Text -> Brig -> Http User +createUserUntrustedEmail :: (HasCallStack) => Text -> Brig -> Http User createUserUntrustedEmail name brig = do email <- randomUntrustedEmail createUserWithEmail name email brig -createAnonUser :: HasCallStack => Text -> Brig -> Http User +createAnonUser :: (HasCallStack) => Text -> Brig -> Http User createAnonUser = createAnonUserExpiry Nothing -createAnonUserExpiry :: HasCallStack => Maybe Integer -> Text -> Brig -> Http User +createAnonUserExpiry :: (HasCallStack) => Maybe Integer -> Text -> Brig -> Http User createAnonUserExpiry expires name brig = do let p = RequestBodyLBS . encode $ object ["name" .= name, "expires_in" .= expires] r <- post (brig . path "/register" . contentJson . body p) Brig -> Int -> Either Email Phone -> Http () +requestActivationCode :: (HasCallStack) => Brig -> Int -> Either Email Phone -> Http () requestActivationCode brig expectedStatus ep = post (brig . path "/activate/send" . contentJson . body (RequestBodyLBS . encode $ bdy ep)) !!! const expectedStatus === statusCode @@ -357,7 +358,7 @@ getPhoneLoginCode brig p = do let lbs = fromMaybe "" $ responseBody r pure (LoginCode <$> (lbs ^? key "code" . _String)) -assertUpdateNotification :: HasCallStack => WS.WebSocket -> UserId -> UserUpdate -> IO () +assertUpdateNotification :: (HasCallStack) => WS.WebSocket -> UserId -> UserUpdate -> IO () assertUpdateNotification ws uid upd = WS.assertMatch (5 # Second) ws $ \n -> do let j = Object $ List1.head (ntfPayload n) j ^? key "type" . _String @?= Just "user.update" @@ -446,7 +447,7 @@ postUserRegister payload brig = do rs <- postUserRegister' payload brig Object -> Brig -> m ResponseLBS +postUserRegister' :: (MonadHttp m) => Object -> Brig -> m ResponseLBS postUserRegister' payload brig = do post (brig . path "/register" . contentJson . body (RequestBodyLBS $ encode payload)) @@ -465,7 +466,7 @@ deleteUserInternal u brig = brig . paths ["/i/users", toByteString' u] -activate :: Brig -> ActivationPair -> MonadHttp m => m ResponseLBS +activate :: Brig -> ActivationPair -> (MonadHttp m) => m ResponseLBS activate brig (k, c) = get $ brig @@ -488,7 +489,7 @@ getUser brig zusr usr = -- | NB: you can also use nginz as the first argument here. The type aliases are compatible, -- and so are the end-points. This is important in tests where the cookie must come from the -- nginz domain, so it can be passed back to it. -login :: Brig -> Login -> CookieType -> MonadHttp m => m ResponseLBS +login :: Brig -> Login -> CookieType -> (MonadHttp m) => m ResponseLBS login b l t = let js = RequestBodyLBS (encode l) in post $ @@ -519,10 +520,10 @@ legalHoldLogin b l t = . (if t == PersistentCookie then queryItem "persist" "true" else id) . body js -decodeCookie :: HasCallStack => Response a -> Bilge.Cookie +decodeCookie :: (HasCallStack) => Response a -> Bilge.Cookie decodeCookie = fromMaybe (error "missing zuid cookie") . getCookie "zuid" -decodeToken :: HasCallStack => Response (Maybe LByteString) -> ZAuth.Token ZAuth.Access +decodeToken :: (HasCallStack) => Response (Maybe LByteString) -> ZAuth.Token ZAuth.Access decodeToken = decodeToken' decodeToken' :: (HasCallStack, ZAuth.AccessTokenLike a) => Response (Maybe LByteString) -> ZAuth.Token a @@ -543,14 +544,15 @@ sendLoginCode b p typ force = . body js where js = - RequestBodyLBS . encode $ - object + RequestBodyLBS + . encode + $ object [ "phone" .= fromPhone p, "voice_call" .= (typ == LoginCodeVoice), "force" .= force ] -postConnection :: Brig -> UserId -> UserId -> MonadHttp m => m ResponseLBS +postConnection :: Brig -> UserId -> UserId -> (MonadHttp m) => m ResponseLBS postConnection brig from to = post $ apiVersion "v1" @@ -562,10 +564,11 @@ postConnection brig from to = . zConn "conn" where payload = - RequestBodyLBS . encode $ - ConnectionRequest to (unsafeRange "some conv name") + RequestBodyLBS + . encode + $ ConnectionRequest to (unsafeRange "some conv name") -postConnectionQualified :: MonadHttp m => Brig -> UserId -> Qualified UserId -> m ResponseLBS +postConnectionQualified :: (MonadHttp m) => Brig -> UserId -> Qualified UserId -> m ResponseLBS postConnectionQualified brig from (Qualified toUser toDomain) = post $ brig @@ -574,7 +577,7 @@ postConnectionQualified brig from (Qualified toUser toDomain) = . zUser from . zConn "conn" -putConnection :: Brig -> UserId -> UserId -> Relation -> MonadHttp m => m ResponseLBS +putConnection :: Brig -> UserId -> UserId -> Relation -> (MonadHttp m) => m ResponseLBS putConnection brig from to r = put $ apiVersion "v1" @@ -587,7 +590,7 @@ putConnection brig from to r = where payload = RequestBodyLBS . encode $ object ["status" .= r] -putConnectionQualified :: Brig -> UserId -> Qualified UserId -> Relation -> MonadHttp m => m ResponseLBS +putConnectionQualified :: Brig -> UserId -> Qualified UserId -> Relation -> (MonadHttp m) => m ResponseLBS putConnectionQualified brig from (Qualified to toDomain) r = put $ brig @@ -721,14 +724,14 @@ getTeamMember u tid galley = . expect2xx ) -getConversationQualified :: MonadHttp m => Galley -> UserId -> Qualified ConvId -> m ResponseLBS +getConversationQualified :: (MonadHttp m) => Galley -> UserId -> Qualified ConvId -> m ResponseLBS getConversationQualified galley usr cnv = get $ galley . paths ["conversations", toByteString' (qDomain cnv), toByteString' (qUnqualified cnv)] . zAuthAccess usr "conn" -createMLSConversation :: MonadHttp m => Galley -> UserId -> ClientId -> m ResponseLBS +createMLSConversation :: (MonadHttp m) => Galley -> UserId -> ClientId -> m ResponseLBS createMLSConversation galley zusr c = do let conv = NewConv @@ -769,7 +772,7 @@ createMLSSubConversation galley zusr qcnv sconv = ] . zUser zusr -createConversation :: MonadHttp m => Galley -> UserId -> [Qualified UserId] -> m ResponseLBS +createConversation :: (MonadHttp m) => Galley -> UserId -> [Qualified UserId] -> m ResponseLBS createConversation galley zusr usersToAdd = do let conv = NewConv @@ -790,7 +793,7 @@ createConversation galley zusr usersToAdd = do . zConn "conn" . json conv -listConvIdsFirstPage :: MonadHttp m => Galley -> UserId -> m ResponseLBS +listConvIdsFirstPage :: (MonadHttp m) => Galley -> UserId -> m ResponseLBS listConvIdsFirstPage galley zusr = do let req = GetMultiTablePageRequest (toRange (Proxy @1000)) Nothing :: GetPaginatedConversationIds post $ @@ -801,7 +804,7 @@ listConvIdsFirstPage galley zusr = do . json req listConvs :: - MonadHttp m => + (MonadHttp m) => Galley -> UserId -> Range 1 1000 [Qualified ConvId] -> @@ -826,16 +829,17 @@ isMember g usr cnv = do Nothing -> pure False Just m -> pure (tUntagged usr == memId m) -getStatus :: HasCallStack => Brig -> UserId -> (MonadIO m, MonadHttp m) => m WU.AccountStatus +getStatus :: (HasCallStack) => Brig -> UserId -> (MonadIO m, MonadHttp m) => m WU.AccountStatus getStatus brig u = - (^?! key "status" . (_JSON @Value @WU.AccountStatus)) . (responseJsonUnsafe @Value) + (^?! key "status" . (_JSON @Value @WU.AccountStatus)) + . (responseJsonUnsafe @Value) <$> get ( brig . paths ["i", "users", toByteString' u, "status"] . expect2xx ) -chkStatus :: HasCallStack => Brig -> UserId -> WU.AccountStatus -> (MonadIO m, MonadHttp m, MonadCatch m) => m () +chkStatus :: (HasCallStack) => Brig -> UserId -> WU.AccountStatus -> (MonadIO m, MonadHttp m, MonadCatch m) => m () chkStatus brig u s = get (brig . paths ["i", "users", toByteString' u, "status"]) !!! do const 200 === statusCode @@ -861,7 +865,7 @@ queryRange start size = maybe id (queryItem "size" . pack . show) size . maybe id (queryItem "start") start -maybeFromJSON :: FromJSON a => Value -> Maybe a +maybeFromJSON :: (FromJSON a) => Value -> Maybe a maybeFromJSON v = case fromJSON v of Success a -> Just a _ -> Nothing @@ -878,7 +882,7 @@ zClient = header "Z-Client" . toByteString' zConn :: ByteString -> Request -> Request zConn = header "Z-Connection" -mkEmailRandomLocalSuffix :: MonadIO m => Text -> m Email +mkEmailRandomLocalSuffix :: (MonadIO m) => Text -> m Email mkEmailRandomLocalSuffix e = do uid <- liftIO UUID.nextRandom case parseEmail e of @@ -887,21 +891,21 @@ mkEmailRandomLocalSuffix e = do -- | Generate emails that are in the trusted whitelist of domains whose @+@ suffices count for email -- disambiguation. See also: 'Brig.Email.mkEmailKey'. -randomEmail :: MonadIO m => m Email +randomEmail :: (MonadIO m) => m Email randomEmail = mkSimulatorEmail "success" -- | To test the behavior of email addresses with untrusted domains (two emails are equal even if -- their local part after @+@ differs), we need to generate them. -randomUntrustedEmail :: MonadIO m => m Email +randomUntrustedEmail :: (MonadIO m) => m Email randomUntrustedEmail = do -- NOTE: local part cannot be longer than 64 octets rd <- liftIO (randomIO :: IO Integer) pure $ Email (Text.pack $ show rd) "zinfra.io" -mkSimulatorEmail :: MonadIO m => Text -> m Email +mkSimulatorEmail :: (MonadIO m) => Text -> m Email mkSimulatorEmail loc = mkEmailRandomLocalSuffix (loc <> "@simulator.amazonses.com") -randomPhone :: MonadIO m => m Phone +randomPhone :: (MonadIO m) => m Phone randomPhone = liftIO $ do nrs <- map show <$> replicateM 14 (randomRIO (0, 9) :: IO Int) let phone = parsePhone . Text.pack $ "+0" ++ concat nrs @@ -910,10 +914,13 @@ randomPhone = liftIO $ do randomActivationCode :: (HasCallStack, MonadIO m) => m ActivationCode randomActivationCode = liftIO $ - ActivationCode . Ascii.unsafeFromText . T.pack . printf "%06d" + ActivationCode + . Ascii.unsafeFromText + . T.pack + . printf "%06d" <$> randIntegerZeroToNMinusOne 1000000 -updatePhone :: HasCallStack => Brig -> UserId -> Phone -> Http () +updatePhone :: (HasCallStack) => Brig -> UserId -> Phone -> Http () updatePhone brig uid phn = do -- update phone let phoneUpdate = RequestBodyLBS . encode $ PhoneUpdate phn @@ -1015,12 +1022,12 @@ defCookieLabel = CookieLabel "auth" randomBytes :: Int -> IO ByteString randomBytes n = BS.pack <$> replicateM n randomIO -randomHandle :: MonadIO m => m Text +randomHandle :: (MonadIO m) => m Text randomHandle = liftIO $ do nrs <- replicateM 21 (randomRIO (97, 122)) -- a-z pure (Text.pack (map chr nrs)) -randomName :: MonadIO m => m Name +randomName :: (MonadIO m) => m Name randomName = randomNameWithMaxLen 128 -- | For testing purposes we restrict ourselves to code points in the @@ -1032,7 +1039,7 @@ randomName = randomNameWithMaxLen 128 -- the standard tokenizer considers as word boundaries (or which are -- simply unassigned code points), yielding no tokens to match and thus -- no results in search queries. -randomNameWithMaxLen :: MonadIO m => Word -> m Name +randomNameWithMaxLen :: (MonadIO m) => Word -> m Name randomNameWithMaxLen maxLen = liftIO $ do len <- randomRIO (2, maxLen) chars <- fill len [] @@ -1130,7 +1137,7 @@ assertOne xs = liftIO . assertFailure $ "Expected exactly one element, found " < newtype MockT m a = MockT {unMock :: ReaderT (IORef MockState) m a} deriving newtype (Functor, Applicative, Monad, MonadReader (IORef MockState), MonadIO) -instance MonadIO m => MonadState MockState (MockT m) where +instance (MonadIO m) => MonadState MockState (MockT m) where get = readIORef =<< ask put x = do ref <- ask @@ -1162,7 +1169,7 @@ getReceivedRequest r = runMockT :: IORef MockState -> MockT m a -> m a runMockT ref mock = runReaderT (unMock mock) ref -startMockService :: MonadIO m => IORef MockState -> ExceptT String m () +startMockService :: (MonadIO m) => IORef MockState -> ExceptT String m () startMockService ref = ExceptT . liftIO $ do (sPort, sock) <- Warp.openFreePort serverStarted <- newEmptyMVar @@ -1185,7 +1192,7 @@ startMockService ref = ExceptT . liftIO $ do initState :: MockState initState = MockState [] (error "server not started") (error "server not started") (error "No mock response provided") -stopMockedService :: MonadIO m => IORef MockState -> m () +stopMockedService :: (MonadIO m) => IORef MockState -> m () stopMockedService ref = liftIO $ Async.cancel . serverThread <=< readIORef $ ref @@ -1214,8 +1221,10 @@ assertRight = \case withMockedGalley :: (MonadIO m, MonadMask m) => Opt.Opts -> (ReceivedRequest -> MockT IO Wai.Response) -> Session a -> m (a, [ReceivedRequest]) withMockedGalley opts handler action = - assertRight <=< runExceptT $ - withTempMockedService initState handler $ \st -> lift $ do + assertRight + <=< runExceptT + $ withTempMockedService initState handler + $ \st -> lift $ do let opts' = opts { Opt.galley = Endpoint "127.0.0.1" (fromIntegral (serverPort st)) @@ -1230,8 +1239,10 @@ withMockedFederatorAndGalley :: Session a -> IO (a, [Mock.FederatedRequest], [ReceivedRequest]) withMockedFederatorAndGalley opts _domain fedResp galleyHandler action = do - result <- assertRight <=< runExceptT $ - withTempMockedService initState galleyHandler $ \galleyMockState -> + result <- assertRight + <=< runExceptT + $ withTempMockedService initState galleyHandler + $ \galleyMockState -> Mock.withTempMockFederator def {Mock.handler = (\r -> pure ("application" // "json", r)) <=< fedResp} $ \fedMockPort -> do @@ -1338,7 +1349,7 @@ runWaiTestFedClient :: runWaiTestFedClient domain action = runReaderT (unWaiTestFedClient action) domain -spawn :: HasCallStack => CreateProcess -> Maybe ByteString -> IO ByteString +spawn :: (HasCallStack) => CreateProcess -> Maybe ByteString -> IO ByteString spawn cp minput = do (mout, ex) <- withCreateProcess cp diff --git a/services/brig/test/integration/Util/AWS.hs b/services/brig/test/integration/Util/AWS.hs index b7cb46fb0f5..ace8a3f23d1 100644 --- a/services/brig/test/integration/Util/AWS.hs +++ b/services/brig/test/integration/Util/AWS.hs @@ -119,7 +119,7 @@ userDeleteMatcher uid ev = assertEventType :: String -> PU.UserEvent'EventType -> PU.UserEvent -> IO () assertEventType l et ev = assertEqual (l <> "eventType") et (ev ^. PU.eventType) -assertUserId :: HasCallStack => String -> UserId -> PU.UserEvent -> IO () +assertUserId :: (HasCallStack) => String -> UserId -> PU.UserEvent -> IO () assertUserId l uid ev = assertEqual (l <> "userId") uid (decodeIdFromBS (ev ^. PU.userId)) assertTeamId :: String -> Maybe TeamId -> PU.UserEvent -> IO () diff --git a/services/brig/test/unit/Test/Brig/Calling.hs b/services/brig/test/unit/Test/Brig/Calling.hs index 007a2041743..1531ca8eed6 100644 --- a/services/brig/test/unit/Test/Brig/Calling.hs +++ b/services/brig/test/unit/Test/Brig/Calling.hs @@ -64,7 +64,7 @@ newFakeDNSEnv :: (Domain -> SrvResponse) -> IO FakeDNSEnv newFakeDNSEnv lookupSrvFn = FakeDNSEnv lookupSrvFn <$> newIORef [] -runFakeDNSLookup :: Member (Embed IO) r => FakeDNSEnv -> Sem (DNSLookup ': r) a -> Sem r a +runFakeDNSLookup :: (Member (Embed IO) r) => FakeDNSEnv -> Sem (DNSLookup ': r) a -> Sem r a runFakeDNSLookup FakeDNSEnv {..} = interpret $ \(LookupSRV domain) -> do modifyIORef' fakeLookupSrvCalls (++ [domain]) diff --git a/services/brig/test/unit/Test/Brig/Effects/Delay.hs b/services/brig/test/unit/Test/Brig/Effects/Delay.hs index 55109f712e3..9b11ad5bfec 100644 --- a/services/brig/test/unit/Test/Brig/Effects/Delay.hs +++ b/services/brig/test/unit/Test/Brig/Effects/Delay.hs @@ -21,7 +21,7 @@ import Wire.Sem.Delay -- > delay 100 -- > takeMVar tick -- This blocks until doStuff is done -- > assertStuffDone -runDelayWithTick :: Member (Embed IO) r => MVar () -> TVar [Int] -> Sem (Delay ': r) a -> Sem r a +runDelayWithTick :: (Member (Embed IO) r) => MVar () -> TVar [Int] -> Sem (Delay ': r) a -> Sem r a runDelayWithTick tick calls = interpret $ \case Delay i -> do atomically $ modifyTVar calls (<> [i]) diff --git a/services/cannon/src/Cannon/App.hs b/services/cannon/src/Cannon/App.hs index 83a6a86e44f..842d38135a3 100644 --- a/services/cannon/src/Cannon/App.hs +++ b/services/cannon/src/Cannon/App.hs @@ -46,11 +46,11 @@ data State = State !Int !Timeout -- | The lifetime of a websocket. newtype TTL = TTL Word64 -counter :: Functor f => LensLike' f State Int +counter :: (Functor f) => LensLike' f State Int counter f (State c p) = (\x -> State x p) `fmap` f c {-# INLINE counter #-} -pingFreq :: Functor f => LensLike' f State Timeout +pingFreq :: (Functor f) => LensLike' f State Timeout pingFreq f (State c p) = (\x -> State c x) `fmap` f p {-# INLINE pingFreq #-} @@ -107,16 +107,16 @@ writeLoop ws clock (TTL ttl) st = loop loop = do s <- readIORef st if - | s ^. counter == 0 -> do - set counter st succ - threadDelay $ s ^. pingFreq - keepAlive - | s ^. counter < 3 -> do - set counter st succ - send (connection ws) ping - threadDelay $ (10 # Second) `min` (s ^. pingFreq) - keepAlive - | otherwise -> pure () + | s ^. counter == 0 -> do + set counter st succ + threadDelay $ s ^. pingFreq + keepAlive + | s ^. counter < 3 -> do + set counter st succ + send (connection ws) ping + threadDelay $ (10 # Second) `min` (s ^. pingFreq) + keepAlive + | otherwise -> pure () keepAlive = do time <- getTime clock unless (time > ttl) loop @@ -161,7 +161,7 @@ rejectOnError p x = do _ -> pure () throwM x -ioErrors :: MonadLogger m => Key -> [Handler m ()] +ioErrors :: (MonadLogger m) => Key -> [Handler m ()] ioErrors k = let f s = Logger.err $ client (key2bytes k) . msg s in [ Handler $ \(x :: HandshakeException) -> f (show x), diff --git a/services/cannon/src/Cannon/Dict.hs b/services/cannon/src/Cannon/Dict.hs index 066a91ccefe..902a3f31040 100644 --- a/services/cannon/src/Cannon/Dict.hs +++ b/services/cannon/src/Cannon/Dict.hs @@ -39,10 +39,10 @@ newtype Dict a b = Dict { _map :: Vector (IORef (SizedHashMap a b)) } -size :: MonadIO m => Dict a b -> m Int +size :: (MonadIO m) => Dict a b -> m Int size d = liftIO $ sum <$> mapM (fmap SHM.size . readIORef) (_map d) -empty :: MonadIO m => Int -> m (Dict a b) +empty :: (MonadIO m) => Int -> m (Dict a b) empty w = liftIO $ if w > 0 && w < 8192 @@ -70,7 +70,7 @@ removeIf f k d = liftIO . atomicModifyIORef' (getSlice k d) $ \m -> lookup :: (Hashable a, MonadIO m) => a -> Dict a b -> m (Maybe b) lookup k = liftIO . fmap (SHM.lookup k) . readIORef . getSlice k -toList :: MonadIO m => Dict a b -> m [(a, b)] +toList :: (MonadIO m) => Dict a b -> m [(a, b)] toList = fmap (mconcat . V.toList) . V.mapM (fmap SHM.toList . readIORef) @@ -80,11 +80,11 @@ toList = -- Internal mutDict :: - MonadIO m => + (MonadIO m) => (SizedHashMap a b -> SizedHashMap a b) -> IORef (SizedHashMap a b) -> m () mutDict f d = liftIO . atomicModifyIORef' d $ \m -> (f m, ()) -getSlice :: Hashable a => a -> Dict a b -> IORef (SizedHashMap a b) +getSlice :: (Hashable a) => a -> Dict a b -> IORef (SizedHashMap a b) getSlice k (Dict m) = m ! (hash k `mod` V.length m) diff --git a/services/cannon/src/Cannon/Types.hs b/services/cannon/src/Cannon/Types.hs index f9d34c5e788..e085a0d9f20 100644 --- a/services/cannon/src/Cannon/Types.hs +++ b/services/cannon/src/Cannon/Types.hs @@ -81,7 +81,7 @@ newtype Cannon a = Cannon MonadMonitor ) -mapConcurrentlyCannon :: Traversable t => (a -> Cannon b) -> t a -> Cannon (t b) +mapConcurrentlyCannon :: (Traversable t) => (a -> Cannon b) -> t a -> Cannon (t b) mapConcurrentlyCannon action inputs = Cannon $ ask >>= \e -> diff --git a/services/cannon/src/Cannon/WS.hs b/services/cannon/src/Cannon/WS.hs index 6837457b636..2b9a816df20 100644 --- a/services/cannon/src/Cannon/WS.hs +++ b/services/cannon/src/Cannon/WS.hs @@ -194,7 +194,7 @@ env :: Env env leh lp gh gp = Env leh lp (host gh . port gp $ empty) (RequestId "N/A") -runWS :: MonadIO m => Env -> WS a -> m a +runWS :: (MonadIO m) => Env -> WS a -> m a runWS e m = liftIO $ runReaderT (_conn m) e registerLocal :: Key -> Websocket -> WS () diff --git a/services/cargohold/src/CargoHold/API/Public.hs b/services/cargohold/src/CargoHold/API/Public.hs index 794e4ae0318..607e8947087 100644 --- a/services/cargohold/src/CargoHold/API/Public.hs +++ b/services/cargohold/src/CargoHold/API/Public.hs @@ -60,11 +60,11 @@ servantSitemap = :<|> legacyAPI :<|> mainAPI where - userAPI :: forall tag. tag ~ 'UserPrincipalTag => ServerT (BaseAPIv3 tag) Handler + userAPI :: forall tag. (tag ~ 'UserPrincipalTag) => ServerT (BaseAPIv3 tag) Handler userAPI = uploadAssetV3 @tag :<|> downloadAssetV3 @tag :<|> deleteAssetV3 @tag - botAPI :: forall tag. tag ~ 'BotPrincipalTag => ServerT (BaseAPIv3 tag) Handler + botAPI :: forall tag. (tag ~ 'BotPrincipalTag) => ServerT (BaseAPIv3 tag) Handler botAPI = uploadAssetV3 @tag :<|> downloadAssetV3 @tag :<|> deleteAssetV3 @tag - providerAPI :: forall tag. tag ~ 'ProviderPrincipalTag => ServerT (BaseAPIv3 tag) Handler + providerAPI :: forall tag. (tag ~ 'ProviderPrincipalTag) => ServerT (BaseAPIv3 tag) Handler providerAPI = uploadAssetV3 @tag :<|> downloadAssetV3 @tag :<|> deleteAssetV3 @tag legacyAPI = legacyDownloadPlain :<|> legacyDownloadPlain :<|> legacyDownloadOtr qualifiedAPI :: ServerT QualifiedAPI Handler @@ -121,7 +121,7 @@ instance HasLocation 'ProviderPrincipalTag where assetKeyToText (tUnqualified key) ] -class HasLocation tag => MakePrincipal (tag :: PrincipalTag) (id :: Type) | id -> tag, tag -> id where +class (HasLocation tag) => MakePrincipal (tag :: PrincipalTag) (id :: Type) | id -> tag, tag -> id where mkPrincipal :: id -> V3.Principal instance MakePrincipal 'UserPrincipalTag (Local UserId) where @@ -135,7 +135,7 @@ instance MakePrincipal 'ProviderPrincipalTag ProviderId where mkAssetLocation :: forall (tag :: PrincipalTag). - HasLocation tag => + (HasLocation tag) => Local AssetKey -> AssetLocation Relative mkAssetLocation key = @@ -155,7 +155,7 @@ mkAssetLocation key = uploadAssetV3 :: forall tag id. - MakePrincipal tag id => + (MakePrincipal tag id) => id -> AssetSource -> Handler (Asset, AssetLocation Relative) @@ -174,7 +174,7 @@ uploadAssetV3 pid req = do pure (fmap tUntagged asset, mkAssetLocation @tag (asset ^. assetKey)) downloadAssetV3 :: - MakePrincipal tag id => + (MakePrincipal tag id) => id -> AssetKey -> Maybe AssetToken -> @@ -206,7 +206,7 @@ downloadAssetV4 usr qkey tok1 tok2 mbHostHeader = ) qkey -deleteAssetV3 :: MakePrincipal tag id => id -> AssetKey -> Handler () +deleteAssetV3 :: (MakePrincipal tag id) => id -> AssetKey -> Handler () deleteAssetV3 usr = V3.delete (mkPrincipal usr) deleteAssetV4 :: Local UserId -> Qualified AssetKey -> Handler () diff --git a/services/cargohold/src/CargoHold/API/V3.hs b/services/cargohold/src/CargoHold/API/V3.hs index 4b4c58f374a..fcb9105c7d5 100644 --- a/services/cargohold/src/CargoHold/API/V3.hs +++ b/services/cargohold/src/CargoHold/API/V3.hs @@ -105,7 +105,7 @@ updateToken own key tok = do let m' = m {S3.v3AssetToken = tok} S3.updateMetadataV3 key m' -randToken :: MonadIO m => m V3.AssetToken +randToken :: (MonadIO m) => m V3.AssetToken randToken = liftIO $ V3.AssetToken . Ascii.encodeBase64Url <$> getRandomBytes 16 download :: V3.Principal -> V3.AssetKey -> Maybe V3.AssetToken -> Maybe Text -> Handler (Maybe URI) diff --git a/services/cargohold/src/CargoHold/AWS.hs b/services/cargohold/src/CargoHold/AWS.hs index 38b8ecc260f..587937d7aa2 100644 --- a/services/cargohold/src/CargoHold/AWS.hs +++ b/services/cargohold/src/CargoHold/AWS.hs @@ -142,7 +142,7 @@ mkEnv lgr s3End s3AddrStyle s3Download bucket cfOpts mgr = do -- they are still revealed on debug level. mapLevel AWS.Error = Logger.Debug -execute :: MonadIO m => Env -> Amazon a -> m a +execute :: (MonadIO m) => Env -> Amazon a -> m a execute e m = liftIO $ runResourceT (runReaderT (unAmazon m) e) data Error where @@ -246,7 +246,7 @@ execCatch env request = do pure Nothing Right r -> pure $ Just r -canRetry :: MonadIO m => Either AWS.Error a -> m Bool +canRetry :: (MonadIO m) => Either AWS.Error a -> m Bool canRetry (Right _) = pure False canRetry (Left e) = case e of AWS.TransportError (HttpExceptionRequest _ ResponseTimeout) -> pure True diff --git a/services/cargohold/src/CargoHold/App.hs b/services/cargohold/src/CargoHold/App.hs index 1f334acb8c2..85c31799667 100644 --- a/services/cargohold/src/CargoHold/App.hs +++ b/services/cargohold/src/CargoHold/App.hs @@ -233,7 +233,7 @@ instance HasRequestId (ExceptT e App) where runAppT :: Env -> AppT m a -> m a runAppT e (AppT a) = runReaderT a e -runAppResourceT :: MonadIO m => Env -> ResourceT App a -> m a +runAppResourceT :: (MonadIO m) => Env -> ResourceT App a -> m a runAppResourceT e rma = liftIO . runResourceT $ transResourceT (runAppT e) rma executeBrigInteral :: BrigInternalClient a -> App (Either Servant.ClientError a) diff --git a/services/cargohold/src/CargoHold/CloudFront.hs b/services/cargohold/src/CargoHold/CloudFront.hs index 9b379e9bcc2..0c8666c1567 100644 --- a/services/cargohold/src/CargoHold/CloudFront.hs +++ b/services/cargohold/src/CargoHold/CloudFront.hs @@ -56,7 +56,7 @@ data CloudFront = CloudFront _func :: ByteString -> IO ByteString } -initCloudFront :: MonadIO m => FilePath -> KeyPairId -> Word -> Domain -> m CloudFront +initCloudFront :: (MonadIO m) => FilePath -> KeyPairId -> Word -> Domain -> m CloudFront initCloudFront kfp kid ttl (Domain dom) = liftIO $ CloudFront baseUrl kid ttl <$> mkPOSIXClock <*> sha1Rsa kfp diff --git a/services/cargohold/src/CargoHold/Metrics.hs b/services/cargohold/src/CargoHold/Metrics.hs index 34d0c08fca4..af9dab18a93 100644 --- a/services/cargohold/src/CargoHold/Metrics.hs +++ b/services/cargohold/src/CargoHold/Metrics.hs @@ -20,7 +20,7 @@ module CargoHold.Metrics where import Imports import qualified Prometheus as Prom -s3UploadOk :: Prom.MonadMonitor m => m () +s3UploadOk :: (Prom.MonadMonitor m) => m () s3UploadOk = Prom.incCounter netS3UploadOk {-# NOINLINE netS3UploadOk #-} diff --git a/services/cargohold/src/CargoHold/Run.hs b/services/cargohold/src/CargoHold/Run.hs index 6106a4c68e9..eeee6b32ab2 100644 --- a/services/cargohold/src/CargoHold/Run.hs +++ b/services/cargohold/src/CargoHold/Run.hs @@ -97,7 +97,7 @@ mkApp o = Codensity $ \k -> toServantHandler :: Env -> Handler a -> Servant.Handler a toServantHandler env = liftIO . runHandler env -collectAuthMetrics :: MonadIO m => AWS.Env -> m () +collectAuthMetrics :: (MonadIO m) => AWS.Env -> m () collectAuthMetrics env = do liftIO $ forever $ do diff --git a/services/cargohold/src/CargoHold/S3.hs b/services/cargohold/src/CargoHold/S3.hs index 181b2f9255c..849b77dcda8 100644 --- a/services/cargohold/src/CargoHold/S3.hs +++ b/services/cargohold/src/CargoHold/S3.hs @@ -341,7 +341,7 @@ getAmzMetaToken h = V3.AssetToken . Ascii.unsafeFromText <$> lookupCI hAmzMetaToken h -parseAmzMeta :: FromByteString a => Text -> [(Text, Text)] -> Maybe a +parseAmzMeta :: (FromByteString a) => Text -> [(Text, Text)] -> Maybe a parseAmzMeta k h = lookupCI k h >>= fromByteString . encodeUtf8 ------------------------------------------------------------------------------- diff --git a/services/cargohold/test/integration/TestSetup.hs b/services/cargohold/test/integration/TestSetup.hs index ae8d4f7362d..93f361e34c3 100644 --- a/services/cargohold/test/integration/TestSetup.hs +++ b/services/cargohold/test/integration/TestSetup.hs @@ -175,17 +175,15 @@ runFederationClient action = do let base = BaseUrl Http (T.unpack cHost) (fromIntegral cPort) "/federation" let env = (mkClientEnv man base) - { makeClientRequest = \burl req -> - let req' = defaultMakeClientRequest burl req - in req' - { requestHeaders = - (originDomainHeaderName, toByteString' domain) - : requestHeaders req' - } + { makeClientRequest = \burl req -> do + req' <- defaultMakeClientRequest burl req + pure req' {requestHeaders = (originDomainHeaderName, toByteString' domain) : requestHeaders req'} } - r <- lift . lift $ - Codensity $ \k -> + r <- lift + . lift + $ Codensity + $ \k -> -- Servant's streaming client throws exceptions in IO for some reason catch (withClientM action env k) (k . Left) @@ -200,17 +198,19 @@ withFederationClient :: ReaderT TestSetup (ExceptT ClientError (Codensity IO)) a withFederationClient action = runExceptT (hoistFederation action) >>= \case Left err -> - liftIO . assertFailure $ - "Unexpected federation client error: " + liftIO + . assertFailure + $ "Unexpected federation client error: " <> displayException err Right x -> pure x withFederationError :: ReaderT TestSetup (ExceptT ClientError (Codensity IO)) a -> TestM Wai.Error withFederationError action = runExceptT (hoistFederation action) - >>= liftIO . \case - Left (FailureResponse _ resp) -> case Aeson.eitherDecode (responseBody resp) of - Left err -> assertFailure $ "Error while parsing error response: " <> err - Right e -> (Wai.code e @?= responseStatusCode resp) $> e - Left err -> assertFailure $ "Unexpected federation client error: " <> displayException err - Right _ -> assertFailure "Unexpected success" + >>= liftIO + . \case + Left (FailureResponse _ resp) -> case Aeson.eitherDecode (responseBody resp) of + Left err -> assertFailure $ "Error while parsing error response: " <> err + Right e -> (Wai.code e @?= responseStatusCode resp) $> e + Left err -> assertFailure $ "Unexpected federation client error: " <> displayException err + Right _ -> assertFailure "Unexpected success" diff --git a/services/federator/src/Federator/ExternalServer.hs b/services/federator/src/Federator/ExternalServer.hs index 11345b1ae6b..238fc493c35 100644 --- a/services/federator/src/Federator/ExternalServer.hs +++ b/services/federator/src/Federator/ExternalServer.hs @@ -55,7 +55,7 @@ import Polysemy.TinyLog qualified as Log import Servant qualified import Servant.API import Servant.API.Extended.Endpath -import Servant.API.Extended.RawM +import Servant.API.Extended.RawM qualified as RawM import Servant.Client.Core import Servant.Server.Generic (AsServerT) import System.Logger.Message qualified as Log @@ -91,7 +91,7 @@ data API mode = API :> Endpath -- We need to use 'RawM' so we can stream request body regardless of -- content-type and send a response with arbitrary content-type. - :> RawM + :> RawM.RawM } deriving (Generic) diff --git a/services/federator/src/Federator/InternalServer.hs b/services/federator/src/Federator/InternalServer.hs index 12a25475c35..e7caef5fd45 100644 --- a/services/federator/src/Federator/InternalServer.hs +++ b/services/federator/src/Federator/InternalServer.hs @@ -43,7 +43,7 @@ import Polysemy.TinyLog import Servant qualified import Servant.API import Servant.API.Extended.Endpath -import Servant.API.Extended.RawM +import Servant.API.Extended.RawM qualified as RawM import Servant.Server.Generic import System.Logger.Class qualified as Log import Wire.API.Federation.Component @@ -67,7 +67,7 @@ data API mode = API :> Endpath -- We need to use 'RawM' so we can stream request body regardless of -- content-type and send a response with arbitrary content-type. - :> RawM + :> RawM.RawM } deriving (Generic) diff --git a/services/federator/src/Federator/Interpreter.hs b/services/federator/src/Federator/Interpreter.hs index 25923a7e824..2042ab1e043 100644 --- a/services/federator/src/Federator/Interpreter.hs +++ b/services/federator/src/Federator/Interpreter.hs @@ -6,7 +6,7 @@ where import Control.Lens import Control.Monad.Codensity -import Control.Monad.Except +import Control.Monad.Except (ExceptT (..)) import Data.Aeson (encode) import Data.Id import Data.Kind diff --git a/services/federator/src/Federator/MockServer.hs b/services/federator/src/Federator/MockServer.hs index a5dd6ae38e1..d7706119998 100644 --- a/services/federator/src/Federator/MockServer.hs +++ b/services/federator/src/Federator/MockServer.hs @@ -234,7 +234,7 @@ getRequestRPC :: Mock Text getRequestRPC = frRPC <$> getRequest -- | Retrieve and deserialise the body of the current request. -getRequestBody :: Aeson.FromJSON a => Mock a +getRequestBody :: (Aeson.FromJSON a) => Mock a getRequestBody = do b <- frBody <$> getRequest case Aeson.eitherDecode b of @@ -257,7 +257,7 @@ guardComponent c = do guard (c == c') -- | Serialise and return a response. -mockReply :: Aeson.ToJSON a => a -> Mock LByteString +mockReply :: (Aeson.ToJSON a) => a -> Mock LByteString mockReply = pure . Aeson.encode -- | Provide a mock reply simulating an unreachable backend. @@ -275,5 +275,5 @@ infixl 5 ~> -- | Expect a given RPC and simply return a pure response when the current -- request matches. -(~>) :: Aeson.ToJSON a => Text -> a -> Mock LByteString +(~>) :: (Aeson.ToJSON a) => Text -> a -> Mock LByteString (~>) rpc x = guardRPC rpc *> mockReply x diff --git a/services/federator/src/Federator/Monitor/Internal.hs b/services/federator/src/Federator/Monitor/Internal.hs index d731858cacc..6f37abdc80f 100644 --- a/services/federator/src/Federator/Monitor/Internal.hs +++ b/services/federator/src/Federator/Monitor/Internal.hs @@ -355,7 +355,7 @@ mkSSLContext settings = do pure ctx -mkSSLContextWithoutCert :: Members '[Embed IO, Polysemy.Error FederationSetupError] r => RunSettings -> Sem r SSLContext +mkSSLContextWithoutCert :: (Members '[Embed IO, Polysemy.Error FederationSetupError] r) => RunSettings -> Sem r SSLContext mkSSLContextWithoutCert settings = do ctx <- embed $ SSL.context embed $ do diff --git a/services/federator/src/Federator/Service.hs b/services/federator/src/Federator/Service.hs index d76718b7dc6..1e9d98330cf 100644 --- a/services/federator/src/Federator/Service.hs +++ b/services/federator/src/Federator/Service.hs @@ -57,7 +57,7 @@ data Service body m a where makeSem ''Service -bodyReaderToStreamT :: Monad m => m ByteString -> SourceT m ByteString +bodyReaderToStreamT :: (Monad m) => m ByteString -> SourceT m ByteString bodyReaderToStreamT action = fromStepT go where go = Effect $ do diff --git a/services/federator/test/integration/Test/Federator/IngressSpec.hs b/services/federator/test/integration/Test/Federator/IngressSpec.hs index 93a6d7fc720..2165edb0761 100644 --- a/services/federator/test/integration/Test/Federator/IngressSpec.hs +++ b/services/federator/test/integration/Test/Federator/IngressSpec.hs @@ -94,8 +94,8 @@ testRejectRequestsWithoutClientCertIngress env = runTestFederator env $ do sslCtxWithoutCert <- either (throwM @_ @FederationSetupError) pure <=< runM - . runEmbedded (liftIO @(TestFederator IO)) - . runError + . runEmbedded (liftIO @(TestFederator IO)) + . runError $ mkSSLContextWithoutCert settings runTestSem $ do r <- @@ -110,7 +110,7 @@ testRejectRequestsWithoutClientCertIngress env = runTestFederator env $ do expectationFailure "Expected client certificate error, got remote error" Left (RemoteErrorResponse _ _ status _) -> status `shouldBe` HTTP.status400 -liftToCodensity :: Member (Embed (Codensity IO)) r => Sem (Embed IO ': r) a -> Sem r a +liftToCodensity :: (Member (Embed (Codensity IO)) r) => Sem (Embed IO ': r) a -> Sem r a liftToCodensity = runEmbedded @IO @(Codensity IO) lift runTestSem :: Sem '[Input TestEnv, Embed (Codensity IO)] a -> TestFederator IO a @@ -124,7 +124,7 @@ discoverConst target = interpret $ \case DiscoverAllFederators _ -> pure (Right (pure target)) inwardBrigCallViaIngress :: - Members [Input TestEnv, Embed (Codensity IO), Error RemoteError] r => + (Members [Input TestEnv, Embed (Codensity IO), Error RemoteError] r) => Text -> Builder -> Sem r StreamingResponse @@ -133,7 +133,7 @@ inwardBrigCallViaIngress path payload = do inwardBrigCallViaIngressWithSettings sslCtx path payload inwardBrigCallViaIngressWithSettings :: - Members [Input TestEnv, Embed (Codensity IO), Error RemoteError] r => + (Members [Input TestEnv, Embed (Codensity IO), Error RemoteError] r) => SSLContext -> Text -> Builder -> diff --git a/services/federator/test/integration/Test/Federator/Util.hs b/services/federator/test/integration/Test/Federator/Util.hs index 549590cb6af..92d80d7d752 100644 --- a/services/federator/test/integration/Test/Federator/Util.hs +++ b/services/federator/test/integration/Test/Federator/Util.hs @@ -77,10 +77,10 @@ newtype TestFederator m a = TestFederator {unwrapTestFederator :: ReaderT TestEn MonadMask ) -instance MonadRandom m => MonadRandom (TestFederator m) where +instance (MonadRandom m) => MonadRandom (TestFederator m) where getRandomBytes = lift . getRandomBytes -instance MonadIO m => MonadHttp (TestFederator m) where +instance (MonadIO m) => MonadHttp (TestFederator m) where handleRequestWithCont req handler = do manager <- _teMgr <$> ask liftIO $ withResponse req manager handler @@ -149,7 +149,7 @@ cliOptsParser = defaultFederatorPath = "/etc/wire/federator/conf/federator.yaml" -- | Create an environment for integration tests from integration and federator config files. -mkEnv :: HasCallStack => IntegrationConfig -> Opts -> IO TestEnv +mkEnv :: (HasCallStack) => IntegrationConfig -> Opts -> IO TestEnv mkEnv _teTstOpts _teOpts = do let managerSettings = mkManagerSettings (Network.Connection.TLSSettingsSimple True False False) Nothing _teMgr :: Manager <- newManager managerSettings @@ -160,7 +160,7 @@ mkEnv _teTstOpts _teOpts = do let _teSettings = optSettings _teOpts pure TestEnv {..} -destroyEnv :: HasCallStack => TestEnv -> IO () +destroyEnv :: (HasCallStack) => TestEnv -> IO () destroyEnv _ = pure () endpointToReq :: Endpoint -> (Bilge.Request -> Bilge.Request) @@ -273,7 +273,7 @@ putHandle brig usr h = where payload = RequestBodyLBS . encode $ object ["handle" .= h] -randomName :: MonadIO m => m Name +randomName :: (MonadIO m) => m Name randomName = randomNameWithMaxLen 128 -- | For testing purposes we restrict ourselves to code points in the @@ -285,7 +285,7 @@ randomName = randomNameWithMaxLen 128 -- the standard tokenizer considers as word boundaries (or which are -- simply unassigned code points), yielding no tokens to match and thus -- no results in search queries. -randomNameWithMaxLen :: MonadIO m => Word -> m Name +randomNameWithMaxLen :: (MonadIO m) => Word -> m Name randomNameWithMaxLen maxLen = liftIO $ do len <- randomRIO (2, maxLen) chars <- fill len [] @@ -305,7 +305,7 @@ randomNameWithMaxLen maxLen = liftIO $ do then pure c else randLetter -randomPhone :: MonadIO m => m Phone +randomPhone :: (MonadIO m) => m Phone randomPhone = liftIO $ do nrs <- map show <$> replicateM 14 (randomRIO (0, 9) :: IO Int) let phone = parsePhone . Text.pack $ "+0" ++ concat nrs @@ -319,13 +319,13 @@ defCookieLabel = CookieLabel "auth" -- | Generate emails that are in the trusted whitelist of domains whose @+@ suffices count for email -- disambiguation. See also: 'Brig.Email.mkEmailKey'. -randomEmail :: MonadIO m => m Email +randomEmail :: (MonadIO m) => m Email randomEmail = mkSimulatorEmail "success" -mkSimulatorEmail :: MonadIO m => Text -> m Email +mkSimulatorEmail :: (MonadIO m) => Text -> m Email mkSimulatorEmail loc = mkEmailRandomLocalSuffix (loc <> "@simulator.amazonses.com") -mkEmailRandomLocalSuffix :: MonadIO m => Text -> m Email +mkEmailRandomLocalSuffix :: (MonadIO m) => Text -> m Email mkEmailRandomLocalSuffix e = do uid <- liftIO UUID.nextRandom case parseEmail e of @@ -338,7 +338,7 @@ zUser = header "Z-User" . C8.pack . show zConn :: ByteString -> Bilge.Request -> Bilge.Request zConn = header "Z-Connection" -randomHandle :: MonadIO m => m Text +randomHandle :: (MonadIO m) => m Text randomHandle = liftIO $ do nrs <- replicateM 21 (randomRIO (97, 122)) -- a-z pure (Text.pack (map chr nrs)) diff --git a/services/federator/test/unit/Test/Federator/ExternalServer.hs b/services/federator/test/unit/Test/Federator/ExternalServer.hs index a0b4effee60..ac45f5aae2d 100644 --- a/services/federator/test/unit/Test/Federator/ExternalServer.hs +++ b/services/federator/test/unit/Test/Federator/ExternalServer.hs @@ -100,7 +100,7 @@ data Call = Call deriving (Eq, Show) mockService :: - Members [Output Call, Embed IO] r => + (Members [Output Call, Embed IO] r) => HTTP.Status -> Sem (ServiceStreaming ': r) a -> Sem r a @@ -131,7 +131,7 @@ requestBrigSuccess = } Right cert <- decodeCertificate <$> BS.readFile "test/resources/unit/localhost.example.com.pem" - let assertMetrics :: Member (Embed IO) r => Sem (Metrics ': r) a -> Sem r a + let assertMetrics :: (Member (Embed IO) r) => Sem (Metrics ': r) a -> Sem r a assertMetrics = interpret $ \case OutgoingCounterIncr _ -> embed @IO $ assertFailure "Should not increment outgoing counter" IncomingCounterIncr od -> embed @IO $ od @?= aValidDomain diff --git a/services/federator/test/unit/Test/Federator/InternalServer.hs b/services/federator/test/unit/Test/Federator/InternalServer.hs index 27029c50b13..66706b74f68 100644 --- a/services/federator/test/unit/Test/Federator/InternalServer.hs +++ b/services/federator/test/unit/Test/Federator/InternalServer.hs @@ -74,7 +74,7 @@ federatedRequestSuccess = trBody = "\"foo\"", trExtraHeaders = requestHeaders } - let verifyCallAndRespond :: Member (Embed IO) r => Sem (Remote ': r) a -> Sem r a + let verifyCallAndRespond :: (Member (Embed IO) r) => Sem (Remote ': r) a -> Sem r a verifyCallAndRespond = interpret $ \case DiscoverAndCall domain component rpc headers body -> embed @IO $ do domain @?= targetDomain @@ -90,7 +90,7 @@ federatedRequestSuccess = responseBody = source ["\"bar\""] } - let assertMetrics :: Member (Embed IO) r => Sem (Metrics ': r) a -> Sem r a + let assertMetrics :: (Member (Embed IO) r) => Sem (Metrics ': r) a -> Sem r a assertMetrics = interpret $ \case OutgoingCounterIncr td -> embed @IO $ td @?= targetDomain IncomingCounterIncr _ -> embed @IO $ assertFailure "Should not increment incoming counter" diff --git a/services/federator/test/unit/Test/Federator/Validation.hs b/services/federator/test/unit/Test/Federator/Validation.hs index 24879f15aae..bd2c882c0e7 100644 --- a/services/federator/test/unit/Test/Federator/Validation.hs +++ b/services/federator/test/unit/Test/Federator/Validation.hs @@ -44,7 +44,7 @@ mockDiscoveryTrivial = Polysemy.interpret $ \case DiscoverFederator dom -> pure . Right $ SrvTarget (Text.encodeUtf8 (domainText dom)) 443 DiscoverAllFederators dom -> pure . Right $ SrvTarget (Text.encodeUtf8 (domainText dom)) 443 :| [] -mockDiscoveryMapping :: HasCallStack => Domain -> NonEmpty ByteString -> Sem (DiscoverFederator ': r) x -> Sem r x +mockDiscoveryMapping :: (HasCallStack) => Domain -> NonEmpty ByteString -> Sem (DiscoverFederator ': r) x -> Sem r x mockDiscoveryMapping origin targets = Polysemy.interpret $ \case DiscoverFederator _ -> error "Not mocked" DiscoverAllFederators dom -> @@ -53,7 +53,7 @@ mockDiscoveryMapping origin targets = Polysemy.interpret $ \case then Right $ fmap (`SrvTarget` 443) targets else Left $ DiscoveryFailureSrvNotAvailable "invalid origin domain" -mockDiscoveryFailure :: HasCallStack => Sem (DiscoverFederator ': r) x -> Sem r x +mockDiscoveryFailure :: (HasCallStack) => Sem (DiscoverFederator ': r) x -> Sem r x mockDiscoveryFailure = Polysemy.interpret $ \case DiscoverFederator _ -> error "Not mocked" DiscoverAllFederators _ -> pure . Left $ DiscoveryFailureDNSError "mock DNS error" diff --git a/services/galley/default.nix b/services/galley/default.nix index e85dbccf854..fbc2aef7564 100644 --- a/services/galley/default.nix +++ b/services/galley/default.nix @@ -175,7 +175,6 @@ mkDerivation { lens metrics-core metrics-wai - mtl optparse-applicative pem polysemy diff --git a/services/galley/galley.cabal b/services/galley/galley.cabal index 0ebe57dc415..c5505dbd551 100644 --- a/services/galley/galley.cabal +++ b/services/galley/galley.cabal @@ -323,7 +323,6 @@ library , lens >=4.4 , metrics-core , metrics-wai >=0.4 - , mtl >=2.2 , optparse-applicative , pem , polysemy diff --git a/services/galley/migrate-data/src/Galley/DataMigration.hs b/services/galley/migrate-data/src/Galley/DataMigration.hs index ac79bcc0fcd..e4c27464ee0 100644 --- a/services/galley/migrate-data/src/Galley/DataMigration.hs +++ b/services/galley/migrate-data/src/Galley/DataMigration.hs @@ -116,5 +116,5 @@ persistVersion (MigrationVersion v) desc time = C.write cql (C.params C.LocalQuo cql :: C.QueryString C.W (Int32, Text, UTCTime) () cql = "insert into data_migration (id, version, descr, date) values (1,?,?,?)" -info :: Log.MonadLogger m => String -> m () +info :: (Log.MonadLogger m) => String -> m () info = Log.info . Log.msg diff --git a/services/galley/migrate-data/src/Galley/DataMigration/Types.hs b/services/galley/migrate-data/src/Galley/DataMigration/Types.hs index 6d92bb0a399..489ac309271 100644 --- a/services/galley/migrate-data/src/Galley/DataMigration/Types.hs +++ b/services/galley/migrate-data/src/Galley/DataMigration/Types.hs @@ -53,7 +53,7 @@ instance (MonadIO m, MonadThrow m) => C.MonadClient (MigrationActionT m) where liftClient = liftCassandra localState f = local (\env -> env {cassandraClientState = f $ cassandraClientState env}) -instance MonadIO m => MonadLogger (MigrationActionT m) where +instance (MonadIO m) => MonadLogger (MigrationActionT m) where log level f = do env <- ask Logger.log (logger env) level f @@ -67,7 +67,7 @@ runMigrationAction :: Env -> MigrationActionT m a -> m a runMigrationAction env action = runReaderT (unMigrationAction action) env -liftCassandra :: MonadIO m => C.Client a -> MigrationActionT m a +liftCassandra :: (MonadIO m) => C.Client a -> MigrationActionT m a liftCassandra m = do env <- ask lift $ C.runClient (cassandraClientState env) m diff --git a/services/galley/migrate-data/src/V1_BackfillBillingTeamMembers.hs b/services/galley/migrate-data/src/V1_BackfillBillingTeamMembers.hs index aa060022e5a..7d46e3f8f13 100644 --- a/services/galley/migrate-data/src/V1_BackfillBillingTeamMembers.hs +++ b/services/galley/migrate-data/src/V1_BackfillBillingTeamMembers.hs @@ -56,13 +56,13 @@ pageSize = 1000 -- Queries -- | Get team members from Galley -getTeamMembers :: MonadClient m => ConduitM () [(TeamId, UserId, Maybe Permissions)] m () +getTeamMembers :: (MonadClient m) => ConduitM () [(TeamId, UserId, Maybe Permissions)] m () getTeamMembers = paginateC cql (paramsP LocalQuorum () pageSize) x5 where cql :: PrepQuery R () (TeamId, UserId, Maybe Permissions) cql = "SELECT team, user, perms FROM team_member" -createBillingTeamMembers :: MonadClient m => (TeamId, UserId) -> m () +createBillingTeamMembers :: (MonadClient m) => (TeamId, UserId) -> m () createBillingTeamMembers pair = retry x5 $ write cql (params LocalQuorum pair) where diff --git a/services/galley/migrate-data/src/V3_BackfillTeamAdmins.hs b/services/galley/migrate-data/src/V3_BackfillTeamAdmins.hs index 6578b4e9631..c835112b40b 100644 --- a/services/galley/migrate-data/src/V3_BackfillTeamAdmins.hs +++ b/services/galley/migrate-data/src/V3_BackfillTeamAdmins.hs @@ -56,13 +56,13 @@ pageSize = 1000 -- Queries -- | Get team members from Galley -getTeamMembers :: MonadClient m => ConduitM () [(TeamId, UserId, Maybe Permissions)] m () +getTeamMembers :: (MonadClient m) => ConduitM () [(TeamId, UserId, Maybe Permissions)] m () getTeamMembers = paginateC cql (paramsP LocalQuorum () pageSize) x5 where cql :: PrepQuery R () (TeamId, UserId, Maybe Permissions) cql = "SELECT team, user, perms FROM team_member" -createTeamAdmins :: MonadClient m => (TeamId, UserId) -> m () +createTeamAdmins :: (MonadClient m) => (TeamId, UserId) -> m () createTeamAdmins pair = retry x5 $ write cql (params LocalQuorum pair) where diff --git a/services/galley/src/Galley/API/Create.hs b/services/galley/src/Galley/API/Create.hs index b998a108339..fa65410616d 100644 --- a/services/galley/src/Galley/API/Create.hs +++ b/services/galley/src/Galley/API/Create.hs @@ -278,7 +278,7 @@ checkCreateConvPermissions lusr newConv (Just tinfo) allUsers = do ensureConnectedToLocals (tUnqualified lusr) (notTeamMember (ulLocals allUsers) (catMaybes convLocalMemberships)) ensureConnectedToRemotes lusr (ulRemotes allUsers) -getTeamMember :: Member TeamStore r => UserId -> Maybe TeamId -> Sem r (Maybe TeamMember) +getTeamMember :: (Member TeamStore r) => UserId -> Maybe TeamId -> Sem r (Maybe TeamMember) getTeamMember uid (Just tid) = E.getTeamMember tid uid getTeamMember uid Nothing = E.getUserTeams uid >>= maybe (pure Nothing) (flip E.getTeamMember uid) . headMay @@ -495,7 +495,7 @@ createOne2OneConversationLocally lcnv self zcon name mtid other = do conversationCreated self c createOne2OneConversationRemotely :: - Member (Error FederationError) r => + (Member (Error FederationError) r) => Remote ConvId -> Local UserId -> ConnId -> @@ -695,7 +695,7 @@ notifyCreatedConversation lusr conn c = do & pushRoute .~ route localOne2OneConvId :: - Member (Error InvalidInput) r => + (Member (Error InvalidInput) r) => Local UserId -> Local UserId -> Sem r (Local ConvId) @@ -704,7 +704,7 @@ localOne2OneConvId self other = do pure . qualifyAs self $ Data.localOne2OneConvId x y toUUIDs :: - Member (Error InvalidInput) r => + (Member (Error InvalidInput) r) => UserId -> UserId -> Sem r (U.UUID U.V4, U.UUID U.V4) @@ -726,6 +726,6 @@ newConvMembers loc body = UserList (newConvUsers body) [] <> toUserList loc (newConvQualifiedUsers body) -ensureOne :: Member (Error InvalidInput) r => [a] -> Sem r a +ensureOne :: (Member (Error InvalidInput) r) => [a] -> Sem r a ensureOne [x] = pure x ensureOne _ = throw (InvalidRange "One-to-one conversations can only have a single invited member") diff --git a/services/galley/src/Galley/API/Error.hs b/services/galley/src/Galley/API/Error.hs index 6a1c4d7c97c..04423558a2f 100644 --- a/services/galley/src/Galley/API/Error.hs +++ b/services/galley/src/Galley/API/Error.hs @@ -99,7 +99,7 @@ badConvState cid = "Connect conversation with more than 2 members: " <> LT.pack (show cid) -legalHoldServiceUnavailable :: Show a => a -> Wai.Error +legalHoldServiceUnavailable :: (Show a) => a -> Wai.Error legalHoldServiceUnavailable e = Wai.mkError status412 "legalhold-unavailable" ("legal hold service unavailable with underlying error: " <> (LT.pack . show $ e)) invalidTeamNotificationId :: Wai.Error diff --git a/services/galley/src/Galley/API/Federation.hs b/services/galley/src/Galley/API/Federation.hs index 7bbc9c8bd8d..aab4029df73 100644 --- a/services/galley/src/Galley/API/Federation.hs +++ b/services/galley/src/Galley/API/Federation.hs @@ -664,14 +664,15 @@ sendMLSMessage remoteDomain msr = handleMLSMessageErrors $ do msg getSubConversationForRemoteUser :: - Members - '[ SubConversationStore, - ConversationStore, - Input (Local ()), - Error InternalError, - P.TinyLog - ] - r => + ( Members + '[ SubConversationStore, + ConversationStore, + Input (Local ()), + Error InternalError, + P.TinyLog + ] + r + ) => Domain -> GetSubConversationsRequest -> Sem r GetSubConversationsResponse @@ -769,7 +770,7 @@ getOne2OneConversation domain (GetOne2OneConversationRequest self other) = class ToGalleyRuntimeError (effs :: EffectRow) r where mapToGalleyError :: - Member (Error GalleyError) r => + (Member (Error GalleyError) r) => Sem (Append effs r) a -> Sem r a @@ -835,7 +836,7 @@ onMLSMessageSent domain rmm = runMessagePush loc (Just (tUntagged rcnv)) $ newMessagePush mempty Nothing rmm.metadata recipients e where - logError :: Member P.TinyLog r => Either (Tagged 'MLSNotEnabled ()) () -> Sem r () + logError :: (Member P.TinyLog r) => Either (Tagged 'MLSNotEnabled ()) () -> Sem r () logError (Left _) = P.warn $ Log.field "conversation" (toByteString' rmm.conversation) @@ -937,7 +938,7 @@ onTypingIndicatorUpdated origDomain TypingDataUpdated {..} = do -- | Log a federation error that is impossible in processing a remote request -- for a local conversation. logFederationError :: - Member P.TinyLog r => + (Member P.TinyLog r) => Local ConvId -> FederationError -> Sem r () diff --git a/services/galley/src/Galley/API/Internal.hs b/services/galley/src/Galley/API/Internal.hs index 142c6df66b7..3cf4708fa8b 100644 --- a/services/galley/src/Galley/API/Internal.hs +++ b/services/galley/src/Galley/API/Internal.hs @@ -485,11 +485,12 @@ guardLegalholdPolicyConflictsH glh = do -- | Get an MLS conversation client list iGetMLSClientListForConv :: forall r. - Members - '[ MemberStore, - ErrorS 'ConvNotFound - ] - r => + ( Members + '[ MemberStore, + ErrorS 'ConvNotFound + ] + r + ) => GroupId -> Sem r ClientList iGetMLSClientListForConv gid = do diff --git a/services/galley/src/Galley/API/LegalHold.hs b/services/galley/src/Galley/API/LegalHold.hs index bc6d94f7161..3ea7e42c928 100644 --- a/services/galley/src/Galley/API/LegalHold.hs +++ b/services/galley/src/Galley/API/LegalHold.hs @@ -695,7 +695,7 @@ blockNonConsentingConnections uid = do status <- putConnectionInternal (BlockForMissingLHConsent userLegalhold othersToBlock) pure $ ["blocking users failed: " <> show (status, othersToBlock) | status /= status200] -unsetTeamLegalholdWhitelistedH :: Member LegalHoldStore r => TeamId -> Sem r () +unsetTeamLegalholdWhitelistedH :: (Member LegalHoldStore r) => TeamId -> Sem r () unsetTeamLegalholdWhitelistedH tid = do () <- error diff --git a/services/galley/src/Galley/API/LegalHold/Team.hs b/services/galley/src/Galley/API/LegalHold/Team.hs index 6345f8fdb30..6fbc8f3bfd6 100644 --- a/services/galley/src/Galley/API/LegalHold/Team.hs +++ b/services/galley/src/Galley/API/LegalHold/Team.hs @@ -85,7 +85,7 @@ ensureNotTooLargeToActivateLegalHold tid = do unlessM (teamSizeBelowLimit (fromIntegral teamSize)) $ throwS @'CannotEnableLegalHoldServiceLargeTeam -teamSizeBelowLimit :: Member TeamStore r => Int -> Sem r Bool +teamSizeBelowLimit :: (Member TeamStore r) => Int -> Sem r Bool teamSizeBelowLimit teamSize = do limit <- fromIntegral . fromRange <$> fanoutLimit let withinLimit = teamSize <= limit diff --git a/services/galley/src/Galley/API/MLS/Commit/ExternalCommit.hs b/services/galley/src/Galley/API/MLS/Commit/ExternalCommit.hs index 52b5a447ca8..74cb9bcaa7e 100644 --- a/services/galley/src/Galley/API/MLS/Commit/ExternalCommit.hs +++ b/services/galley/src/Galley/API/MLS/Commit/ExternalCommit.hs @@ -182,7 +182,7 @@ processExternalCommit senderIdentity lConvOrSub ciphersuite epoch action updateP executeExternalCommitAction :: forall r. - HasProposalActionEffects r => + (HasProposalActionEffects r) => Local ConvOrSubConv -> ClientIdentity -> ExternalCommitAction -> diff --git a/services/galley/src/Galley/API/MLS/Commit/InternalCommit.hs b/services/galley/src/Galley/API/MLS/Commit/InternalCommit.hs index 4e7974de17d..f0b71cb216f 100644 --- a/services/galley/src/Galley/API/MLS/Commit/InternalCommit.hs +++ b/services/galley/src/Galley/API/MLS/Commit/InternalCommit.hs @@ -267,7 +267,7 @@ processInternalCommit senderIdentity con lConvOrSub ciphersuite epoch action com pure events addMembers :: - HasProposalActionEffects r => + (HasProposalActionEffects r) => Qualified UserId -> Maybe ConnId -> Local ConvOrSubConv -> @@ -291,7 +291,7 @@ addMembers qusr con lConvOrSub users = case tUnqualified lConvOrSub of SubConv _ _ -> pure [] removeMembers :: - HasProposalActionEffects r => + (HasProposalActionEffects r) => Qualified UserId -> Maybe ConnId -> Local ConvOrSubConv -> @@ -313,7 +313,7 @@ removeMembers qusr con lConvOrSub users = case tUnqualified lConvOrSub of $ users SubConv _ _ -> pure [] -handleNoChanges :: Monoid a => Sem (Error NoChanges ': r) a -> Sem r a +handleNoChanges :: (Monoid a) => Sem (Error NoChanges ': r) a -> Sem r a handleNoChanges = fmap fold . runError existingLocalMembers :: Local Data.Conversation -> Set (Qualified UserId) diff --git a/services/galley/src/Galley/API/MLS/Conversation.hs b/services/galley/src/Galley/API/MLS/Conversation.hs index 1a7ed3d62bc..09e66ff52c7 100644 --- a/services/galley/src/Galley/API/MLS/Conversation.hs +++ b/services/galley/src/Galley/API/MLS/Conversation.hs @@ -33,7 +33,7 @@ import Wire.API.Conversation hiding (Member) import Wire.API.Conversation.Protocol mkMLSConversation :: - Member MemberStore r => + (Member MemberStore r) => Data.Conversation -> Sem r (Maybe MLSConversation) mkMLSConversation conv = diff --git a/services/galley/src/Galley/API/MLS/Enabled.hs b/services/galley/src/Galley/API/MLS/Enabled.hs index d8106726f0f..ec1bd099baa 100644 --- a/services/galley/src/Galley/API/MLS/Enabled.hs +++ b/services/galley/src/Galley/API/MLS/Enabled.hs @@ -26,7 +26,7 @@ import Wire.API.Error import Wire.API.Error.Galley import Wire.API.MLS.Keys -isMLSEnabled :: Member (Input Env) r => Sem r Bool +isMLSEnabled :: (Member (Input Env) r) => Sem r Bool isMLSEnabled = inputs (isJust . view mlsKeys) -- | Fail if MLS is not enabled. Only use this function at the beginning of an diff --git a/services/galley/src/Galley/API/MLS/GroupInfo.hs b/services/galley/src/Galley/API/MLS/GroupInfo.hs index 692b9524a5d..252551100f2 100644 --- a/services/galley/src/Galley/API/MLS/GroupInfo.hs +++ b/services/galley/src/Galley/API/MLS/GroupInfo.hs @@ -52,7 +52,7 @@ getGroupInfo :: Member (Input Env) r, Member MemberStore r ) => - Members MLSGroupInfoStaticErrors r => + (Members MLSGroupInfoStaticErrors r) => Local UserId -> Qualified ConvId -> Sem r GroupInfoData @@ -68,7 +68,7 @@ getGroupInfoFromLocalConv :: ( Member ConversationStore r, Member MemberStore r ) => - Members MLSGroupInfoStaticErrors r => + (Members MLSGroupInfoStaticErrors r) => Qualified UserId -> Local ConvId -> Sem r GroupInfoData @@ -81,7 +81,7 @@ getGroupInfoFromRemoteConv :: ( Member (Error FederationError) r, Member FederatorAccess r ) => - Members MLSGroupInfoStaticErrors r => + (Members MLSGroupInfoStaticErrors r) => Local UserId -> Remote ConvOrSubConvId -> Sem r GroupInfoData diff --git a/services/galley/src/Galley/API/MLS/Keys.hs b/services/galley/src/Galley/API/MLS/Keys.hs index f8bfe8e458b..71895166859 100644 --- a/services/galley/src/Galley/API/MLS/Keys.hs +++ b/services/galley/src/Galley/API/MLS/Keys.hs @@ -29,10 +29,10 @@ import Wire.API.MLS.CipherSuite import Wire.API.MLS.Keys data SomeKeyPair where - SomeKeyPair :: forall ss. IsSignatureScheme ss => Proxy ss -> KeyPair ss -> SomeKeyPair + SomeKeyPair :: forall ss. (IsSignatureScheme ss) => Proxy ss -> KeyPair ss -> SomeKeyPair getMLSRemovalKey :: - Member (Input Env) r => + (Member (Input Env) r) => SignatureSchemeTag -> Sem r (Maybe SomeKeyPair) getMLSRemovalKey ss = fmap hush . runError @() $ do diff --git a/services/galley/src/Galley/API/MLS/Migration.hs b/services/galley/src/Galley/API/MLS/Migration.hs index b59fa410655..747de458cd4 100644 --- a/services/galley/src/Galley/API/MLS/Migration.hs +++ b/services/galley/src/Galley/API/MLS/Migration.hs @@ -40,10 +40,10 @@ import Wire.API.User -- does not print anything. newtype ApAll f = ApAll {unApAll :: f Bool} -instance Monad f => Semigroup (ApAll f) where +instance (Monad f) => Semigroup (ApAll f) where ApAll a <> ApAll b = ApAll $ a >>= \x -> if x then b else pure False -instance Monad f => Monoid (ApAll f) where +instance (Monad f) => Monoid (ApAll f) where mempty = ApAll (pure True) checkMigrationCriteria :: diff --git a/services/galley/src/Galley/API/MLS/One2One.hs b/services/galley/src/Galley/API/MLS/One2One.hs index 462c0beb66f..00dd1a534de 100644 --- a/services/galley/src/Galley/API/MLS/One2One.hs +++ b/services/galley/src/Galley/API/MLS/One2One.hs @@ -118,7 +118,7 @@ remoteMLSOne2OneConversation lself rother rc = -- | Create a new record for an MLS 1-1 conversation in the database and add -- the two members to it. createMLSOne2OneConversation :: - Member ConversationStore r => + (Member ConversationStore r) => Qualified UserId -> Qualified UserId -> Local MLSConversation -> diff --git a/services/galley/src/Galley/API/MLS/Proposal.hs b/services/galley/src/Galley/API/MLS/Proposal.hs index cbaba7f43db..7f7fb3e40f8 100644 --- a/services/galley/src/Galley/API/MLS/Proposal.hs +++ b/services/galley/src/Galley/API/MLS/Proposal.hs @@ -182,7 +182,7 @@ checkProposal ciphersuite im p = case p of void $ noteS @'MLSInvalidLeafNodeIndex $ imLookup im idx _ -> pure () -addProposedClient :: Member (State IndexMap) r => ClientIdentity -> Sem r ProposalAction +addProposedClient :: (Member (State IndexMap) r) => ClientIdentity -> Sem r ProposalAction addProposedClient cid = do im <- get let (idx, im') = imAddClient im cid @@ -233,7 +233,7 @@ applyProposal _ciphersuite _groupId (RemoveProposal idx) = do applyProposal _activeData _groupId _ = pure mempty processProposal :: - HasProposalEffects r => + (HasProposalEffects r) => ( Member (ErrorS 'ConvNotFound) r, Member (ErrorS 'MLSStaleMessage) r ) => @@ -265,7 +265,7 @@ processProposal qusr lConvOrSub groupId epoch pub prop = do storeProposal groupId epoch propRef ProposalOriginClient prop getKeyPackageIdentity :: - Member (ErrorS 'MLSUnsupportedProposal) r => + (Member (ErrorS 'MLSUnsupportedProposal) r) => KeyPackage -> Sem r ClientIdentity getKeyPackageIdentity = diff --git a/services/galley/src/Galley/API/MLS/Removal.hs b/services/galley/src/Galley/API/MLS/Removal.hs index 53c9a4f2a97..1da9c52369a 100644 --- a/services/galley/src/Galley/API/MLS/Removal.hs +++ b/services/galley/src/Galley/API/MLS/Removal.hs @@ -263,7 +263,7 @@ removeUser lc includeMain qusr = do -- | Convert cassandra subconv maps into SubConversations listSubConversations' :: - Member SubConversationStore r => + (Member SubConversationStore r) => ConvId -> Sem r [SubConversation] listSubConversations' cid = do diff --git a/services/galley/src/Galley/API/MLS/SubConversation.hs b/services/galley/src/Galley/API/MLS/SubConversation.hs index af4df8a7482..c5c57889e1a 100644 --- a/services/galley/src/Galley/API/MLS/SubConversation.hs +++ b/services/galley/src/Galley/API/MLS/SubConversation.hs @@ -99,14 +99,15 @@ getSubConversation lusr qconv sconv = do qconv getLocalSubConversation :: - Members - '[ SubConversationStore, - ConversationStore, - ErrorS 'ConvNotFound, - ErrorS 'ConvAccessDenied, - ErrorS 'MLSSubConvUnsupportedConvType - ] - r => + ( Members + '[ SubConversationStore, + ConversationStore, + ErrorS 'ConvNotFound, + ErrorS 'ConvAccessDenied, + ErrorS 'MLSSubConvUnsupportedConvType + ] + r + ) => Qualified UserId -> Local ConvId -> SubConvId -> @@ -186,13 +187,14 @@ getSubConversationGroupInfo lusr qcnvId subconv = do qcnvId getSubConversationGroupInfoFromLocalConv :: - Members - '[ ConversationStore, - SubConversationStore, - MemberStore - ] - r => - Members MLSGroupInfoStaticErrors r => + ( Members + '[ ConversationStore, + SubConversationStore, + MemberStore + ] + r + ) => + (Members MLSGroupInfoStaticErrors r) => Qualified UserId -> SubConvId -> Local ConvId -> diff --git a/services/galley/src/Galley/API/MLS/Util.hs b/services/galley/src/Galley/API/MLS/Util.hs index cc77d6f3dfa..65e6e9f09b2 100644 --- a/services/galley/src/Galley/API/MLS/Util.hs +++ b/services/galley/src/Galley/API/MLS/Util.hs @@ -126,7 +126,7 @@ withCommitLock lConvOrSubId gid epoch action = ttl = fromIntegral (600 :: Int) -- 10 minutes getConvFromGroupId :: - Member (Error MLSProtocolError) r => + (Member (Error MLSProtocolError) r) => GroupId -> Sem r (ConvType, Qualified ConvOrSubConvId) getConvFromGroupId gid = case groupIdToConv gid of diff --git a/services/galley/src/Galley/API/MLS/Welcome.hs b/services/galley/src/Galley/API/MLS/Welcome.hs index 6f051263247..c9a182d890b 100644 --- a/services/galley/src/Galley/API/MLS/Welcome.hs +++ b/services/galley/src/Galley/API/MLS/Welcome.hs @@ -124,7 +124,7 @@ sendRemoteWelcomes qcnv qusr welcome clients = do } where handleError :: - Member P.TinyLog r => + (Member P.TinyLog r) => Either (Remote [a], FederationError) (Remote MLSWelcomeResponse) -> Sem r () handleError (Right x) = case tUnqualified x of @@ -132,7 +132,7 @@ sendRemoteWelcomes qcnv qusr welcome clients = do MLSWelcomeMLSNotEnabled -> logFedError x (errorToResponse @'MLSNotEnabled) handleError (Left (r, e)) = logFedError r (toResponse e) - logFedError :: Member P.TinyLog r => Remote x -> JSONResponse -> Sem r () + logFedError :: (Member P.TinyLog r) => Remote x -> JSONResponse -> Sem r () logFedError r e = P.warn $ Logger.msg ("A welcome message could not be delivered to a remote backend" :: ByteString) diff --git a/services/galley/src/Galley/API/Message.hs b/services/galley/src/Galley/API/Message.hs index 8d0d8dba25c..483010aa828 100644 --- a/services/galley/src/Galley/API/Message.hs +++ b/services/galley/src/Galley/API/Message.hs @@ -566,7 +566,7 @@ guardQualifiedLegalholdPolicyConflictsWrapper senderType sender localClients qua -- FUTUREWORK: This is just a workaround and would not be needed if we had a proper monoid/semigroup instance for Map where the values have a monoid instance. collectFailedToSend :: - Foldable f => + (Foldable f) => f (Map Domain (Map UserId (Set ClientId))) -> Map Domain (Map UserId (Set ClientId)) collectFailedToSend = foldr (Map.unionWith (Map.unionWith Set.union)) mempty @@ -766,6 +766,6 @@ instance Unqualify QualifiedUserClients UserClients where . Map.findWithDefault mempty domain . qualifiedUserClients -instance Unqualify a b => Unqualify (PostOtrResponse a) (PostOtrResponse b) where +instance (Unqualify a b) => Unqualify (PostOtrResponse a) (PostOtrResponse b) where unqualify domain (Left a) = Left (unqualify domain <$> a) unqualify domain (Right a) = Right (unqualify domain a) diff --git a/services/galley/src/Galley/API/Public/TeamNotification.hs b/services/galley/src/Galley/API/Public/TeamNotification.hs index f8e5a828096..85e4c00358e 100644 --- a/services/galley/src/Galley/API/Public/TeamNotification.hs +++ b/services/galley/src/Galley/API/Public/TeamNotification.hs @@ -41,7 +41,7 @@ getTeamNotifications uid since size = do (fromMaybe defaultSize size) where checkSince :: - Member (ErrorS 'InvalidTeamNotificationId) r => + (Member (ErrorS 'InvalidTeamNotificationId) r) => Maybe NotificationId -> Sem r (Maybe NotificationId) checkSince Nothing = pure Nothing diff --git a/services/galley/src/Galley/API/Push.hs b/services/galley/src/Galley/API/Push.hs index b501c804009..c66a8ae73a4 100644 --- a/services/galley/src/Galley/API/Push.hs +++ b/services/galley/src/Galley/API/Push.hs @@ -61,7 +61,7 @@ instance ToRecipient Recipient where toRecipient = id newMessagePush :: - ToRecipient r => + (ToRecipient r) => BotMap -> Maybe ConnId -> MessageMetadata -> @@ -98,6 +98,6 @@ toPush (MessagePush mconn mm rs _ event) = let usr = qUnqualified (evtFrom event) in newPush (Just usr) (toJSONObject event) rs <&> set pushConn mconn - . set pushNativePriority (mmNativePriority mm) - . set pushRoute (bool RouteDirect RouteAny (mmNativePush mm)) - . set pushTransient (mmTransient mm) + . set pushNativePriority (mmNativePriority mm) + . set pushRoute (bool RouteDirect RouteAny (mmNativePush mm)) + . set pushTransient (mmTransient mm) diff --git a/services/galley/src/Galley/API/Query.hs b/services/galley/src/Galley/API/Query.hs index 5f0e76809ed..8facb7f7b76 100644 --- a/services/galley/src/Galley/API/Query.hs +++ b/services/galley/src/Galley/API/Query.hs @@ -263,7 +263,7 @@ getRemoteConversationsWithFailures lusr convs = do <$> traverse handleFailure resp where handleFailure :: - Member P.TinyLog r => + (Member P.TinyLog r) => Either (Remote [ConvId], FederationError) (Remote GetConversationsResponse) -> Sem r (Either FailedGetConversation [Remote RemoteConversation]) handleFailure (Left (rcids, e)) = do @@ -288,7 +288,7 @@ getConversationRoles lusr cnv = do pure $ Public.ConversationRolesList wireConvRoles conversationIdsPageFromUnqualified :: - Member (ListItems LegacyPaging ConvId) r => + (Member (ListItems LegacyPaging ConvId) r) => Local UserId -> Maybe ConvId -> Maybe (Range 1 1000 Int32) -> @@ -488,7 +488,7 @@ getConversationsInternal luser mids mstart msize = do pure (hasMore, resultSetResult r) removeDeleted :: - Member ConversationStore r => + (Member ConversationStore r) => Data.Conversation -> Sem r Bool removeDeleted c @@ -540,7 +540,7 @@ listConversations luser (Public.ListConversations ids) = do } where removeDeleted :: - Member ConversationStore r => + (Member ConversationStore r) => Data.Conversation -> Sem r Bool removeDeleted c @@ -832,7 +832,7 @@ isMLSOne2OneEstablished lself qother = do convId isLocalMLSOne2OneEstablished :: - Member ConversationStore r => + (Member ConversationStore r) => Local ConvId -> Sem r Bool isLocalMLSOne2OneEstablished lconv = do diff --git a/services/galley/src/Galley/API/Teams.hs b/services/galley/src/Galley/API/Teams.hs index d92aa3b2097..e3aed8fbd4c 100644 --- a/services/galley/src/Galley/API/Teams.hs +++ b/services/galley/src/Galley/API/Teams.hs @@ -182,7 +182,7 @@ getTeamNameInternalH :: getTeamNameInternalH tid = getTeamNameInternal tid >>= noteS @'TeamNotFound -getTeamNameInternal :: Member TeamStore r => TeamId -> Sem r (Maybe TeamName) +getTeamNameInternal :: (Member TeamStore r) => TeamId -> Sem r (Maybe TeamName) getTeamNameInternal = fmap (fmap TeamName) . E.getTeamName -- | DEPRECATED. @@ -310,7 +310,7 @@ updateTeamStatus tid (TeamStatusUpdate newStatus cur) = do else possiblyStaleSize Journal.teamActivate tid size c teamCreationTime runJournal _ _ = throwS @'InvalidTeamStatusUpdate - validateTransition :: Member (ErrorS 'InvalidTeamStatusUpdate) r => (TeamStatus, TeamStatus) -> Sem r Bool + validateTransition :: (Member (ErrorS 'InvalidTeamStatusUpdate) r) => (TeamStatus, TeamStatus) -> Sem r Bool validateTransition = \case (PendingActive, Active) -> pure True (Active, Active) -> pure False @@ -519,7 +519,7 @@ getTeamMembers lzusr tid mbMaxResults mbPagingState = do (pwsHasMore p) (teamMemberPagingState p) -outputToStreamingBody :: Member (Final IO) r => Sem (Output LByteString ': r) () -> Sem r StreamingBody +outputToStreamingBody :: (Member (Final IO) r) => Sem (Output LByteString ': r) () -> Sem r StreamingBody outputToStreamingBody action = withWeavingToFinal @IO $ \state weave _inspect -> pure . (<$ state) $ \write flush -> do let writeChunk c = embedFinal $ do @@ -605,7 +605,7 @@ getTeamMembersCSV lusr tid = do tExportNumDevices = numClients uid } - lookupInviterHandle :: Member BrigAccess r => [TeamMember] -> Sem r (UserId -> Maybe Handle.Handle) + lookupInviterHandle :: (Member BrigAccess r) => [TeamMember] -> Sem r (UserId -> Maybe Handle.Handle) lookupInviterHandle members = do let inviterIds :: [UserId] inviterIds = nub $ mapMaybe (fmap fst . view invitation) members @@ -691,7 +691,7 @@ uncheckedGetTeamMember tid uid = E.getTeamMember tid uid >>= noteS @'TeamMemberNotFound uncheckedGetTeamMembersH :: - Member TeamStore r => + (Member TeamStore r) => TeamId -> Maybe (Range 1 HardTruncationLimit Int32) -> Sem r TeamMemberList @@ -699,7 +699,7 @@ uncheckedGetTeamMembersH tid mMaxResults = uncheckedGetTeamMembers tid (fromMaybe (unsafeRange hardTruncationLimit) mMaxResults) uncheckedGetTeamMembers :: - Member TeamStore r => + (Member TeamStore r) => TeamId -> Range 1 HardTruncationLimit Int32 -> Sem r TeamMemberList @@ -1253,7 +1253,7 @@ ensureNonBindingTeam tid = do -- ensure that the permissions are not "greater" than the user's copy permissions -- this is used to ensure users cannot "elevate" permissions -ensureNotElevated :: Member (ErrorS 'InvalidPermissions) r => Permissions -> TeamMember -> Sem r () +ensureNotElevated :: (Member (ErrorS 'InvalidPermissions) r) => Permissions -> TeamMember -> Sem r () ensureNotElevated targetPermissions member = unless ( (targetPermissions ^. self) @@ -1405,7 +1405,7 @@ canUserJoinTeam tid = do -- | Modify and get visibility type for a team (internal, no user permission checks) getSearchVisibilityInternal :: - Member SearchVisibilityStore r => + (Member SearchVisibilityStore r) => TeamId -> Sem r TeamSearchVisibilityView getSearchVisibilityInternal = @@ -1454,7 +1454,7 @@ queueTeamDeletion tid zusr zcon = do ok <- E.tryPush (TeamItem tid zusr zcon) unless ok $ throwS @'DeleteQueueFull -checkAdminLimit :: Member (ErrorS 'TooManyTeamAdmins) r => Int -> Sem r () +checkAdminLimit :: (Member (ErrorS 'TooManyTeamAdmins) r) => Int -> Sem r () checkAdminLimit adminCount = when (adminCount > 2000) $ throwS @'TooManyTeamAdmins diff --git a/services/galley/src/Galley/API/Teams/Features.hs b/services/galley/src/Galley/API/Teams/Features.hs index 1542b701b12..aa65a594ed4 100644 --- a/services/galley/src/Galley/API/Teams/Features.hs +++ b/services/galley/src/Galley/API/Teams/Features.hs @@ -226,7 +226,7 @@ guardLockStatus = \case -- SetFeatureConfig instances -- | Don't export methods of this typeclass -class GetFeatureConfig cfg => SetFeatureConfig cfg where +class (GetFeatureConfig cfg) => SetFeatureConfig cfg where type SetConfigForTeamConstraints cfg (r :: EffectRow) :: Constraint type SetConfigForTeamConstraints cfg (r :: EffectRow) = () diff --git a/services/galley/src/Galley/API/Teams/Features/Get.hs b/services/galley/src/Galley/API/Teams/Features/Get.hs index 79f1b4e0ba8..685266b3ea1 100644 --- a/services/galley/src/Galley/API/Teams/Features/Get.hs +++ b/services/galley/src/Galley/API/Teams/Features/Get.hs @@ -56,7 +56,7 @@ import Wire.API.Team.Feature data DoAuth = DoAuth UserId | DontDoAuth -- | Don't export methods of this typeclass -class IsFeatureConfig cfg => GetFeatureConfig cfg where +class (IsFeatureConfig cfg) => GetFeatureConfig cfg where type GetConfigForTeamConstraints cfg (r :: EffectRow) :: Constraint type GetConfigForTeamConstraints cfg (r :: EffectRow) = @@ -76,7 +76,7 @@ class IsFeatureConfig cfg => GetFeatureConfig cfg where ) getConfigForServer :: - Member (Input Opts) r => + (Member (Input Opts) r) => Sem r (WithStatus cfg) -- only override if there is additional business logic for getting the feature config -- and/or if the feature flag is configured for the backend in 'FeatureFlags' for galley in 'Galley.Types.Teams' @@ -85,7 +85,7 @@ class IsFeatureConfig cfg => GetFeatureConfig cfg where getConfigForServer = pure defFeatureStatus getConfigForTeam :: - GetConfigForTeamConstraints cfg r => + (GetConfigForTeamConstraints cfg r) => TeamId -> Sem r (WithStatus cfg) default getConfigForTeam :: @@ -97,7 +97,7 @@ class IsFeatureConfig cfg => GetFeatureConfig cfg where getConfigForTeam = genericGetConfigForTeam getConfigForUser :: - GetConfigForUserConstraints cfg r => + (GetConfigForUserConstraints cfg r) => UserId -> Sem r (WithStatus cfg) default getConfigForUser :: @@ -213,7 +213,7 @@ getAllFeatureConfigsForTeam luid tid = do getAllFeatureConfigsForServer :: forall r. - Member (Input Opts) r => + (Member (Input Opts) r) => Sem r AllFeatureConfigs getAllFeatureConfigsForServer = AllFeatureConfigs @@ -277,9 +277,9 @@ getAllFeatureConfigsUser uid = -- | Note: this is an internal function which doesn't cover all features, e.g. LegalholdConfig genericGetConfigForTeam :: forall cfg r. - GetFeatureConfig cfg => - Member TeamFeatureStore r => - Member (Input Opts) r => + (GetFeatureConfig cfg) => + (Member TeamFeatureStore r) => + (Member (Input Opts) r) => TeamId -> Sem r (WithStatus cfg) genericGetConfigForTeam tid = do @@ -291,9 +291,9 @@ genericGetConfigForTeam tid = do -- Note: this function assumes the feature cannot be locked genericGetConfigForMultiTeam :: forall cfg r. - GetFeatureConfig cfg => - Member TeamFeatureStore r => - Member (Input Opts) r => + (GetFeatureConfig cfg) => + (Member TeamFeatureStore r) => + (Member (Input Opts) r) => [TeamId] -> Sem r [(TeamId, WithStatus cfg)] genericGetConfigForMultiTeam tids = do diff --git a/services/galley/src/Galley/API/Teams/Notifications.hs b/services/galley/src/Galley/API/Teams/Notifications.hs index 5c5e040ceb4..f3e31f9ec33 100644 --- a/services/galley/src/Galley/API/Teams/Notifications.hs +++ b/services/galley/src/Galley/API/Teams/Notifications.hs @@ -73,7 +73,7 @@ getTeamNotifications zusr since size = do (DataTeamQueue.resultHasMore page) Nothing -pushTeamEvent :: Member TeamNotificationStore r => TeamId -> Event -> Sem r () +pushTeamEvent :: (Member TeamNotificationStore r) => TeamId -> Event -> Sem r () pushTeamEvent tid evt = do nid <- E.mkNotificationId E.createTeamNotification tid nid (List1.singleton $ toJSONObject evt) diff --git a/services/galley/src/Galley/API/Update.hs b/services/galley/src/Galley/API/Update.hs index 750b9324ca3..e16a7e8c96e 100644 --- a/services/galley/src/Galley/API/Update.hs +++ b/services/galley/src/Galley/API/Update.hs @@ -74,7 +74,6 @@ where import Control.Error.Util (hush) import Control.Lens -import Control.Monad.State import Data.Code import Data.Id import Data.Json.Util diff --git a/services/galley/src/Galley/API/Util.hs b/services/galley/src/Galley/API/Util.hs index efd53d5af79..b87dcf5e051 100644 --- a/services/galley/src/Galley/API/Util.hs +++ b/services/galley/src/Galley/API/Util.hs @@ -222,7 +222,7 @@ ensureActionAllowed action self = case isActionAllowed (fromSing action) (convMe -- fact that there can be no custom roles at the moment Nothing -> throwS @('ActionDenied action) -ensureGroupConversation :: Member (ErrorS 'InvalidOperation) r => Data.Conversation -> Sem r () +ensureGroupConversation :: (Member (ErrorS 'InvalidOperation) r) => Data.Conversation -> Sem r () ensureGroupConversation conv = do let ty = Data.convType conv when (ty /= RegularConv) $ throwS @'InvalidOperation @@ -378,7 +378,7 @@ memberJoinEvent lorig qconv t lmems rmems = remoteToSimple u = SimpleMember (tUntagged (rmId u)) (rmConvRoleName u) convDeleteMembers :: - Member MemberStore r => + (Member MemberStore r) => UserList UserId -> Data.Conversation -> Sem r Data.Conversation @@ -395,13 +395,13 @@ convDeleteMembers ul conv = do filter (\rm -> Set.notMember (rmId rm) remotes) (Data.convRemoteMembers conv) } -isMember :: Foldable m => UserId -> m LocalMember -> Bool +isMember :: (Foldable m) => UserId -> m LocalMember -> Bool isMember u = isJust . find ((u ==) . lmId) -isRemoteMember :: Foldable m => Remote UserId -> m RemoteMember -> Bool +isRemoteMember :: (Foldable m) => Remote UserId -> m RemoteMember -> Bool isRemoteMember u = isJust . find ((u ==) . rmId) -class IsConvMember mem => IsConvMemberId uid mem | uid -> mem where +class (IsConvMember mem) => IsConvMemberId uid mem | uid -> mem where getConvMember :: Local x -> Data.Conversation -> uid -> Maybe mem isConvMember :: Local x -> Data.Conversation -> uid -> Bool @@ -410,7 +410,7 @@ class IsConvMember mem => IsConvMemberId uid mem | uid -> mem where notIsConvMember :: Local x -> Data.Conversation -> uid -> Bool notIsConvMember loc conv = not . isConvMember loc conv -isConvMemberL :: IsConvMemberId uid mem => Local Data.Conversation -> uid -> Bool +isConvMemberL :: (IsConvMemberId uid mem) => Local Data.Conversation -> uid -> Bool isConvMemberL lconv = isConvMember lconv (tUnqualified lconv) instance IsConvMemberId UserId LocalMember where @@ -512,7 +512,7 @@ bmFromMembers lmems rusers = case localBotsAndUsers lmems of convBotsAndMembers :: Data.Conversation -> BotsAndMembers convBotsAndMembers conv = bmFromMembers (Data.convLocalMembers conv) (Data.convRemoteMembers conv) -localBotsAndUsers :: Foldable f => f LocalMember -> ([BotMember], [LocalMember]) +localBotsAndUsers :: (Foldable f) => f LocalMember -> ([BotMember], [LocalMember]) localBotsAndUsers = foldMap botOrUser where botOrUser m = case lmService m of @@ -520,7 +520,7 @@ localBotsAndUsers = foldMap botOrUser Just _ -> (toList (newBotMember m), []) Nothing -> ([], [m]) -location :: ToByteString a => a -> Response -> Response +location :: (ToByteString a) => a -> Response -> Response location = Wai.addHeader hLocation . toByteString' nonTeamMembers :: [LocalMember] -> [TeamMember] -> [LocalMember] @@ -544,15 +544,17 @@ getSelfMemberFromLocals = getMember @'ConvNotFound lmId -- | Throw 'ConvMemberNotFound' if the given user is not part of a -- conversation (either locally or remotely). ensureOtherMember :: - Member (ErrorS 'ConvMemberNotFound) r => + (Member (ErrorS 'ConvMemberNotFound) r) => Local a -> Qualified UserId -> Data.Conversation -> Sem r (Either LocalMember RemoteMember) ensureOtherMember loc quid conv = noteS @'ConvMemberNotFound $ - Left <$> find ((== quid) . tUntagged . qualifyAs loc . lmId) (Data.convLocalMembers conv) - <|> Right <$> find ((== quid) . tUntagged . rmId) (Data.convRemoteMembers conv) + Left + <$> find ((== quid) . tUntagged . qualifyAs loc . lmId) (Data.convLocalMembers conv) + <|> Right + <$> find ((== quid) . tUntagged . rmId) (Data.convRemoteMembers conv) getMember :: forall e mem t userId r. @@ -696,7 +698,7 @@ ensureConversationAccess zusr conv access = do ensureAccessRole (Data.convAccessRoles conv) [(zusr, zusrMembership)] ensureAccess :: - Member (ErrorS 'ConvAccessDenied) r => + (Member (ErrorS 'ConvAccessDenied) r) => Data.Conversation -> Access -> Sem r () @@ -704,13 +706,13 @@ ensureAccess conv access = unless (access `elem` Data.convAccess conv) $ throwS @'ConvAccessDenied -ensureLocal :: Member (Error FederationError) r => Local x -> Qualified a -> Sem r (Local a) +ensureLocal :: (Member (Error FederationError) r) => Local x -> Qualified a -> Sem r (Local a) ensureLocal loc = foldQualified loc pure (\_ -> throw FederationNotImplemented) -------------------------------------------------------------------------------- -- Federation -qualifyLocal :: Member (Input (Local ())) r => a -> Sem r (Local a) +qualifyLocal :: (Member (Input (Local ())) r) => a -> Sem r (Local a) qualifyLocal a = toLocalUnsafe <$> fmap getDomain input <*> pure a where getDomain :: Local () -> Domain @@ -776,7 +778,7 @@ fromConversationCreated loc rc@ConversationCreated {..} = where inDomain :: OtherMember -> Bool inDomain = (== tDomain loc) . qDomain . Public.omQualifiedId - setHoles :: Ord a => Set a -> [(a, Set a)] + setHoles :: (Ord a) => Set a -> [(a, Set a)] setHoles s = foldMap (\x -> [(x, Set.delete x s)]) s -- Currently this function creates a Member with default conversation attributes -- FUTUREWORK(federation): retrieve member's conversation attributes (muted, archived, etc) here once supported by the database schema. @@ -815,7 +817,7 @@ fromConversationCreated loc rc@ConversationCreated {..} = ProtocolProteus ensureNoUnreachableBackends :: - Member (Error UnreachableBackends) r => + (Member (Error UnreachableBackends) r) => [Either (Remote e, b) a] -> Sem r [a] ensureNoUnreachableBackends results = do @@ -939,7 +941,7 @@ consentGiven = \case UserLegalHoldNoConsent -> ConsentNotGiven checkConsent :: - Member TeamStore r => + (Member TeamStore r) => Map UserId TeamId -> UserId -> Sem r ConsentGiven @@ -949,7 +951,7 @@ checkConsent teamsOfUsers other = do -- Get legalhold status of user. Defaults to 'defUserLegalHoldStatus' if user -- doesn't belong to a team. getLHStatus :: - Member TeamStore r => + (Member TeamStore r) => Maybe TeamId -> UserId -> Sem r UserLegalHoldStatus @@ -1006,7 +1008,7 @@ allLegalholdConsentGiven uids = do -- | Add to every uid the legalhold status getLHStatusForUsers :: - Member TeamStore r => + (Member TeamStore r) => [UserId] -> Sem r [(UserId, UserLegalHoldStatus)] getLHStatusForUsers uids = @@ -1019,7 +1021,7 @@ getLHStatusForUsers uids = (uid,) <$> getLHStatus (Map.lookup uid teamsOfUsers) uid ) -getTeamMembersForFanout :: Member TeamStore r => TeamId -> Sem r TeamMemberList +getTeamMembersForFanout :: (Member TeamStore r) => TeamId -> Sem r TeamMemberList getTeamMembersForFanout tid = do lim <- fanoutLimit getTeamMembersWithLimit tid lim diff --git a/services/galley/src/Galley/App.hs b/services/galley/src/Galley/App.hs index 4242b7f3cf6..0eab89da5c7 100644 --- a/services/galley/src/Galley/App.hs +++ b/services/galley/src/Galley/App.hs @@ -212,7 +212,7 @@ initHttp2Manager = do http2ManagerWithSSLCtx ctx interpretTinyLog :: - Member (Embed IO) r => + (Member (Embed IO) r) => Env -> Sem (P.TinyLog ': r) a -> Sem r a diff --git a/services/galley/src/Galley/Aws.hs b/services/galley/src/Galley/Aws.hs index 2a7050784f6..67963a7e908 100644 --- a/services/galley/src/Galley/Aws.hs +++ b/services/galley/src/Galley/Aws.hs @@ -156,7 +156,7 @@ mkEnv lgr mgr opts = do (pure . QueueUrl . view SQS.getQueueUrlResponse_queueUrl) x -execute :: MonadIO m => Env -> Amazon a -> m a +execute :: (MonadIO m) => Env -> Amazon a -> m a execute e m = liftIO $ runResourceT (runReaderT (unAmazon m) e) enqueue :: E.TeamEvent -> Amazon () @@ -186,7 +186,7 @@ sendCatch :: Amazon (Either AWS.Error (AWS.AWSResponse r)) sendCatch e = AWS.trying AWS._Error . AWS.send e -canRetry :: MonadIO m => Either AWS.Error a -> m Bool +canRetry :: (MonadIO m) => Either AWS.Error a -> m Bool canRetry (Right _) = pure False canRetry (Left e) = case e of AWS.TransportError (HttpExceptionRequest _ ResponseTimeout) -> pure True diff --git a/services/galley/src/Galley/Cassandra/Conversation.hs b/services/galley/src/Galley/Cassandra/Conversation.hs index 919b7b21836..5bc1fdc7ebe 100644 --- a/services/galley/src/Galley/Cassandra/Conversation.hs +++ b/services/galley/src/Galley/Cassandra/Conversation.hs @@ -389,11 +389,12 @@ toConv cid ms remoteMems mconv = do } updateToMixedProtocol :: - Members - '[ Embed IO, - Input ClientState - ] - r => + ( Members + '[ Embed IO, + Input ClientState + ] + r + ) => Local ConvId -> ConvType -> Sem r () @@ -407,11 +408,12 @@ updateToMixedProtocol lcnv ct = do pure () updateToMLSProtocol :: - Members - '[ Embed IO, - Input ClientState - ] - r => + ( Members + '[ Embed IO, + Input ClientState + ] + r + ) => Local ConvId -> Sem r () updateToMLSProtocol lcnv = diff --git a/services/galley/src/Galley/Cassandra/Conversation/Members.hs b/services/galley/src/Galley/Cassandra/Conversation/Members.hs index 4b0482f712b..26c3db667bd 100644 --- a/services/galley/src/Galley/Cassandra/Conversation/Members.hs +++ b/services/galley/src/Galley/Cassandra/Conversation/Members.hs @@ -369,7 +369,7 @@ addMLSClients groupId (Qualified usr domain) cs = retry x5 . batch $ do for_ cs $ \(c, idx) -> addPrepQuery Cql.addMLSClient (groupId, domain, usr, c, fromIntegral idx) -planMLSClientRemoval :: Foldable f => GroupId -> f ClientIdentity -> Client () +planMLSClientRemoval :: (Foldable f) => GroupId -> f ClientIdentity -> Client () planMLSClientRemoval groupId cids = retry x5 . batch $ do setType BatchLogged diff --git a/services/galley/src/Galley/Cassandra/CustomBackend.hs b/services/galley/src/Galley/Cassandra/CustomBackend.hs index f06f8187ac9..df0af160cec 100644 --- a/services/galley/src/Galley/Cassandra/CustomBackend.hs +++ b/services/galley/src/Galley/Cassandra/CustomBackend.hs @@ -50,7 +50,7 @@ interpretCustomBackendStoreToCassandra = interpret $ \case logEffect "CustomBackendStore.DeleteCustomBackend" embedClient $ deleteCustomBackend dom -getCustomBackend :: MonadClient m => Domain -> m (Maybe CustomBackend) +getCustomBackend :: (MonadClient m) => Domain -> m (Maybe CustomBackend) getCustomBackend domain = fmap toCustomBackend <$> do retry x1 $ query1 Cql.selectCustomBackend (params LocalQuorum (Identity domain)) @@ -58,10 +58,10 @@ getCustomBackend domain = toCustomBackend (backendConfigJsonUrl, backendWebappWelcomeUrl) = CustomBackend {..} -setCustomBackend :: MonadClient m => Domain -> CustomBackend -> m () +setCustomBackend :: (MonadClient m) => Domain -> CustomBackend -> m () setCustomBackend domain CustomBackend {..} = do retry x5 $ write Cql.upsertCustomBackend (params LocalQuorum (backendConfigJsonUrl, backendWebappWelcomeUrl, domain)) -deleteCustomBackend :: MonadClient m => Domain -> m () +deleteCustomBackend :: (MonadClient m) => Domain -> m () deleteCustomBackend domain = do retry x5 $ write Cql.deleteCustomBackend (params LocalQuorum (Identity domain)) diff --git a/services/galley/src/Galley/Cassandra/GetAllTeamFeatureConfigs.hs b/services/galley/src/Galley/Cassandra/GetAllTeamFeatureConfigs.hs index 7e35b485851..282e9d916c2 100644 --- a/services/galley/src/Galley/Cassandra/GetAllTeamFeatureConfigs.hs +++ b/services/galley/src/Galley/Cassandra/GetAllTeamFeatureConfigs.hs @@ -340,7 +340,7 @@ allFeatureConfigsFromRow ourteam allowListForExposeInvitationURLs featureLH hasT FeatureLegalHoldDisabledByDefault -> maybe False ((==) FeatureStatusEnabled) mStatusValue FeatureLegalHoldWhitelistTeamsAndImplicitConsent -> hasTeamImplicitLegalhold -getAllFeatureConfigs :: MonadClient m => Maybe [TeamId] -> FeatureLegalHold -> Bool -> AllFeatureConfigs -> TeamId -> m AllFeatureConfigs +getAllFeatureConfigs :: (MonadClient m) => Maybe [TeamId] -> FeatureLegalHold -> Bool -> AllFeatureConfigs -> TeamId -> m AllFeatureConfigs getAllFeatureConfigs allowListForExposeInvitationURLs featureLH hasTeamImplicitLegalhold serverConfigs tid = do mRow <- retry x1 $ query1 select (params LocalQuorum (Identity tid)) pure diff --git a/services/galley/src/Galley/Cassandra/LegalHold.hs b/services/galley/src/Galley/Cassandra/LegalHold.hs index ccc4b9c53f5..490e46dcaa9 100644 --- a/services/galley/src/Galley/Cassandra/LegalHold.hs +++ b/services/galley/src/Galley/Cassandra/LegalHold.hs @@ -109,23 +109,23 @@ interpretLegalHoldStoreToCassandra lh = interpret $ \case -- | Returns 'False' if legal hold is not enabled for this team -- The Caller is responsible for checking whether legal hold is enabled for this team -createSettings :: MonadClient m => LegalHoldService -> m () +createSettings :: (MonadClient m) => LegalHoldService -> m () createSettings (LegalHoldService tid url fpr tok key) = do retry x1 $ write Q.insertLegalHoldSettings (params LocalQuorum (url, fpr, tok, key, tid)) -- | Returns 'Nothing' if no settings are saved -- The Caller is responsible for checking whether legal hold is enabled for this team -getSettings :: MonadClient m => TeamId -> m (Maybe LegalHoldService) +getSettings :: (MonadClient m) => TeamId -> m (Maybe LegalHoldService) getSettings tid = fmap toLegalHoldService <$> do retry x1 $ query1 Q.selectLegalHoldSettings (params LocalQuorum (Identity tid)) where toLegalHoldService (httpsUrl, fingerprint, tok, key) = LegalHoldService tid httpsUrl fingerprint tok key -removeSettings :: MonadClient m => TeamId -> m () +removeSettings :: (MonadClient m) => TeamId -> m () removeSettings tid = retry x5 (write Q.removeLegalHoldSettings (params LocalQuorum (Identity tid))) -insertPendingPrekeys :: MonadClient m => UserId -> [Prekey] -> m () +insertPendingPrekeys :: (MonadClient m) => UserId -> [Prekey] -> m () insertPendingPrekeys uid keys = retry x5 . batch $ forM_ keys $ \key -> @@ -133,7 +133,7 @@ insertPendingPrekeys uid keys = retry x5 . batch $ where toTuple (Prekey keyId key) = (uid, keyId, key) -selectPendingPrekeys :: MonadClient m => UserId -> m (Maybe ([Prekey], LastPrekey)) +selectPendingPrekeys :: (MonadClient m) => UserId -> m (Maybe ([Prekey], LastPrekey)) selectPendingPrekeys uid = pickLastKey . fmap fromTuple <$> retry x1 (query Q.selectPendingPrekeys (params LocalQuorum (Identity uid))) @@ -144,18 +144,18 @@ selectPendingPrekeys uid = Nothing -> Nothing Just (keys, lst) -> pure (keys, lastPrekey . prekeyKey $ lst) -dropPendingPrekeys :: MonadClient m => UserId -> m () +dropPendingPrekeys :: (MonadClient m) => UserId -> m () dropPendingPrekeys uid = retry x5 (write Q.dropPendingPrekeys (params LocalQuorum (Identity uid))) -setUserLegalHoldStatus :: MonadClient m => TeamId -> UserId -> UserLegalHoldStatus -> m () +setUserLegalHoldStatus :: (MonadClient m) => TeamId -> UserId -> UserLegalHoldStatus -> m () setUserLegalHoldStatus tid uid status = retry x5 (write Q.updateUserLegalHoldStatus (params LocalQuorum (status, tid, uid))) -setTeamLegalholdWhitelisted :: MonadClient m => TeamId -> m () +setTeamLegalholdWhitelisted :: (MonadClient m) => TeamId -> m () setTeamLegalholdWhitelisted tid = retry x5 (write Q.insertLegalHoldWhitelistedTeam (params LocalQuorum (Identity tid))) -unsetTeamLegalholdWhitelisted :: MonadClient m => TeamId -> m () +unsetTeamLegalholdWhitelisted :: (MonadClient m) => TeamId -> m () unsetTeamLegalholdWhitelisted tid = retry x5 (write Q.removeLegalHoldWhitelistedTeam (params LocalQuorum (Identity tid))) @@ -171,7 +171,7 @@ isTeamLegalholdWhitelisted FeatureLegalHoldWhitelistTeamsAndImplicitConsent tid -- -- FUTUREWORK: It would be nice to move (part of) this to ssl-util, but it has types from -- brig-types and types-common. -validateServiceKey :: MonadIO m => ServiceKeyPEM -> m (Maybe (ServiceKey, Fingerprint Rsa)) +validateServiceKey :: (MonadIO m) => ServiceKeyPEM -> m (Maybe (ServiceKey, Fingerprint Rsa)) validateServiceKey pem = liftIO $ readPublicKey >>= \pk -> diff --git a/services/galley/src/Galley/Cassandra/SearchVisibility.hs b/services/galley/src/Galley/Cassandra/SearchVisibility.hs index 84505b5809a..bf656fd8204 100644 --- a/services/galley/src/Galley/Cassandra/SearchVisibility.hs +++ b/services/galley/src/Galley/Cassandra/SearchVisibility.hs @@ -49,7 +49,7 @@ interpretSearchVisibilityStoreToCassandra = interpret $ \case embedClient $ resetSearchVisibility tid -- | Return whether a given team is allowed to enable/disable sso -getSearchVisibility :: MonadClient m => TeamId -> m TeamSearchVisibility +getSearchVisibility :: (MonadClient m) => TeamId -> m TeamSearchVisibility getSearchVisibility tid = toSearchVisibility <$> do retry x1 $ query1 selectSearchVisibility (params LocalQuorum (Identity tid)) @@ -60,10 +60,10 @@ getSearchVisibility tid = toSearchVisibility _ = SearchVisibilityStandard -- | Determines whether a given team is allowed to enable/disable sso -setSearchVisibility :: MonadClient m => TeamId -> TeamSearchVisibility -> m () +setSearchVisibility :: (MonadClient m) => TeamId -> TeamSearchVisibility -> m () setSearchVisibility tid visibilityType = do retry x5 $ write updateSearchVisibility (params LocalQuorum (visibilityType, tid)) -resetSearchVisibility :: MonadClient m => TeamId -> m () +resetSearchVisibility :: (MonadClient m) => TeamId -> m () resetSearchVisibility tid = do retry x5 $ write updateSearchVisibility (params LocalQuorum (SearchVisibilityStandard, tid)) diff --git a/services/galley/src/Galley/Cassandra/Services.hs b/services/galley/src/Galley/Cassandra/Services.hs index 7e8012e2998..0b3e3fa15a7 100644 --- a/services/galley/src/Galley/Cassandra/Services.hs +++ b/services/galley/src/Galley/Cassandra/Services.hs @@ -67,7 +67,7 @@ interpretServiceStoreToCassandra = interpret $ \case logEffect "ServiceStore.DeleteService" embedClient $ deleteService sr -insertService :: MonadClient m => Bot.Service -> m () +insertService :: (MonadClient m) => Bot.Service -> m () insertService s = do let sid = s ^. Bot.serviceRef . serviceRefId let pid = s ^. Bot.serviceRef . serviceRefProvider @@ -77,7 +77,7 @@ insertService s = do let ena = s ^. Bot.serviceEnabled retry x5 $ write insertSrv (params LocalQuorum (pid, sid, url, tok, fps, ena)) -lookupService :: MonadClient m => ServiceRef -> m (Maybe Bot.Service) +lookupService :: (MonadClient m) => ServiceRef -> m (Maybe Bot.Service) lookupService s = fmap toService <$> retry x1 (query1 selectSrv (params LocalQuorum (s ^. serviceRefProvider, s ^. serviceRefId))) @@ -85,5 +85,5 @@ lookupService s = toService (url, tok, Set fps, ena) = Bot.newService s url tok fps & set Bot.serviceEnabled ena -deleteService :: MonadClient m => ServiceRef -> m () +deleteService :: (MonadClient m) => ServiceRef -> m () deleteService s = retry x5 (write rmSrv (params LocalQuorum (s ^. serviceRefProvider, s ^. serviceRefId))) diff --git a/services/galley/src/Galley/Cassandra/SubConversation.hs b/services/galley/src/Galley/Cassandra/SubConversation.hs index 4d775d02b99..b410e2bcc71 100644 --- a/services/galley/src/Galley/Cassandra/SubConversation.hs +++ b/services/galley/src/Galley/Cassandra/SubConversation.hs @@ -15,14 +15,10 @@ -- You should have received a copy of the GNU Affero General Public License along -- with this program. If not, see . -module Galley.Cassandra.SubConversation - ( interpretSubConversationStoreToCassandra, - ) -where +module Galley.Cassandra.SubConversation (interpretSubConversationStoreToCassandra) where import Cassandra import Cassandra.Util -import Control.Error.Util import Control.Monad.Trans.Maybe import Data.Id import Data.Map qualified as Map diff --git a/services/galley/src/Galley/Cassandra/TeamFeatures.hs b/services/galley/src/Galley/Cassandra/TeamFeatures.hs index 6df455cf557..618b242efaf 100644 --- a/services/galley/src/Galley/Cassandra/TeamFeatures.hs +++ b/services/galley/src/Galley/Cassandra/TeamFeatures.hs @@ -85,7 +85,7 @@ interpretTeamFeatureStoreToCassandra = interpret $ \case serverConfigs tid -getFeatureConfig :: MonadClient m => FeatureSingleton cfg -> TeamId -> m (Maybe (WithStatusNoLock cfg)) +getFeatureConfig :: (MonadClient m) => FeatureSingleton cfg -> TeamId -> m (Maybe (WithStatusNoLock cfg)) getFeatureConfig FeatureSingletonLegalholdConfig tid = getTrivialConfigC "legalhold_status" tid getFeatureConfig FeatureSingletonSSOConfig tid = getTrivialConfigC "sso_status" tid getFeatureConfig FeatureSingletonSearchVisibilityAvailableConfig tid = getTrivialConfigC "search_visibility_status" tid @@ -222,7 +222,7 @@ getFeatureConfig FeatureSingletonEnforceFileDownloadLocationConfig tid = do getFeatureConfig FeatureSingletonLimitedEventFanoutConfig tid = getTrivialConfigC "limited_event_fanout_status" tid -setFeatureConfig :: MonadClient m => FeatureSingleton cfg -> TeamId -> WithStatusNoLock cfg -> m () +setFeatureConfig :: (MonadClient m) => FeatureSingleton cfg -> TeamId -> WithStatusNoLock cfg -> m () setFeatureConfig FeatureSingletonLegalholdConfig tid statusNoLock = setFeatureStatusC "legalhold_status" tid (wssStatus statusNoLock) setFeatureConfig FeatureSingletonSSOConfig tid statusNoLock = setFeatureStatusC "sso_status" tid (wssStatus statusNoLock) setFeatureConfig FeatureSingletonSearchVisibilityAvailableConfig tid statusNoLock = setFeatureStatusC "search_visibility_status" tid (wssStatus statusNoLock) @@ -322,7 +322,7 @@ setFeatureConfig FeatureSingletonEnforceFileDownloadLocationConfig tid status = setFeatureConfig FeatureSingletonLimitedEventFanoutConfig tid statusNoLock = setFeatureStatusC "limited_event_fanout_status" tid (wssStatus statusNoLock) -getFeatureLockStatus :: MonadClient m => FeatureSingleton cfg -> TeamId -> m (Maybe LockStatus) +getFeatureLockStatus :: (MonadClient m) => FeatureSingleton cfg -> TeamId -> m (Maybe LockStatus) getFeatureLockStatus FeatureSingletonFileSharingConfig tid = getLockStatusC "file_sharing_lock_status" tid getFeatureLockStatus FeatureSingletonSelfDeletingMessagesConfig tid = getLockStatusC "self_deleting_messages_lock_status" tid getFeatureLockStatus FeatureSingletonGuestLinksConfig tid = getLockStatusC "guest_links_lock_status" tid @@ -334,7 +334,7 @@ getFeatureLockStatus FeatureSingletonMLSConfig tid = getLockStatusC "mls_lock_st getFeatureLockStatus FeatureSingletonEnforceFileDownloadLocationConfig tid = getLockStatusC "enforce_file_download_location_lock_status" tid getFeatureLockStatus _ _ = pure Nothing -setFeatureLockStatus :: MonadClient m => FeatureSingleton cfg -> TeamId -> LockStatus -> m () +setFeatureLockStatus :: (MonadClient m) => FeatureSingleton cfg -> TeamId -> LockStatus -> m () setFeatureLockStatus FeatureSingletonFileSharingConfig tid status = setLockStatusC "file_sharing_lock_status" tid status setFeatureLockStatus FeatureSingletonSelfDeletingMessagesConfig tid status = setLockStatusC "self_deleting_messages_lock_status" tid status setFeatureLockStatus FeatureSingletonGuestLinksConfig tid status = setLockStatusC "guest_links_lock_status" tid status @@ -399,7 +399,7 @@ getLockStatusC lockStatusCol tid = do <> " from team_features where team_id = ?" setLockStatusC :: - MonadClient m => + (MonadClient m) => String -> TeamId -> LockStatus -> diff --git a/services/galley/src/Galley/Cassandra/Util.hs b/services/galley/src/Galley/Cassandra/Util.hs index 2e3169fb523..f0cd114d5f4 100644 --- a/services/galley/src/Galley/Cassandra/Util.hs +++ b/services/galley/src/Galley/Cassandra/Util.hs @@ -23,5 +23,5 @@ import Polysemy import Polysemy.TinyLog import System.Logger.Message -logEffect :: Member TinyLog r => ByteString -> Sem r () +logEffect :: (Member TinyLog r) => ByteString -> Sem r () logEffect = debug . msg . val diff --git a/services/galley/src/Galley/Data/Types.hs b/services/galley/src/Galley/Data/Types.hs index 81feef99324..9cd3fe16257 100644 --- a/services/galley/src/Galley/Data/Types.hs +++ b/services/galley/src/Galley/Data/Types.hs @@ -76,7 +76,7 @@ toCode k s (val, ttl, cnv, mPw) = -- The 'key' is a stable, truncated, base64 encoded sha256 hash of the conversation ID -- The 'value' is a base64 encoded, 120-bit random value (changing on each generation) -generate :: MonadIO m => ConvId -> Scope -> Timeout -> m Code +generate :: (MonadIO m) => ConvId -> Scope -> Timeout -> m Code generate cnv s t = do key <- mkKey cnv val <- liftIO $ Value . unsafeRange . Ascii.encodeBase64Url <$> randBytes 15 @@ -90,7 +90,7 @@ generate cnv s t = do codeHasPassword = False } -mkKey :: MonadIO m => ConvId -> m Key +mkKey :: (MonadIO m) => ConvId -> m Key mkKey cnv = do sha256 <- liftIO $ fromJust <$> getDigestByName "SHA256" pure $ Key . unsafeRange . Ascii.encodeBase64Url . BS.take 15 $ digestBS sha256 (toByteString' cnv) diff --git a/services/galley/src/Galley/Effects/BackendNotificationQueueAccess.hs b/services/galley/src/Galley/Effects/BackendNotificationQueueAccess.hs index 9c2fe5d4004..fee78987c23 100644 --- a/services/galley/src/Galley/Effects/BackendNotificationQueueAccess.hs +++ b/services/galley/src/Galley/Effects/BackendNotificationQueueAccess.hs @@ -11,7 +11,7 @@ import Wire.API.Federation.Error data BackendNotificationQueueAccess m a where EnqueueNotification :: - KnownComponent c => + (KnownComponent c) => Q.DeliveryMode -> Remote x -> FedQueueClient c a -> diff --git a/services/galley/src/Galley/Effects/BrigAccess.hs b/services/galley/src/Galley/Effects/BrigAccess.hs index 642a3ab4c10..c825a3e7129 100644 --- a/services/galley/src/Galley/Effects/BrigAccess.hs +++ b/services/galley/src/Galley/Effects/BrigAccess.hs @@ -130,7 +130,7 @@ data BrigAccess m a where makeSem ''BrigAccess -getUser :: Member BrigAccess r => UserId -> Sem r (Maybe UserAccount) +getUser :: (Member BrigAccess r) => UserId -> Sem r (Maybe UserAccount) getUser = fmap listToMaybe . getUsers . pure addLegalHoldClientToUser :: diff --git a/services/galley/src/Galley/Effects/ConversationStore.hs b/services/galley/src/Galley/Effects/ConversationStore.hs index 234dfa64bda..d85d2258e85 100644 --- a/services/galley/src/Galley/Effects/ConversationStore.hs +++ b/services/galley/src/Galley/Effects/ConversationStore.hs @@ -106,5 +106,5 @@ data ConversationStore m a where makeSem ''ConversationStore -acceptConnectConversation :: Member ConversationStore r => ConvId -> Sem r () +acceptConnectConversation :: (Member ConversationStore r) => ConvId -> Sem r () acceptConnectConversation cid = setConversationType cid One2OneConv diff --git a/services/galley/src/Galley/Effects/ExternalAccess.hs b/services/galley/src/Galley/Effects/ExternalAccess.hs index 095ecb75b78..e2d0bb75404 100644 --- a/services/galley/src/Galley/Effects/ExternalAccess.hs +++ b/services/galley/src/Galley/Effects/ExternalAccess.hs @@ -33,8 +33,8 @@ import Polysemy import Wire.API.Event.Conversation data ExternalAccess m a where - Deliver :: Foldable f => f (BotMember, Event) -> ExternalAccess m [BotMember] + Deliver :: (Foldable f) => f (BotMember, Event) -> ExternalAccess m [BotMember] DeliverAsync :: (Foldable f) => f (BotMember, Event) -> ExternalAccess m () - DeliverAndDeleteAsync :: Foldable f => ConvId -> f (BotMember, Event) -> ExternalAccess m () + DeliverAndDeleteAsync :: (Foldable f) => ConvId -> f (BotMember, Event) -> ExternalAccess m () makeSem ''ExternalAccess diff --git a/services/galley/src/Galley/Effects/FederatorAccess.hs b/services/galley/src/Galley/Effects/FederatorAccess.hs index cfa3b508c76..eaa5e70ba01 100644 --- a/services/galley/src/Galley/Effects/FederatorAccess.hs +++ b/services/galley/src/Galley/Effects/FederatorAccess.hs @@ -39,12 +39,12 @@ import Wire.API.Federation.Error data FederatorAccess m a where RunFederated :: - KnownComponent c => + (KnownComponent c) => Remote x -> FederatorClient c a -> FederatorAccess m a RunFederatedEither :: - KnownComponent c => + (KnownComponent c) => Remote x -> FederatorClient c a -> FederatorAccess m (Either FederationError a) diff --git a/services/galley/src/Galley/Effects/FireAndForget.hs b/services/galley/src/Galley/Effects/FireAndForget.hs index 0a99f3c5551..b78264acaf3 100644 --- a/services/galley/src/Galley/Effects/FireAndForget.hs +++ b/services/galley/src/Galley/Effects/FireAndForget.hs @@ -36,14 +36,14 @@ data FireAndForget m a where makeSem ''FireAndForget -fireAndForget :: Member FireAndForget r => Sem r () -> Sem r () +fireAndForget :: (Member FireAndForget r) => Sem r () -> Sem r () fireAndForget = fireAndForgetOne -- | Run actions in separate threads and ignore results. -- -- /Note/: this will also ignore any state and error effects contained in the -- 'FireAndForget' action. Use with care. -interpretFireAndForget :: Member (Final IO) r => Sem (FireAndForget ': r) a -> Sem r a +interpretFireAndForget :: (Member (Final IO) r) => Sem (FireAndForget ': r) a -> Sem r a interpretFireAndForget = interpretFinal @IO $ \case FireAndForgetOne action -> do action' <- runS action diff --git a/services/galley/src/Galley/Effects/MemberStore.hs b/services/galley/src/Galley/Effects/MemberStore.hs index 0513cc6570e..e1e0d4c372f 100644 --- a/services/galley/src/Galley/Effects/MemberStore.hs +++ b/services/galley/src/Galley/Effects/MemberStore.hs @@ -86,7 +86,7 @@ data MemberStore m a where DeleteMembers :: ConvId -> UserList UserId -> MemberStore m () DeleteMembersInRemoteConversation :: Remote ConvId -> [UserId] -> MemberStore m () AddMLSClients :: GroupId -> Qualified UserId -> Set (ClientId, LeafIndex) -> MemberStore m () - PlanClientRemoval :: Foldable f => GroupId -> f ClientIdentity -> MemberStore m () + PlanClientRemoval :: (Foldable f) => GroupId -> f ClientIdentity -> MemberStore m () RemoveMLSClients :: GroupId -> Qualified UserId -> Set ClientId -> MemberStore m () RemoveAllMLSClients :: GroupId -> MemberStore m () LookupMLSClients :: GroupId -> MemberStore m ClientMap diff --git a/services/galley/src/Galley/Effects/TeamStore.hs b/services/galley/src/Galley/Effects/TeamStore.hs index cf0a2257156..bd403e17f55 100644 --- a/services/galley/src/Galley/Effects/TeamStore.hs +++ b/services/galley/src/Galley/Effects/TeamStore.hs @@ -141,7 +141,7 @@ data TeamStore m a where makeSem ''TeamStore listTeams :: - Member (ListItems p TeamId) r => + (Member (ListItems p TeamId) r) => UserId -> Maybe (PagingState p TeamId) -> PagingBounds p TeamId -> diff --git a/services/galley/src/Galley/External/LegalHoldService/Internal.hs b/services/galley/src/Galley/External/LegalHoldService/Internal.hs index 6923ebf02da..6cf5cabe5bf 100644 --- a/services/galley/src/Galley/External/LegalHoldService/Internal.hs +++ b/services/galley/src/Galley/External/LegalHoldService/Internal.hs @@ -67,7 +67,7 @@ makeVerifiedRequestWithManager mgr verifyFingerprints fpr (HttpsUrl url) reqBuil a b = fromMaybe a (BS.stripSuffix "/" a) <> "/" <> fromMaybe b (BS.stripPrefix "/" b) x3 :: RetryPolicy x3 = limitRetries 3 <> exponentialBackoff 100000 - extHandleAll :: MonadCatch m => (SomeException -> m a) -> m a -> m a + extHandleAll :: (MonadCatch m) => (SomeException -> m a) -> m a -> m a extHandleAll f ma = catches ma diff --git a/services/galley/src/Galley/Intra/Federator.hs b/services/galley/src/Galley/Intra/Federator.hs index 565cd417d3e..6c35754d292 100644 --- a/services/galley/src/Galley/Intra/Federator.hs +++ b/services/galley/src/Galley/Intra/Federator.hs @@ -18,7 +18,6 @@ module Galley.Intra.Federator (interpretFederatorAccess) where import Control.Lens -import Control.Monad.Except import Data.Bifunctor import Data.Qualified import Galley.Cassandra.Util @@ -113,7 +112,7 @@ runFederatedConcurrentlyEither xs rpc = bimap (r,) (qualifyAs r) <$> runFederatedEither r (rpc r) runFederatedConcurrentlyBucketsEither :: - Foldable f => + (Foldable f) => f (Remote x) -> (Remote x -> FederatorClient c b) -> App [Either (Remote x, FederationError) (Remote b)] diff --git a/services/galley/src/Galley/Intra/User.hs b/services/galley/src/Galley/Intra/User.hs index 27b3497afae..5419b68ecea 100644 --- a/services/galley/src/Galley/Intra/User.hs +++ b/services/galley/src/Galley/Intra/User.hs @@ -238,7 +238,7 @@ getRichInfoMultiUser = chunkify $ \uids -> do . expect2xx parseResponse (mkError status502 "server-error: could not parse response to `GET brig:/i/users/rich-info`") resp -getAccountConferenceCallingConfigClient :: HasCallStack => UserId -> App (WithStatusNoLock ConferenceCallingConfig) +getAccountConferenceCallingConfigClient :: (HasCallStack) => UserId -> App (WithStatusNoLock ConferenceCallingConfig) getAccountConferenceCallingConfigClient uid = runHereClientM (namedClient @IAPI.API @"get-account-conference-calling-config" uid) >>= handleServantResp @@ -247,9 +247,9 @@ updateSearchVisibilityInbound :: Multi.TeamStatus SearchVisibilityInboundConfig updateSearchVisibilityInbound = handleServantResp <=< runHereClientM - . namedClient @IAPI.API @"updateSearchVisibilityInbound" + . namedClient @IAPI.API @"updateSearchVisibilityInbound" -runHereClientM :: HasCallStack => Client.ClientM a -> App (Either Client.ClientError a) +runHereClientM :: (HasCallStack) => Client.ClientM a -> App (Either Client.ClientError a) runHereClientM action = do mgr <- view manager brigep <- view brig diff --git a/services/galley/src/Galley/Monad.hs b/services/galley/src/Galley/Monad.hs index f1a30b8b8a0..43af4e1dc20 100644 --- a/services/galley/src/Galley/Monad.hs +++ b/services/galley/src/Galley/Monad.hs @@ -24,7 +24,6 @@ import Bilge.RPC import Cassandra import Control.Lens import Control.Monad.Catch -import Control.Monad.Except import Galley.Env import Imports hiding (log) import Polysemy diff --git a/services/galley/src/Galley/Queue.hs b/services/galley/src/Galley/Queue.hs index 2ec064374ba..de320bde244 100644 --- a/services/galley/src/Galley/Queue.hs +++ b/services/galley/src/Galley/Queue.hs @@ -38,10 +38,10 @@ data Queue a = Queue _queue :: Stm.TBQueue a } -new :: MonadIO m => Natural -> m (Queue a) +new :: (MonadIO m) => Natural -> m (Queue a) new n = liftIO $ Queue <$> Stm.newTVarIO 0 <*> Stm.newTBQueueIO n -tryPush :: MonadIO m => Queue a -> a -> m Bool +tryPush :: (MonadIO m) => Queue a -> a -> m Bool tryPush q a = liftIO . atomically $ do isFull <- Stm.isFullTBQueue (_queue q) unless isFull $ do @@ -49,16 +49,16 @@ tryPush q a = liftIO . atomically $ do Stm.writeTBQueue (_queue q) a pure (not isFull) -pop :: MonadIO m => Queue a -> m a +pop :: (MonadIO m) => Queue a -> m a pop q = liftIO . atomically $ do Stm.modifyTVar' (_len q) (pred . max 1) Stm.readTBQueue (_queue q) -len :: MonadIO m => Queue a -> m Word +len :: (MonadIO m) => Queue a -> m Word len q = liftIO $ Stm.readTVarIO (_len q) interpretQueue :: - Member (Embed IO) r => + (Member (Embed IO) r) => Queue a -> Sem (E.Queue a ': r) x -> Sem r x diff --git a/services/galley/src/Galley/Types/UserList.hs b/services/galley/src/Galley/Types/UserList.hs index 3dbc81444de..071403b5c9d 100644 --- a/services/galley/src/Galley/Types/UserList.hs +++ b/services/galley/src/Galley/Types/UserList.hs @@ -43,7 +43,7 @@ instance Semigroup (UserList a) where instance Monoid (UserList a) where mempty = UserList mempty mempty -toUserList :: Foldable f => Local x -> f (Qualified a) -> UserList a +toUserList :: (Foldable f) => Local x -> f (Qualified a) -> UserList a toUserList loc = uncurry UserList . partitionQualified loc ulAddLocal :: a -> UserList a -> UserList a @@ -59,7 +59,7 @@ ulFromRemotes :: [Remote a] -> UserList a ulFromRemotes = UserList [] -- | Remove from the first list all the users that are in the second list. -ulDiff :: Eq a => UserList a -> UserList a -> UserList a +ulDiff :: (Eq a) => UserList a -> UserList a -> UserList a ulDiff (UserList lA rA) (UserList lB rB) = UserList (filter (`notElem` lB) lA) diff --git a/services/galley/src/Galley/Validation.hs b/services/galley/src/Galley/Validation.hs index 964963e4e65..7d045d21026 100644 --- a/services/galley/src/Galley/Validation.hs +++ b/services/galley/src/Galley/Validation.hs @@ -51,9 +51,9 @@ rangeCheckedMaybe (Just a) = Just <$> rangeChecked a newtype ConvSizeChecked f a = ConvSizeChecked {fromConvSize :: f a} deriving (Functor, Foldable, Traversable) -deriving newtype instance Semigroup (f a) => Semigroup (ConvSizeChecked f a) +deriving newtype instance (Semigroup (f a)) => Semigroup (ConvSizeChecked f a) -deriving newtype instance Monoid (f a) => Monoid (ConvSizeChecked f a) +deriving newtype instance (Monoid (f a)) => Monoid (ConvSizeChecked f a) checkedConvSize :: (Member (Error InvalidInput) r, Foldable f) => @@ -67,5 +67,5 @@ checkedConvSize o x = do then pure (ConvSizeChecked x) else throwErr (errorMsg minV limit "") -throwErr :: Member (Error InvalidInput) r => String -> Sem r a +throwErr :: (Member (Error InvalidInput) r) => String -> Sem r a throwErr = throw . InvalidRange . fromString diff --git a/services/galley/test/integration/API.hs b/services/galley/test/integration/API.hs index 62c10b3e20a..2a6c1f3a8bf 100644 --- a/services/galley/test/integration/API.hs +++ b/services/galley/test/integration/API.hs @@ -1808,7 +1808,7 @@ paginateConvListIdsPageEndingAtLocalsAndDomain = do -- to go, when this is 0, it is assumed that this chunk is last and the response -- must set @has_more@ to 'False' and the number of conv ids returned should -- match @lastSize@. -getChunkedConvs :: HasCallStack => Int32 -> Int -> UserId -> Maybe ConversationPagingState -> Int -> TestM (Maybe ConversationPagingState) +getChunkedConvs :: (HasCallStack) => Int32 -> Int -> UserId -> Maybe ConversationPagingState -> Int -> TestM (Maybe ConversationPagingState) getChunkedConvs size lastSize alice pagingState n = do resp <- getConvPage alice pagingState (Just size) UserId -> t Int -> TestM () + walk :: (Foldable t) => UserId -> t Int -> TestM () walk u = foldM_ (next u 3) Nothing next :: @@ -2006,7 +2006,7 @@ postConvQualifiedFederationNotEnabled = do -- like postConvQualified -- FUTUREWORK: figure out how to use functions in the TestM monad inside withSettingsOverrides and remove this duplication -postConvHelper :: MonadHttp m => (Request -> Request) -> UserId -> [Qualified UserId] -> m ResponseLBS +postConvHelper :: (MonadHttp m) => (Request -> Request) -> UserId -> [Qualified UserId] -> m ResponseLBS postConvHelper g zusr newUsers = do let conv = NewConv [] newUsers (checked "gossip") (Set.fromList []) Nothing Nothing Nothing Nothing roleNameWireAdmin BaseProtocolProteusTag post $ g . path "/conversations" . zUser zusr . zConn "conn" . zType "access" . json conv diff --git a/services/galley/test/integration/API/Federation/Util.hs b/services/galley/test/integration/API/Federation/Util.hs index 9f2f052365c..c4e6a41ea49 100644 --- a/services/galley/test/integration/API/Federation/Util.hs +++ b/services/galley/test/integration/API/Federation/Util.hs @@ -44,22 +44,22 @@ class HasTrivialHandler api where instance HasTrivialHandler (Verb m c cs a) where trivialHandler name = throwError err501 {errBody = cs ("mock not implemented: " <> name)} -instance HasTrivialHandler api => HasTrivialHandler ((path :: Symbol) :> api) where +instance (HasTrivialHandler api) => HasTrivialHandler ((path :: Symbol) :> api) where trivialHandler = trivialHandler @api -instance HasTrivialHandler api => HasTrivialHandler (OriginDomainHeader :> api) where +instance (HasTrivialHandler api) => HasTrivialHandler (OriginDomainHeader :> api) where trivialHandler name _ = trivialHandler @api name -instance HasTrivialHandler api => HasTrivialHandler (MakesFederatedCall comp name :> api) where +instance (HasTrivialHandler api) => HasTrivialHandler (MakesFederatedCall comp name :> api) where trivialHandler name _ = trivialHandler @api name -instance HasTrivialHandler api => HasTrivialHandler (ReqBody cs a :> api) where +instance (HasTrivialHandler api) => HasTrivialHandler (ReqBody cs a :> api) where trivialHandler name _ = trivialHandler @api name -instance HasTrivialHandler api => HasTrivialHandler (Until v :> api) where +instance (HasTrivialHandler api) => HasTrivialHandler (Until v :> api) where trivialHandler = trivialHandler @api -instance HasTrivialHandler api => HasTrivialHandler (From v :> api) where +instance (HasTrivialHandler api) => HasTrivialHandler (From v :> api) where trivialHandler = trivialHandler @api trivialNamedHandler :: diff --git a/services/galley/test/integration/API/MLS/Mocks.hs b/services/galley/test/integration/API/MLS/Mocks.hs index 69cd62f2902..49165e64bc7 100644 --- a/services/galley/test/integration/API/MLS/Mocks.hs +++ b/services/galley/test/integration/API/MLS/Mocks.hs @@ -49,8 +49,8 @@ receiveCommitMock clients = asum [ "on-conversation-updated" ~> EmptyResponse, "get-not-fully-connected-backends" ~> NonConnectedBackends mempty, - "get-mls-clients" ~> - Set.fromList + "get-mls-clients" + ~> Set.fromList ( map (flip ClientInfo True . ciClient) clients ) ] @@ -82,8 +82,8 @@ welcomeMockByDomain reachables = do sendMessageMock :: Mock LByteString sendMessageMock = - "send-mls-message" ~> - MLSMessageResponseUpdates + "send-mls-message" + ~> MLSMessageResponseUpdates [] claimKeyPackagesMock :: KeyPackageBundle -> Mock LByteString diff --git a/services/galley/test/integration/API/MLS/Util.hs b/services/galley/test/integration/API/MLS/Util.hs index 3c38958eb58..978f7ab4d14 100644 --- a/services/galley/test/integration/API/MLS/Util.hs +++ b/services/galley/test/integration/API/MLS/Util.hs @@ -177,7 +177,7 @@ remotePostCommitBundle rsender qcs bundle = do MLSMessageResponseUpdates _ -> pure [] postCommitBundle :: - HasCallStack => + (HasCallStack) => ClientIdentity -> Qualified ConvOrSubConvId -> ByteString -> @@ -270,7 +270,7 @@ data MessagePackage = MessagePackage } deriving (Show) -takeLastPrekeyNG :: HasCallStack => MLSTest LastPrekey +takeLastPrekeyNG :: (HasCallStack) => MLSTest LastPrekey takeLastPrekeyNG = do s <- State.get case mlsUnusedPrekeys s of @@ -290,7 +290,7 @@ randomFileName = do bd <- State.gets mlsBaseDir (bd ) . UUID.toString <$> liftIO UUIDV4.nextRandom -mlscli :: HasCallStack => ClientIdentity -> [String] -> Maybe ByteString -> MLSTest ByteString +mlscli :: (HasCallStack) => ClientIdentity -> [String] -> Maybe ByteString -> MLSTest ByteString mlscli qcid args mbstdin = do bd <- State.gets mlsBaseDir let cdir = bd cid2Str qcid @@ -328,13 +328,13 @@ argSubst :: String -> String -> String -> String argSubst from to_ s = if s == from then to_ else s -createWireClient :: HasCallStack => Qualified UserId -> MLSTest ClientIdentity +createWireClient :: (HasCallStack) => Qualified UserId -> MLSTest ClientIdentity createWireClient qusr = do lpk <- takeLastPrekeyNG clientId <- liftTest $ randomClient (qUnqualified qusr) lpk pure $ mkClientIdentity qusr clientId -initMLSClient :: HasCallStack => ClientIdentity -> MLSTest () +initMLSClient :: (HasCallStack) => ClientIdentity -> MLSTest () initMLSClient cid = do bd <- State.gets mlsBaseDir createDirectory $ bd cid2Str cid @@ -360,13 +360,13 @@ createLocalMLSClient (tUntagged -> qusr) = do -- | Create new mls client and register with backend. If the user is remote, -- this only creates a fake client (see 'createFakeMLSClient'). -createMLSClient :: HasCallStack => Qualified UserId -> MLSTest ClientIdentity +createMLSClient :: (HasCallStack) => Qualified UserId -> MLSTest ClientIdentity createMLSClient qusr = do loc <- liftTest $ qualifyLocal () foldQualified loc createLocalMLSClient (createFakeMLSClient . tUntagged) qusr -- | Like 'createMLSClient', but do not actually register client with backend. -createFakeMLSClient :: HasCallStack => Qualified UserId -> MLSTest ClientIdentity +createFakeMLSClient :: (HasCallStack) => Qualified UserId -> MLSTest ClientIdentity createFakeMLSClient qusr = do c <- liftIO $ generate arbitrary let cid = mkClientIdentity qusr c @@ -374,7 +374,7 @@ createFakeMLSClient qusr = do pure cid -- | create and upload to backend -uploadNewKeyPackage :: HasCallStack => ClientIdentity -> MLSTest (RawMLS KeyPackage) +uploadNewKeyPackage :: (HasCallStack) => ClientIdentity -> MLSTest (RawMLS KeyPackage) uploadNewKeyPackage qcid = do (kp, _) <- generateKeyPackage qcid @@ -389,33 +389,33 @@ uploadNewKeyPackage qcid = do !!! const 201 === statusCode pure kp -generateKeyPackage :: HasCallStack => ClientIdentity -> MLSTest (RawMLS KeyPackage, KeyPackageRef) +generateKeyPackage :: (HasCallStack) => ClientIdentity -> MLSTest (RawMLS KeyPackage, KeyPackageRef) generateKeyPackage qcid = do kpData <- mlscli qcid ["key-package", "create"] Nothing kp <- liftIO $ decodeMLSError kpData let ref = fromJust (kpRef' kp) pure (kp, ref) -setClientGroupState :: HasCallStack => ClientIdentity -> ByteString -> MLSTest () +setClientGroupState :: (HasCallStack) => ClientIdentity -> ByteString -> MLSTest () setClientGroupState cid g = State.modify $ \s -> s {mlsClientGroupState = Map.insert cid g (mlsClientGroupState s)} -getClientGroupState :: HasCallStack => ClientIdentity -> MLSTest ByteString +getClientGroupState :: (HasCallStack) => ClientIdentity -> MLSTest ByteString getClientGroupState cid = do mgs <- State.gets (Map.lookup cid . mlsClientGroupState) case mgs of Nothing -> liftIO $ assertFailure ("Attempted to get non-existing group state for client " <> show cid) Just g -> pure g -hasClientGroupState :: HasCallStack => ClientIdentity -> MLSTest Bool +hasClientGroupState :: (HasCallStack) => ClientIdentity -> MLSTest Bool hasClientGroupState cid = State.gets (isJust . Map.lookup cid . mlsClientGroupState) -- | Create a conversation from a provided action and then create a -- corresponding group. setupMLSGroupWithConv :: - HasCallStack => + (HasCallStack) => MLSTest Conversation -> ClientIdentity -> MLSTest (GroupId, Qualified ConvId) @@ -435,7 +435,7 @@ setupMLSGroupWithConv convAction creator = do pure (groupId, qcnv) -- | Create conversation and corresponding group. -setupMLSGroup :: HasCallStack => ClientIdentity -> MLSTest (GroupId, Qualified ConvId) +setupMLSGroup :: (HasCallStack) => ClientIdentity -> MLSTest (GroupId, Qualified ConvId) setupMLSGroup creator = setupMLSGroupWithConv action creator where action = @@ -449,7 +449,7 @@ setupMLSGroup creator = setupMLSGroupWithConv action creator ClientIdentity -> MLSTest (GroupId, Qualified ConvId) +setupMLSSelfGroup :: (HasCallStack) => ClientIdentity -> MLSTest (GroupId, Qualified ConvId) setupMLSSelfGroup creator = setupMLSGroupWithConv action creator where action = @@ -498,7 +498,7 @@ getConvId = >>= maybe (liftIO (assertFailure "Uninitialised test conversation")) pure createSubConv :: - HasCallStack => + (HasCallStack) => Qualified ConvId -> ClientIdentity -> SubConvId -> @@ -517,7 +517,7 @@ createSubConv qcnv creator subId = do -- | Create a local group only without a conversation. This simulates creating -- an MLS conversation on a remote backend. setupFakeMLSGroup :: - HasCallStack => + (HasCallStack) => ClientIdentity -> Maybe SubConvId -> MLSTest (GroupId, Qualified ConvId) @@ -527,7 +527,7 @@ setupFakeMLSGroup creator mSubId = do createGroup creator (fmap Conv qcnv) groupId pure (groupId, qcnv) -claimLocalKeyPackages :: HasCallStack => ClientIdentity -> Local UserId -> MLSTest KeyPackageBundle +claimLocalKeyPackages :: (HasCallStack) => ClientIdentity -> Local UserId -> MLSTest KeyPackageBundle claimLocalKeyPackages qcid lusr = do brigCall <- viewBrig responseJsonError @@ -539,7 +539,7 @@ claimLocalKeyPackages qcid lusr = do Qualified UserId -> MLSTest [ClientIdentity] +getUserClients :: (HasCallStack) => Qualified UserId -> MLSTest [ClientIdentity] getUserClients qusr = do bd <- State.gets mlsBaseDir files <- getDirectoryContents bd @@ -550,7 +550,7 @@ getUserClients qusr = do pure . mapMaybe toClient $ files -- | Generate one key package for each client of a remote user -claimRemoteKeyPackages :: HasCallStack => Remote UserId -> MLSTest KeyPackageBundle +claimRemoteKeyPackages :: (HasCallStack) => Remote UserId -> MLSTest KeyPackageBundle claimRemoteKeyPackages (tUntagged -> qusr) = do clients <- getUserClients qusr fmap (KeyPackageBundle . Set.fromList) $ @@ -566,7 +566,7 @@ claimRemoteKeyPackages (tUntagged -> qusr) = do -- | Claim key package for a local user, or generate and map key packages for remote ones. claimKeyPackages :: - HasCallStack => + (HasCallStack) => ClientIdentity -> Qualified UserId -> MLSTest KeyPackageBundle @@ -586,14 +586,14 @@ bundleKeyPackages bundle = -- Note that this alters the state of the group immediately. If we want to test -- a scenario where the commit is rejected by the backend, we can restore the -- group to the previous state by using an older version of the group file. -createAddCommit :: HasCallStack => ClientIdentity -> [Qualified UserId] -> MLSTest MessagePackage +createAddCommit :: (HasCallStack) => ClientIdentity -> [Qualified UserId] -> MLSTest MessagePackage createAddCommit cid users = do kps <- fmap (concatMap bundleKeyPackages) . traverse (claimKeyPackages cid) $ users liftIO $ assertBool "no key packages could be claimed" (not (null kps)) createAddCommitWithKeyPackages cid kps createExternalCommit :: - HasCallStack => + (HasCallStack) => ClientIdentity -> Maybe ByteString -> Qualified ConvOrSubConvId -> @@ -633,14 +633,14 @@ createExternalCommit qcid mpgs qcs = do mpGroupInfo = Just newPgs } -createAddProposals :: HasCallStack => ClientIdentity -> [Qualified UserId] -> MLSTest [MessagePackage] +createAddProposals :: (HasCallStack) => ClientIdentity -> [Qualified UserId] -> MLSTest [MessagePackage] createAddProposals cid users = do kps <- fmap (concatMap bundleKeyPackages) . traverse (claimKeyPackages cid) $ users traverse (createAddProposalWithKeyPackage cid) kps -- | Create an application message. createApplicationMessage :: - HasCallStack => + (HasCallStack) => ClientIdentity -> String -> MLSTest MessagePackage @@ -660,7 +660,7 @@ createApplicationMessage cid messageContent = do } createAddCommitWithKeyPackages :: - HasCallStack => + (HasCallStack) => ClientIdentity -> [(ClientIdentity, ByteString)] -> MLSTest MessagePackage @@ -720,7 +720,7 @@ createAddProposalWithKeyPackage cid (_, kp) = do mpGroupInfo = Nothing } -createPendingProposalCommit :: HasCallStack => ClientIdentity -> MLSTest MessagePackage +createPendingProposalCommit :: (HasCallStack) => ClientIdentity -> MLSTest MessagePackage createPendingProposalCommit qcid = do bd <- State.gets mlsBaseDir welcomeFile <- liftIO $ emptyTempFile bd "welcome" @@ -757,7 +757,7 @@ readWelcome fp = runMaybeT $ do guard $ fileSize stat > 0 liftIO $ BS.readFile fp -createRemoveCommit :: HasCallStack => ClientIdentity -> [ClientIdentity] -> MLSTest MessagePackage +createRemoveCommit :: (HasCallStack) => ClientIdentity -> [ClientIdentity] -> MLSTest MessagePackage createRemoveCommit cid targets = do bd <- State.gets mlsBaseDir welcomeFile <- liftIO $ emptyTempFile bd "welcome" @@ -794,7 +794,7 @@ createRemoveCommit cid targets = do mpGroupInfo = Just pgs } -createExternalAddProposal :: HasCallStack => ClientIdentity -> MLSTest MessagePackage +createExternalAddProposal :: (HasCallStack) => ClientIdentity -> MLSTest MessagePackage createExternalAddProposal joiner = do groupId <- State.gets mlsGroupId >>= \case @@ -825,7 +825,7 @@ createExternalAddProposal joiner = do mpGroupInfo = Nothing } -consumeWelcome :: HasCallStack => ByteString -> MLSTest () +consumeWelcome :: (HasCallStack) => ByteString -> MLSTest () consumeWelcome welcome = do qcids <- State.gets mlsNewMembers for_ qcids $ \qcid -> do @@ -843,13 +843,13 @@ consumeWelcome welcome = do (Just welcome) -- | Make all member clients consume a given message. -consumeMessage :: HasCallStack => MessagePackage -> MLSTest () +consumeMessage :: (HasCallStack) => MessagePackage -> MLSTest () consumeMessage msg = do mems <- State.gets mlsMembers for_ (Set.delete (mpSender msg) mems) $ \cid -> consumeMessage1 cid (mpMessage msg) -consumeMessage1 :: HasCallStack => ClientIdentity -> ByteString -> MLSTest () +consumeMessage1 :: (HasCallStack) => ClientIdentity -> ByteString -> MLSTest () consumeMessage1 cid msg = void $ mlscli @@ -865,7 +865,7 @@ consumeMessage1 cid msg = -- | Send an MLS message and simulate clients receiving it. If the message is a -- commit, the 'sendAndConsumeCommitBundle' function should be used instead. -sendAndConsumeMessage :: HasCallStack => MessagePackage -> MLSTest [Event] +sendAndConsumeMessage :: (HasCallStack) => MessagePackage -> MLSTest [Event] sendAndConsumeMessage mp = do for_ mp.mpWelcome $ \_ -> liftIO $ assertFailure "use sendAndConsumeCommitBundle" res <- @@ -895,7 +895,7 @@ createBundle mp = do mkBundle mp pure (encodeMLS' bundle) -sendAndConsumeCommitBundle :: HasCallStack => MessagePackage -> MLSTest [Event] +sendAndConsumeCommitBundle :: (HasCallStack) => MessagePackage -> MLSTest [Event] sendAndConsumeCommitBundle mp = do qcs <- getConvId bundle <- createBundle mp @@ -914,7 +914,7 @@ sendAndConsumeCommitBundle mp = do pure resp mlsBracket :: - HasCallStack => + (HasCallStack) => [ClientIdentity] -> ([WS.WebSocket] -> MLSTest a) -> MLSTest a @@ -985,7 +985,7 @@ receiveOnConvUpdated conv origUser joiner = do (qDomain conv) cu -getGroupInfo :: HasCallStack => Qualified UserId -> Qualified ConvOrSubConvId -> TestM ByteString +getGroupInfo :: (HasCallStack) => Qualified UserId -> Qualified ConvOrSubConvId -> TestM ByteString getGroupInfo qusr qcs = do loc <- qualifyLocal () foldQualified @@ -1068,7 +1068,7 @@ getSelfConv u = do . zConn "conn" . zType "access" -withMLSDisabled :: HasSettingsOverrides m => m a -> m a +withMLSDisabled :: (HasSettingsOverrides m) => m a -> m a withMLSDisabled = withSettingsOverrides noMLS where noMLS = Opts.settings . Opts.mlsPrivateKeyPaths .~ Nothing @@ -1162,7 +1162,7 @@ remoteLeaveCurrentConv rcid qcnv subId = do LeaveSubConversationResponseOk -> pure () leaveCurrentConv :: - HasCallStack => + (HasCallStack) => ClientIdentity -> Qualified ConvOrSubConvId -> MLSTest () diff --git a/services/galley/test/integration/API/Roles.hs b/services/galley/test/integration/API/Roles.hs index 1fdf61a1e4b..898f42dc8a7 100644 --- a/services/galley/test/integration/API/Roles.hs +++ b/services/galley/test/integration/API/Roles.hs @@ -316,10 +316,10 @@ testAccessRoleUpdateV2 = do -------------------------------------------------------------------------------- -- Utilities -assertActionSucceeded :: HasCallStack => Assertions () +assertActionSucceeded :: (HasCallStack) => Assertions () assertActionSucceeded = const 200 === statusCode -assertActionDenied :: HasCallStack => Assertions () +assertActionDenied :: (HasCallStack) => Assertions () assertActionDenied = do const 403 === statusCode const (Just "action-denied") === fmap label . responseJsonUnsafe diff --git a/services/galley/test/integration/API/SQS.hs b/services/galley/test/integration/API/SQS.hs index 16c7307c012..2057433b150 100644 --- a/services/galley/test/integration/API/SQS.hs +++ b/services/galley/test/integration/API/SQS.hs @@ -42,13 +42,13 @@ import Test.Tasty.HUnit import TestSetup import Util.Test.SQS qualified as SQS -withTeamEventWatcher :: HasCallStack => (SQS.SQSWatcher TeamEvent -> TestM ()) -> TestM () +withTeamEventWatcher :: (HasCallStack) => (SQS.SQSWatcher TeamEvent -> TestM ()) -> TestM () withTeamEventWatcher action = do view tsTeamEventWatcher >>= \case Nothing -> pure () Just w -> action w -assertIfWatcher :: HasCallStack => String -> (TeamEvent -> Bool) -> (String -> Maybe TeamEvent -> TestM ()) -> TestM () +assertIfWatcher :: (HasCallStack) => String -> (TeamEvent -> Bool) -> (String -> Maybe TeamEvent -> TestM ()) -> TestM () assertIfWatcher l matcher assertion = view tsTeamEventWatcher >>= \case Nothing -> pure () @@ -63,7 +63,7 @@ tActivateWithCurrency c l (Just e) = liftIO $ do assertEqual "currency" cur (e ^. eventData . maybe'currency) tActivateWithCurrency _ l Nothing = liftIO $ assertFailure $ l <> ": Expected 1 TeamActivate, got nothing" -assertTeamActivateWithCurrency :: HasCallStack => String -> TeamId -> Maybe Currency.Alpha -> TestM () +assertTeamActivateWithCurrency :: (HasCallStack) => String -> TeamId -> Maybe Currency.Alpha -> TestM () assertTeamActivateWithCurrency l tid c = assertIfWatcher l (teamActivateMatcher tid) (tActivateWithCurrency c) @@ -73,7 +73,7 @@ tActivate l (Just e) = liftIO $ do assertEqual "count" 1 (e ^. eventData . memberCount) tActivate l Nothing = liftIO $ assertFailure $ l <> ": Expected 1 TeamActivate, got nothing" -assertTeamActivate :: HasCallStack => String -> TeamId -> TestM () +assertTeamActivate :: (HasCallStack) => String -> TeamId -> TestM () assertTeamActivate l tid = assertIfWatcher l (teamActivateMatcher tid) tActivate @@ -84,7 +84,7 @@ tDelete :: (HasCallStack, MonadIO m) => String -> Maybe E.TeamEvent -> m () tDelete l (Just e) = liftIO $ assertEqual (l <> ": eventType") E.TeamEvent'TEAM_DELETE (e ^. eventType) tDelete l Nothing = liftIO $ assertFailure $ l <> ": Expected 1 TeamDelete, got nothing" -assertTeamDelete :: HasCallStack => Int -> String -> TeamId -> TestM () +assertTeamDelete :: (HasCallStack) => Int -> String -> TeamId -> TestM () assertTeamDelete maxWaitSeconds l tid = withTeamEventWatcher $ \w -> do mEvent <- SQS.waitForMessage w maxWaitSeconds (\e -> e ^. eventType == E.TeamEvent'TEAM_DELETE && decodeIdFromBS (e ^. teamId) == tid) @@ -94,7 +94,7 @@ tSuspend :: (HasCallStack, MonadIO m) => String -> Maybe E.TeamEvent -> m () tSuspend l (Just e) = liftIO $ assertEqual (l <> "eventType") E.TeamEvent'TEAM_SUSPEND (e ^. eventType) tSuspend l Nothing = liftIO $ assertFailure $ l <> ": Expected 1 TeamSuspend, got nothing" -assertTeamSuspend :: HasCallStack => String -> TeamId -> TestM () +assertTeamSuspend :: (HasCallStack) => String -> TeamId -> TestM () assertTeamSuspend l tid = assertIfWatcher l (\e -> e ^. eventType == E.TeamEvent'TEAM_SUSPEND && decodeIdFromBS (e ^. teamId) == tid) tSuspend @@ -114,7 +114,7 @@ tUpdate _ _ l Nothing = liftIO $ assertFailure $ l <> ": Expected 1 TeamUpdate, updateMatcher :: TeamId -> TeamEvent -> Bool updateMatcher tid e = e ^. eventType == E.TeamEvent'TEAM_UPDATE && decodeIdFromBS (e ^. teamId) == tid -assertTeamUpdate :: HasCallStack => String -> TeamId -> Int32 -> [UserId] -> TestM () +assertTeamUpdate :: (HasCallStack) => String -> TeamId -> Int32 -> [UserId] -> TestM () assertTeamUpdate l tid c uids = assertIfWatcher l (\e -> e ^. eventType == E.TeamEvent'TEAM_UPDATE && decodeIdFromBS (e ^. teamId) == tid) $ tUpdate c uids diff --git a/services/galley/test/integration/API/Teams.hs b/services/galley/test/integration/API/Teams.hs index 060116473e0..cad9536576d 100644 --- a/services/galley/test/integration/API/Teams.hs +++ b/services/galley/test/integration/API/Teams.hs @@ -236,7 +236,7 @@ testListTeamMembersDefaultLimit = do -- | for ad-hoc load-testing, set @numMembers@ to, say, 10k and see what -- happens. but please don't give that number to our ci! :) -- for additional tests of the CSV download particularly with SCIM users, please refer to 'Test.Spar.Scim.UserSpec' -testListTeamMembersCsv :: HasCallStack => Int -> TestM () +testListTeamMembersCsv :: (HasCallStack) => Int -> TestM () testListTeamMembersCsv numMembers = do let teamSize = numMembers + 1 @@ -257,7 +257,7 @@ testListTeamMembersCsv numMembers = do users <- Util.getUsersByHandle (catMaybes someHandles) mbrs <- view teamMembers <$> Util.bulkGetTeamMembers owner tid (U.userId <$> users) - let check :: Eq a => String -> (TeamExportUser -> Maybe a) -> UserId -> Maybe a -> IO () + let check :: (Eq a) => String -> (TeamExportUser -> Maybe a) -> UserId -> Maybe a -> IO () check msg getTeamExportUserAttr uid userAttr = do assertBool msg (isJust userAttr) assertEqual (msg <> ": " <> show uid) 1 (countOn getTeamExportUserAttr userAttr usersInCsv) @@ -280,16 +280,16 @@ testListTeamMembersCsv numMembers = do assertEqual ("tExportUserId: " <> show (U.userId user)) (U.userId user) (tExportUserId export) assertEqual "tExportNumDevices: " (Map.findWithDefault (-1) (U.userId user) numClientMappings) (tExportNumDevices export) where - userToIdPIssuer :: HasCallStack => U.User -> Maybe HttpsUrl + userToIdPIssuer :: (HasCallStack) => U.User -> Maybe HttpsUrl userToIdPIssuer usr = case (U.userIdentity >=> U.ssoIdentity) usr of Just (U.UserSSOId (SAML.UserRef (SAML.Issuer issuer) _)) -> either (const $ error "shouldn't happen") Just $ mkHttpsUrl issuer Just _ -> Nothing Nothing -> Nothing - decodeCSV :: FromNamedRecord a => LByteString -> Either String [a] + decodeCSV :: (FromNamedRecord a) => LByteString -> Either String [a] decodeCSV bstr = decodeByName bstr <&> (snd >>> V.toList) - countOn :: Eq b => (a -> b) -> b -> [a] -> Int + countOn :: (Eq b) => (a -> b) -> b -> [a] -> Int countOn prop val xs = sum $ fmap (bool 0 1 . (== val) . prop) xs addClients :: Map.Map UserId Int -> TestM () @@ -357,7 +357,7 @@ testListTeamMembersDefaultLimitByIds = do check owner tid [phantom] [] check owner tid [owner, alien, phantom] [owner] where - check :: HasCallStack => UserId -> TeamId -> [UserId] -> [UserId] -> TestM () + check :: (HasCallStack) => UserId -> TeamId -> [UserId] -> [UserId] -> TestM () check owner tid uidsIn uidsOut = do listFromServer <- Util.bulkGetTeamMembers owner tid uidsIn liftIO $ @@ -396,12 +396,12 @@ testEnableSSOPerTeam = do owner <- Util.randomUser tid <- Util.createBindingTeamInternal "foo" owner assertTeamActivate "create team" tid - let check :: HasCallStack => String -> Public.FeatureStatus -> TestM () + let check :: (HasCallStack) => String -> Public.FeatureStatus -> TestM () check msg enabledness = do status :: Public.WithStatusNoLock Public.SSOConfig <- responseJsonUnsafe <$> (getSSOEnabledInternal tid TestM () + let putSSOEnabledInternalCheckNotImplemented :: (HasCallStack) => TestM () putSSOEnabledInternalCheckNotImplemented = do g <- viewGalley waierr <- @@ -489,7 +489,7 @@ testCreateOne2OneFailForNonTeamMembers = do const "non-binding-team-members" === (Error.label . responseJsonUnsafeWithMsg "error label") testCreateOne2OneWithMembers :: - HasCallStack => + (HasCallStack) => -- | Role of the user who creates the conversation Role -> TestM () @@ -709,7 +709,7 @@ testRemoveBindingTeamOwner = do Util.waitForMemberDeletion ownerB tid ownerWithoutEmail assertTeamUpdate "Remove ownerWithoutEmail" tid 2 [ownerB] where - check :: HasCallStack => TeamId -> UserId -> UserId -> Maybe PlainTextPassword6 -> Maybe LText -> TestM () + check :: (HasCallStack) => TeamId -> UserId -> UserId -> Maybe PlainTextPassword6 -> Maybe LText -> TestM () check tid deleter deletee pass maybeError = do g <- viewGalley delete @@ -1728,21 +1728,21 @@ newTeamMember' perms uid = Member.mkTeamMember uid perms Nothing LH.defUserLegal -- 'putTeamFeatureInternal'. Since these functions all work in slightly different monads -- and with different kinds of internal checks, it's quite tedious to do so. -getSSOEnabledInternal :: HasCallStack => TeamId -> TestM ResponseLBS +getSSOEnabledInternal :: (HasCallStack) => TeamId -> TestM ResponseLBS getSSOEnabledInternal = Util.getTeamFeatureInternal @Public.SSOConfig -putSSOEnabledInternal :: HasCallStack => TeamId -> Public.FeatureStatus -> TestM () +putSSOEnabledInternal :: (HasCallStack) => TeamId -> Public.FeatureStatus -> TestM () putSSOEnabledInternal tid statusValue = void $ Util.putTeamFeatureInternal @Public.SSOConfig expect2xx tid (Public.WithStatusNoLock statusValue Public.SSOConfig Public.FeatureTTLUnlimited) -getSearchVisibility :: HasCallStack => (Request -> Request) -> UserId -> TeamId -> MonadHttp m => m ResponseLBS +getSearchVisibility :: (HasCallStack) => (Request -> Request) -> UserId -> TeamId -> (MonadHttp m) => m ResponseLBS getSearchVisibility g uid tid = do get $ g . paths ["teams", toByteString' tid, "search-visibility"] . zUser uid -putSearchVisibility :: HasCallStack => (Request -> Request) -> UserId -> TeamId -> TeamSearchVisibility -> MonadHttp m => m ResponseLBS +putSearchVisibility :: (HasCallStack) => (Request -> Request) -> UserId -> TeamId -> TeamSearchVisibility -> (MonadHttp m) => m ResponseLBS putSearchVisibility g uid tid vis = do put $ g diff --git a/services/galley/test/integration/API/Teams/LegalHold.hs b/services/galley/test/integration/API/Teams/LegalHold.hs index 57dfd9f43b0..77896207454 100644 --- a/services/galley/test/integration/API/Teams/LegalHold.hs +++ b/services/galley/test/integration/API/Teams/LegalHold.hs @@ -85,12 +85,12 @@ testsInternal s = testWhitelistingTeams :: TestM () testWhitelistingTeams = do - let testTeamWhitelisted :: HasCallStack => TeamId -> TestM Bool + let testTeamWhitelisted :: (HasCallStack) => TeamId -> TestM Bool testTeamWhitelisted tid = do res <- getLHWhitelistedTeam tid pure (Bilge.responseStatus res == status200) - let expectWhitelisted :: HasCallStack => Bool -> TeamId -> TestM () + let expectWhitelisted :: (HasCallStack) => Bool -> TeamId -> TestM () expectWhitelisted yes tid = do let msg = if yes then "team should be whitelisted" else "team should not be whitelisted" aFewTimesAssertBool msg (== yes) (testTeamWhitelisted tid) @@ -124,18 +124,18 @@ testCreateLegalHoldTeamSettings = withTeam $ \owner tid -> do postSettings owner tid brokenService !!! testResponse 412 (Just "legalhold-unavailable") -- checks /status of legal hold service (boolean argument says whether the service is -- behaving or not) - let lhapp :: HasCallStack => IsWorking -> Chan Void -> Application + let lhapp :: (HasCallStack) => IsWorking -> Chan Void -> Application lhapp NotWorking _ _ cont = cont respondBad lhapp Working _ req cont = do if - | pathInfo req /= ["legalhold", "status"] -> cont respondBad - | requestMethod req /= "GET" -> cont respondBad - | otherwise -> cont respondOk + | pathInfo req /= ["legalhold", "status"] -> cont respondBad + | requestMethod req /= "GET" -> cont respondBad + | otherwise -> cont respondOk respondOk :: Wai.Response respondOk = responseLBS status200 mempty mempty respondBad :: Wai.Response respondBad = responseLBS status404 mempty mempty - lhtest :: HasCallStack => IsWorking -> Warp.Port -> Chan Void -> TestM () + lhtest :: (HasCallStack) => IsWorking -> Warp.Port -> Chan Void -> TestM () lhtest NotWorking _ _ = do postSettings owner tid brokenService !!! testResponse 412 (Just "legalhold-unavailable") lhtest Working lhPort _ = do @@ -217,7 +217,7 @@ testRemoveLegalHoldFromTeam = do -- fails if LH for team is disabled deleteSettings (Just defPassword) owner tid !!! testResponse 403 (Just "legalhold-disable-unimplemented") -testAddTeamUserTooLargeWithLegalholdWhitelisted :: HasCallStack => TestM () +testAddTeamUserTooLargeWithLegalholdWhitelisted :: (HasCallStack) => TestM () testAddTeamUserTooLargeWithLegalholdWhitelisted = withTeam $ \owner tid -> do o <- view tsGConf let fanoutLimit = fromIntegral @_ @Integer . fromRange $ Galley.currentFanoutLimit o @@ -256,7 +256,7 @@ testCannotCreateLegalHoldDeviceOldAPI = do data GroupConvInvCase = InviteOnlyConsenters | InviteAlsoNonConsenters deriving (Show, Eq, Ord, Bounded, Enum) -testBenchHack :: HasCallStack => TestM () +testBenchHack :: (HasCallStack) => TestM () testBenchHack = do {- representative sample run on an old laptop: @@ -299,13 +299,13 @@ testBenchHack = do print =<< testBenchHack' 300 print =<< testBenchHack' 600 -testBenchHack' :: HasCallStack => Int -> TestM (Int, Time.NominalDiffTime) +testBenchHack' :: (HasCallStack) => Int -> TestM (Int, Time.NominalDiffTime) testBenchHack' numPeers = do (legalholder :: UserId, tid) <- createBindingTeam peers :: [UserId] <- replicateM numPeers randomUser galley <- viewGalley - let doEnableLH :: HasCallStack => TestM () + let doEnableLH :: (HasCallStack) => TestM () doEnableLH = do withLHWhitelist tid (requestLegalHoldDevice' galley legalholder legalholder tid) !!! testResponse 201 Nothing withLHWhitelist tid (approveLegalHoldDevice' galley (Just defPassword) legalholder legalholder tid) !!! testResponse 200 Nothing diff --git a/services/galley/test/integration/API/Teams/LegalHold/DisabledByDefault.hs b/services/galley/test/integration/API/Teams/LegalHold/DisabledByDefault.hs index a9315929573..0ed8319d99e 100644 --- a/services/galley/test/integration/API/Teams/LegalHold/DisabledByDefault.hs +++ b/services/galley/test/integration/API/Teams/LegalHold/DisabledByDefault.hs @@ -361,18 +361,18 @@ testCreateLegalHoldTeamSettings = do postSettings owner tid brokenService !!! testResponse 412 (Just "legalhold-unavailable") -- checks /status of legal hold service (boolean argument says whether the service is -- behaving or not) - let lhapp :: HasCallStack => IsWorking -> Chan Void -> Application + let lhapp :: (HasCallStack) => IsWorking -> Chan Void -> Application lhapp NotWorking _ _ cont = cont respondBad lhapp Working _ req cont = do if - | pathInfo req /= ["legalhold", "status"] -> cont respondBad - | requestMethod req /= "GET" -> cont respondBad - | otherwise -> cont respondOk + | pathInfo req /= ["legalhold", "status"] -> cont respondBad + | requestMethod req /= "GET" -> cont respondBad + | otherwise -> cont respondOk respondOk :: Wai.Response respondOk = responseLBS status200 mempty mempty respondBad :: Wai.Response respondBad = responseLBS status404 mempty mempty - lhtest :: HasCallStack => IsWorking -> Warp.Port -> Chan Void -> TestM () + lhtest :: (HasCallStack) => IsWorking -> Warp.Port -> Chan Void -> TestM () lhtest NotWorking _ _ = do postSettings owner tid brokenService !!! testResponse 412 (Just "legalhold-unavailable") lhtest Working lhPort _ = do @@ -601,7 +601,7 @@ testGetTeamMembersIncludesLHStatus = do findMemberStatus ms = ms ^? traversed . filtered (has $ Team.userId . only member) . legalHoldStatus - let check :: HasCallStack => UserLegalHoldStatus -> String -> TestM () + let check :: (HasCallStack) => UserLegalHoldStatus -> String -> TestM () check status msg = do members' <- view teamMembers <$> getTeamMembers owner tid liftIO $ @@ -640,7 +640,7 @@ testOldClientsBlockDeviceHandshake = do -- has to be a team member, granting LH consent for personal users is not supported. createBindingTeam - let doEnableLH :: HasCallStack => UserId -> UserId -> TestM ClientId + let doEnableLH :: (HasCallStack) => UserId -> UserId -> TestM ClientId doEnableLH owner uid = do requestLegalHoldDevice owner uid tid !!! testResponse 201 Nothing approveLegalHoldDevice (Just defPassword) uid uid tid !!! testResponse 200 Nothing @@ -683,7 +683,7 @@ testOldClientsBlockDeviceHandshake = do UserId -> ClientId -> TestM ResponseLBS + let runit :: (HasCallStack) => UserId -> ClientId -> TestM ResponseLBS runit sender senderClient = do postOtrMessage id sender senderClient convId rcps where @@ -718,7 +718,7 @@ testClaimKeys testcase = do (legalholder, tid) <- createBindingTeam (peer, teamPeer) <- createBindingTeam - let doEnableLH :: HasCallStack => TeamId -> UserId -> UserId -> TestM ClientId + let doEnableLH :: (HasCallStack) => TeamId -> UserId -> UserId -> TestM ClientId doEnableLH team owner uid = do requestLegalHoldDevice owner uid team !!! testResponse 201 Nothing approveLegalHoldDevice (Just defPassword) uid uid team !!! testResponse 200 Nothing @@ -772,7 +772,7 @@ testClaimKeys testcase = do -------------------------------------------------------------------- -- setup helpers -withDummyTestServiceForTeam' :: HasCallStack => UserId -> TeamId -> (Warp.Port -> Chan (Wai.Request, LByteString) -> TestM a) -> TestM a +withDummyTestServiceForTeam' :: (HasCallStack) => UserId -> TeamId -> (Warp.Port -> Chan (Wai.Request, LByteString) -> TestM a) -> TestM a withDummyTestServiceForTeam' owner tid go = do withDummyTestServiceForTeamNoService $ \lhPort chan -> do newService <- newLegalHoldService lhPort diff --git a/services/galley/test/integration/API/Teams/LegalHold/Util.hs b/services/galley/test/integration/API/Teams/LegalHold/Util.hs index 85e2e37d195..6fd3eee176b 100644 --- a/services/galley/test/integration/API/Teams/LegalHold/Util.hs +++ b/services/galley/test/integration/API/Teams/LegalHold/Util.hs @@ -65,7 +65,7 @@ import Wire.API.UserEvent qualified as Ev -- | Create a new legal hold service creation request with the URL from the integration test -- config. -newLegalHoldService :: HasCallStack => Warp.Port -> TestM NewLegalHoldService +newLegalHoldService :: (HasCallStack) => Warp.Port -> TestM NewLegalHoldService newLegalHoldService lhPort = do config <- view (tsIConf . to provider) key' <- liftIO $ readServiceKey (publicKey config) @@ -88,7 +88,7 @@ readServiceKey fp = liftIO $ do withDummyTestServiceForTeam :: forall a. - HasCallStack => + (HasCallStack) => UserId -> TeamId -> -- | the test @@ -104,7 +104,7 @@ withDummyTestServiceForTeam owner tid go = -- the config file), and see if it works as well as with our mock service. withDummyTestServiceForTeamNoService :: forall a. - HasCallStack => + (HasCallStack) => -- | the test (Warp.Port -> Chan (Wai.Request, LByteString) -> TestM a) -> TestM a @@ -151,7 +151,7 @@ withDummyTestServiceForTeamNoService go = do -- it's here for historical reason because we did this in galley.yaml -- at some point in the past rather than in an internal end-point, and that required spawning -- another galley 'Application' with 'withSettingsOverrides'. -withLHWhitelist :: forall a. HasCallStack => TeamId -> TestM a -> TestM a +withLHWhitelist :: forall a. (HasCallStack) => TeamId -> TestM a -> TestM a withLHWhitelist tid action = do void $ putLHWhitelistTeam tid opts <- view tsGConf @@ -159,7 +159,7 @@ withLHWhitelist tid action = do -- | If you play with whitelists, you should use this one. Every whitelisted team that does -- not get fully deleted will blow up the whitelist that is cached in every warp handler. -withTeam :: forall a. HasCallStack => (HasCallStack => UserId -> TeamId -> TestM a) -> TestM a +withTeam :: forall a. (HasCallStack) => ((HasCallStack) => UserId -> TeamId -> TestM a) -> TestM a withTeam action = bracket createBindingTeam @@ -173,7 +173,7 @@ withTeam action = withFreePortAnyAddr :: (MonadMask m, MonadIO m) => ((Warp.Port, Socket) -> m a) -> m a withFreePortAnyAddr = bracket openFreePortAnyAddr (liftIO . Socket.close . snd) -openFreePortAnyAddr :: MonadIO m => m (Warp.Port, Socket) +openFreePortAnyAddr :: (MonadIO m) => m (Warp.Port, Socket) openFreePortAnyAddr = liftIO $ bindRandomPortTCP "*" -- | Run a test with an mock legal hold service application. The mock service is also binding @@ -184,7 +184,7 @@ openFreePortAnyAddr = liftIO $ bindRandomPortTCP "*" -- they can be run several times if they fail the first time. this is the allow for the ssl -- service to have some time to propagate through the test system (needed on k8s). withTestService :: - HasCallStack => + (HasCallStack) => -- | the mock service (Chan e -> Application) -> -- | the test @@ -222,14 +222,14 @@ publicKeyNotMatchingService = ---------------------------------------------------------------------- -- API helpers -getEnabled :: HasCallStack => TeamId -> TestM ResponseLBS +getEnabled :: (HasCallStack) => TeamId -> TestM ResponseLBS getEnabled tid = do g <- viewGalley get $ g . paths ["i", "teams", toByteString' tid, "features", "legalhold"] -renewToken :: HasCallStack => Text -> TestM () +renewToken :: (HasCallStack) => Text -> TestM () renewToken tok = do b <- viewBrig void . post $ @@ -238,7 +238,7 @@ renewToken tok = do . cookieRaw "zuid" (toByteString' tok) . expect2xx -putEnabled :: HasCallStack => TeamId -> Public.FeatureStatus -> TestM () +putEnabled :: (HasCallStack) => TeamId -> Public.FeatureStatus -> TestM () putEnabled tid enabled = do g <- viewGalley putEnabledM g tid enabled @@ -246,7 +246,7 @@ putEnabled tid enabled = do putEnabledM :: (HasCallStack, MonadHttp m, MonadIO m) => GalleyR -> TeamId -> Public.FeatureStatus -> m () putEnabledM g tid enabled = void $ putEnabledM' g expect2xx tid enabled -putEnabled' :: HasCallStack => (Bilge.Request -> Bilge.Request) -> TeamId -> Public.FeatureStatus -> TestM ResponseLBS +putEnabled' :: (HasCallStack) => (Bilge.Request -> Bilge.Request) -> TeamId -> Public.FeatureStatus -> TestM ResponseLBS putEnabled' extra tid enabled = do g <- viewGalley putEnabledM' g extra tid enabled @@ -259,7 +259,7 @@ putEnabledM' g extra tid enabled = do . json (Public.WithStatusNoLock enabled Public.LegalholdConfig Public.FeatureTTLUnlimited) . extra -postSettings :: HasCallStack => UserId -> TeamId -> NewLegalHoldService -> TestM ResponseLBS +postSettings :: (HasCallStack) => UserId -> TeamId -> NewLegalHoldService -> TestM ResponseLBS postSettings uid tid new = -- Retry calls to this endpoint, on k8s it sometimes takes a while to establish a working -- connection. @@ -278,10 +278,10 @@ postSettings uid tid new = only412 :: RetryStatus -> ResponseLBS -> TestM Bool only412 _ resp = pure $ statusCode resp == 412 -getSettingsTyped :: HasCallStack => UserId -> TeamId -> TestM ViewLegalHoldService +getSettingsTyped :: (HasCallStack) => UserId -> TeamId -> TestM ViewLegalHoldService getSettingsTyped uid tid = responseJsonUnsafe <$> (getSettings uid tid UserId -> TeamId -> TestM ResponseLBS +getSettings :: (HasCallStack) => UserId -> TeamId -> TestM ResponseLBS getSettings uid tid = do g <- viewGalley get $ @@ -291,7 +291,7 @@ getSettings uid tid = do . zConn "conn" . zType "access" -deleteSettings :: HasCallStack => Maybe PlainTextPassword6 -> UserId -> TeamId -> TestM ResponseLBS +deleteSettings :: (HasCallStack) => Maybe PlainTextPassword6 -> UserId -> TeamId -> TestM ResponseLBS deleteSettings mPassword uid tid = do g <- viewGalley delete $ @@ -302,7 +302,7 @@ deleteSettings mPassword uid tid = do . zType "access" . json (RemoveLegalHoldSettingsRequest mPassword) -getUserStatusTyped :: HasCallStack => UserId -> TeamId -> TestM UserLegalHoldStatusResponse +getUserStatusTyped :: (HasCallStack) => UserId -> TeamId -> TestM UserLegalHoldStatusResponse getUserStatusTyped uid tid = do g <- viewGalley getUserStatusTyped' g uid tid @@ -321,7 +321,7 @@ getUserStatus' g uid tid = do . zConn "conn" . zType "access" -approveLegalHoldDevice :: HasCallStack => Maybe PlainTextPassword6 -> UserId -> UserId -> TeamId -> TestM ResponseLBS +approveLegalHoldDevice :: (HasCallStack) => Maybe PlainTextPassword6 -> UserId -> UserId -> TeamId -> TestM ResponseLBS approveLegalHoldDevice mPassword zusr uid tid = do g <- viewGalley approveLegalHoldDevice' g mPassword zusr uid tid @@ -344,7 +344,7 @@ approveLegalHoldDevice' g mPassword zusr uid tid = do . json (ApproveLegalHoldForUserRequest mPassword) disableLegalHoldForUser :: - HasCallStack => + (HasCallStack) => Maybe PlainTextPassword6 -> TeamId -> UserId -> @@ -370,7 +370,7 @@ disableLegalHoldForUser' g mPassword tid zusr uid = do . zType "access" . json (DisableLegalHoldForUserRequest mPassword) -assertExactlyOneLegalHoldDevice :: HasCallStack => UserId -> TestM () +assertExactlyOneLegalHoldDevice :: (HasCallStack) => UserId -> TestM () assertExactlyOneLegalHoldDevice uid = do clients :: [Client] <- getClients uid >>= responseJsonError @@ -378,7 +378,7 @@ assertExactlyOneLegalHoldDevice uid = do let numdevs = length $ clientType <$> clients assertEqual ("expected exactly one legal hold device for user: " <> show uid) numdevs 1 -assertZeroLegalHoldDevices :: HasCallStack => UserId -> TestM () +assertZeroLegalHoldDevices :: (HasCallStack) => UserId -> TestM () assertZeroLegalHoldDevices uid = do clients :: [Client] <- getClients uid >>= responseJsonError @@ -396,7 +396,7 @@ assertZeroLegalHoldDevices uid = do ---------------------------------------------------------------------- ---- Device helpers -grantConsent :: HasCallStack => TeamId -> UserId -> TestM () +grantConsent :: (HasCallStack) => TeamId -> UserId -> TestM () grantConsent tid zusr = do g <- viewGalley grantConsent' g tid zusr @@ -414,7 +414,7 @@ grantConsent'' expectation g tid zusr = do . zType "access" . expectation -requestLegalHoldDevice :: HasCallStack => UserId -> UserId -> TeamId -> TestM ResponseLBS +requestLegalHoldDevice :: (HasCallStack) => UserId -> UserId -> TeamId -> TestM ResponseLBS requestLegalHoldDevice zusr uid tid = do g <- viewGalley requestLegalHoldDevice' g zusr uid tid @@ -505,7 +505,7 @@ assertMatchChan c match = go [] refill buf error "Timeout" -getLHWhitelistedTeam :: HasCallStack => TeamId -> TestM ResponseLBS +getLHWhitelistedTeam :: (HasCallStack) => TeamId -> TestM ResponseLBS getLHWhitelistedTeam tid = do galleyCall <- viewGalley getLHWhitelistedTeam' galleyCall tid @@ -517,7 +517,7 @@ getLHWhitelistedTeam' g tid = do . paths ["i", "legalhold", "whitelisted-teams", toByteString' tid] ) -putLHWhitelistTeam :: HasCallStack => TeamId -> TestM ResponseLBS +putLHWhitelistTeam :: (HasCallStack) => TeamId -> TestM ResponseLBS putLHWhitelistTeam tid = do galleyCall <- viewGalley putLHWhitelistTeam' galleyCall tid @@ -529,7 +529,7 @@ putLHWhitelistTeam' g tid = do . paths ["i", "legalhold", "whitelisted-teams", toByteString' tid] ) -_deleteLHWhitelistTeam :: HasCallStack => TeamId -> TestM ResponseLBS +_deleteLHWhitelistTeam :: (HasCallStack) => TeamId -> TestM ResponseLBS _deleteLHWhitelistTeam tid = do galleyCall <- viewGalley deleteLHWhitelistTeam' galleyCall tid diff --git a/services/galley/test/integration/API/Util.hs b/services/galley/test/integration/API/Util.hs index 5f80a490368..c7b157051ae 100644 --- a/services/galley/test/integration/API/Util.hs +++ b/services/galley/test/integration/API/Util.hs @@ -192,11 +192,11 @@ instance HasBrig TestM where symmPermissions :: [Perm] -> Permissions symmPermissions p = let s = Set.fromList p in fromJust (newPermissions s s) -createBindingTeam :: HasCallStack => TestM (UserId, TeamId) +createBindingTeam :: (HasCallStack) => TestM (UserId, TeamId) createBindingTeam = do first User.userId <$> createBindingTeam' -createBindingTeam' :: HasCallStack => TestM (User, TeamId) +createBindingTeam' :: (HasCallStack) => TestM (User, TeamId) createBindingTeam' = do owner <- randomTeamCreator' teams <- getTeams (User.userId owner) [] @@ -206,7 +206,7 @@ createBindingTeam' = do refreshIndex pure (owner, tid) -createBindingTeamWithMembers :: HasCallStack => Int -> TestM (TeamId, UserId, [UserId]) +createBindingTeamWithMembers :: (HasCallStack) => Int -> TestM (TeamId, UserId, [UserId]) createBindingTeamWithMembers numUsers = do (owner, tid) <- createBindingTeam members <- forM [2 .. numUsers] $ \n -> do @@ -220,7 +220,7 @@ createBindingTeamWithMembers numUsers = do pure (tid, owner, members) -createBindingTeamWithQualifiedMembers :: HasCallStack => Int -> TestM (TeamId, Qualified UserId, [Qualified UserId]) +createBindingTeamWithQualifiedMembers :: (HasCallStack) => Int -> TestM (TeamId, Qualified UserId, [Qualified UserId]) createBindingTeamWithQualifiedMembers num = do localDomain <- viewFederationDomain (tid, owner, users) <- createBindingTeamWithMembers num @@ -256,7 +256,7 @@ createBindingTeamWithNMembersWithHandles withHandles n = do pure member1 pure (owner, tid, mems) where - mkRandomHandle :: MonadIO m => m Text + mkRandomHandle :: (MonadIO m) => m Text mkRandomHandle = liftIO $ do nrs <- replicateM 21 (randomRIO (97, 122)) -- a-z pure (cs (map chr nrs)) @@ -273,7 +273,7 @@ createBindingTeamWithNMembersWithHandles withHandles n = do !!! do const 200 === statusCode -changeTeamStatus :: HasCallStack => TeamId -> TeamStatus -> TestM () +changeTeamStatus :: (HasCallStack) => TeamId -> TeamStatus -> TestM () changeTeamStatus tid s = do g <- viewGalley put @@ -284,13 +284,13 @@ changeTeamStatus tid s = do !!! const 200 === statusCode -createBindingTeamInternal :: HasCallStack => Text -> UserId -> TestM TeamId +createBindingTeamInternal :: (HasCallStack) => Text -> UserId -> TestM TeamId createBindingTeamInternal name owner = do tid <- createBindingTeamInternalNoActivate name owner changeTeamStatus tid Active pure tid -createBindingTeamInternalNoActivate :: HasCallStack => Text -> UserId -> TestM TeamId +createBindingTeamInternalNoActivate :: (HasCallStack) => Text -> UserId -> TestM TeamId createBindingTeamInternalNoActivate name owner = do g <- viewGalley tid <- randomId @@ -301,7 +301,7 @@ createBindingTeamInternalNoActivate name owner = do const True === isJust . getHeader "Location" pure tid -createBindingTeamInternalWithCurrency :: HasCallStack => Text -> UserId -> Currency.Alpha -> TestM TeamId +createBindingTeamInternalWithCurrency :: (HasCallStack) => Text -> UserId -> Currency.Alpha -> TestM TeamId createBindingTeamInternalWithCurrency name owner cur = do g <- viewGalley tid <- createBindingTeamInternalNoActivate name owner @@ -311,33 +311,33 @@ createBindingTeamInternalWithCurrency name owner cur = do === statusCode pure tid -getTeamInternal :: HasCallStack => TeamId -> TestM TeamData +getTeamInternal :: (HasCallStack) => TeamId -> TestM TeamData getTeamInternal tid = do g <- viewGalley r <- get (g . paths ["i/teams", toByteString' tid]) UserId -> TeamId -> TestM Team +getTeam :: (HasCallStack) => UserId -> TeamId -> TestM Team getTeam usr tid = do g <- viewGalley r <- get (g . paths ["teams", toByteString' tid] . zUser usr) UserId -> TeamId -> TestM TeamMemberList +getTeamMembers :: (HasCallStack) => UserId -> TeamId -> TestM TeamMemberList getTeamMembers usr tid = do g <- viewGalley r <- get (g . paths ["teams", toByteString' tid, "members"] . zUser usr) UserId -> TeamId -> TestM ResponseLBS +getTeamMembersCsv :: (HasCallStack) => 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 :: (HasCallStack) => UserId -> TeamId -> Int -> TestM TeamMemberList getTeamMembersTruncated usr tid n = do g <- viewGalley r <- get (g . paths ["teams", toByteString' tid, "members"] . zUser usr . queryItem "maxResults" (C.pack $ show n)) o .: "pagingState" -getTeamMembersPaginated :: HasCallStack => UserId -> TeamId -> Int -> Maybe Text -> TestM ResultPage +getTeamMembersPaginated :: (HasCallStack) => UserId -> TeamId -> Int -> Maybe Text -> TestM ResultPage getTeamMembersPaginated usr tid n mPs = do g <- viewGalley r <- @@ -374,7 +374,7 @@ getTeamMembersPaginated usr tid n mPs = do === statusCode responseJsonError r -getTeamMembersInternalTruncated :: HasCallStack => TeamId -> Int -> TestM TeamMemberList +getTeamMembersInternalTruncated :: (HasCallStack) => TeamId -> Int -> TestM TeamMemberList getTeamMembersInternalTruncated tid n = do g <- viewGalley r <- @@ -387,7 +387,7 @@ getTeamMembersInternalTruncated tid n = do === statusCode responseJsonError r -bulkGetTeamMembers :: HasCallStack => UserId -> TeamId -> [UserId] -> TestM TeamMemberList +bulkGetTeamMembers :: (HasCallStack) => UserId -> TeamId -> [UserId] -> TestM TeamMemberList bulkGetTeamMembers usr tid uids = do g <- viewGalley r <- @@ -401,7 +401,7 @@ bulkGetTeamMembers usr tid uids = do === statusCode responseJsonError r -bulkGetTeamMembersTruncated :: HasCallStack => UserId -> TeamId -> [UserId] -> Int -> TestM ResponseLBS +bulkGetTeamMembersTruncated :: (HasCallStack) => UserId -> TeamId -> [UserId] -> Int -> TestM ResponseLBS bulkGetTeamMembersTruncated usr tid uids trnc = do g <- viewGalley post @@ -412,7 +412,7 @@ bulkGetTeamMembersTruncated usr tid uids trnc = do . json (UserIdList uids) ) -getTeamMember :: HasCallStack => UserId -> TeamId -> UserId -> TestM TeamMember +getTeamMember :: (HasCallStack) => UserId -> TeamId -> UserId -> TestM TeamMember getTeamMember getter tid gettee = do g <- viewGalley getTeamMember' g getter tid gettee @@ -422,13 +422,13 @@ getTeamMember' g getter tid gettee = do r <- get (g . paths ["teams", toByteString' tid, "members", toByteString' gettee] . zUser getter) TeamId -> UserId -> TestM TeamMember +getTeamMemberInternal :: (HasCallStack) => TeamId -> UserId -> TestM TeamMember getTeamMemberInternal tid mid = do g <- viewGalley r <- get (g . paths ["i", "teams", toByteString' tid, "members", toByteString' mid]) UserId -> TeamId -> UserId -> Permissions -> Maybe (UserId, UTCTimeMillis) -> TestM () +addTeamMember :: (HasCallStack) => UserId -> TeamId -> UserId -> Permissions -> Maybe (UserId, UTCTimeMillis) -> TestM () addTeamMember usr tid muid mperms mmbinv = do g <- viewGalley let payload = json (mkNewTeamMember muid mperms mmbinv) @@ -437,23 +437,23 @@ addTeamMember usr tid muid mperms mmbinv = do === statusCode -- | FUTUREWORK: do not use this, it's broken!! use 'addUserToTeam' instead! https://wearezeta.atlassian.net/browse/SQSERVICES-471 -addTeamMemberInternal :: HasCallStack => TeamId -> UserId -> Permissions -> Maybe (UserId, UTCTimeMillis) -> TestM () +addTeamMemberInternal :: (HasCallStack) => TeamId -> UserId -> Permissions -> Maybe (UserId, UTCTimeMillis) -> TestM () addTeamMemberInternal tid muid mperms mmbinv = addTeamMemberInternal' tid muid mperms mmbinv !!! const 200 === statusCode -- | FUTUREWORK: do not use this, it's broken!! use 'addUserToTeam' instead! https://wearezeta.atlassian.net/browse/SQSERVICES-471 -addTeamMemberInternal' :: HasCallStack => TeamId -> UserId -> Permissions -> Maybe (UserId, UTCTimeMillis) -> TestM ResponseLBS +addTeamMemberInternal' :: (HasCallStack) => TeamId -> UserId -> Permissions -> Maybe (UserId, UTCTimeMillis) -> TestM ResponseLBS addTeamMemberInternal' tid muid mperms mmbinv = do g <- viewGalley let payload = json (mkNewTeamMember muid mperms mmbinv) post (g . paths ["i", "teams", toByteString' tid, "members"] . payload) -addUserToTeam :: HasCallStack => UserId -> TeamId -> TestM TeamMember +addUserToTeam :: (HasCallStack) => UserId -> TeamId -> TestM TeamMember addUserToTeam = addUserToTeamWithRole Nothing -addUserToTeam' :: HasCallStack => UserId -> TeamId -> TestM ResponseLBS +addUserToTeam' :: (HasCallStack) => UserId -> TeamId -> TestM ResponseLBS addUserToTeam' u t = snd <$> addUserToTeamWithRole' Nothing u t -addUserToTeamWithRole :: HasCallStack => Maybe Role -> UserId -> TeamId -> TestM TeamMember +addUserToTeamWithRole :: (HasCallStack) => Maybe Role -> UserId -> TeamId -> TestM TeamMember addUserToTeamWithRole role inviter tid = do (inv, rsp2) <- addUserToTeamWithRole' role inviter tid let invitee :: User = responseJsonUnsafe rsp2 @@ -465,7 +465,7 @@ addUserToTeamWithRole role inviter tid = do liftIO $ assertEqual "Wrong cookie" (Just "zuid") (setCookieName <$> zuid) pure mem -addUserToTeamWithRole' :: HasCallStack => Maybe Role -> UserId -> TeamId -> TestM (Invitation, ResponseLBS) +addUserToTeamWithRole' :: (HasCallStack) => Maybe Role -> UserId -> TeamId -> TestM (Invitation, ResponseLBS) addUserToTeamWithRole' role inviter tid = do brig <- viewBrig inviteeEmail <- randomEmail @@ -482,13 +482,13 @@ addUserToTeamWithRole' role inviter tid = do ) pure (inv, r) -addUserToTeamWithSSO :: HasCallStack => Bool -> TeamId -> TestM TeamMember +addUserToTeamWithSSO :: (HasCallStack) => Bool -> TeamId -> TestM TeamMember addUserToTeamWithSSO hasEmail tid = do let ssoid = UserSSOId mkSimpleSampleUref uid <- fmap (\(u :: User) -> User.userId u) $ responseJsonError =<< postSSOUser "SSO User" hasEmail ssoid tid getTeamMember uid tid uid -makeOwner :: HasCallStack => UserId -> TeamMember -> TeamId -> TestM () +makeOwner :: (HasCallStack) => UserId -> TeamMember -> TeamId -> TestM () makeOwner owner mem tid = do galley <- viewGalley let changeMember = mkNewTeamMember (mem ^. Team.userId) fullPermissions (mem ^. Team.invitation) @@ -528,7 +528,7 @@ zAuthAccess u conn = . zConn conn . zType "access" -getInvitationCode :: HasCallStack => TeamId -> InvitationId -> TestM InvitationCode +getInvitationCode :: (HasCallStack) => TeamId -> InvitationId -> TestM InvitationCode getInvitationCode t ref = do brig <- viewBrig @@ -554,7 +554,7 @@ getInvitationCode t ref = do -- and therefore cannot be unset. However, given that this is to test the legacy -- API (i.e., no roles) it's fine to hardcode the JSON object in the test since -- it clearly shows the API that old(er) clients use. -createTeamConvLegacy :: HasCallStack => UserId -> TeamId -> [UserId] -> Maybe Text -> TestM ConvId +createTeamConvLegacy :: (HasCallStack) => UserId -> TeamId -> [UserId] -> Maybe Text -> TestM ConvId createTeamConvLegacy u tid us name = do g <- viewGalley let tinfo = ConvTeamInfo tid @@ -575,7 +575,7 @@ createTeamConvLegacy u tid us name = do >>= \r -> fromBS (getHeader' "Location" r) createTeamConv :: - HasCallStack => + (HasCallStack) => UserId -> TeamId -> [UserId] -> @@ -586,7 +586,7 @@ createTeamConv :: createTeamConv u tid us name acc mtimer = createTeamConvAccess u tid us name acc Nothing mtimer (Just roleNameWireAdmin) createTeamConvWithRole :: - HasCallStack => + (HasCallStack) => UserId -> TeamId -> [UserId] -> @@ -598,7 +598,7 @@ createTeamConvWithRole :: createTeamConvWithRole u tid us name acc mtimer convRole = createTeamConvAccess u tid us name acc Nothing mtimer (Just convRole) createTeamConvAccess :: - HasCallStack => + (HasCallStack) => UserId -> TeamId -> [UserId] -> @@ -732,7 +732,7 @@ postConvQualified u c n = do . json n postConvWithRemoteUsersGeneric :: - HasCallStack => + (HasCallStack) => Mock LByteString -> UserId -> Maybe ClientId -> @@ -752,7 +752,7 @@ postConvWithRemoteUsersGeneric m u c n = do setName x = x postConvWithRemoteUsers :: - HasCallStack => + (HasCallStack) => UserId -> Maybe ClientId -> NewConv -> @@ -994,7 +994,7 @@ mkOtrPayload sender rec reportMissingBody ad = mkOtrMessage :: (UserId, ClientId, Text) -> (Text, HashMap.HashMap Text Text) mkOtrMessage (usr, clt, m) = (fn usr, HashMap.singleton (fn clt) m) where - fn :: ToByteString a => a -> Text + fn :: (ToByteString a) => a -> Text fn = fromJust . fromByteString . toByteString' postProtoOtrMessage :: UserId -> ClientId -> ConvId -> OtrRecipients -> TestM ResponseLBS @@ -1023,7 +1023,7 @@ mkOtrProtoMessage sender rec reportMissing ad = & Proto.newOtrMessageData ?~ fromBase64TextLenient ad & Proto.newOtrMessageReportMissing .~ rmis -getConvs :: HasCallStack => UserId -> [Qualified ConvId] -> TestM ResponseLBS +getConvs :: (HasCallStack) => UserId -> [Qualified ConvId] -> TestM ResponseLBS getConvs u cids = do g <- viewGalley post $ @@ -1033,7 +1033,7 @@ getConvs u cids = do . zConn "conn" . json (ListConversations (unsafeRange cids)) -getConvClients :: HasCallStack => GroupId -> TestM ClientList +getConvClients :: (HasCallStack) => GroupId -> TestM ClientList getConvClients gid = do g <- viewGalley responseJsonError @@ -1042,7 +1042,7 @@ getConvClients gid = do . paths ["i", "group", B64U.encode $ unGroupId gid] ) -getAllConvs :: HasCallStack => UserId -> TestM [Conversation] +getAllConvs :: (HasCallStack) => UserId -> TestM [Conversation] getAllConvs u = do g <- viewGalley cids <- do @@ -1514,7 +1514,7 @@ deleteUser u = do g <- viewGalley delete (g . path "/i/user" . zUser u) -getTeamQueue :: HasCallStack => UserId -> Maybe NotificationId -> Maybe (Int, Bool) -> Bool -> TestM [(NotificationId, UserId)] +getTeamQueue :: (HasCallStack) => UserId -> Maybe NotificationId -> Maybe (Int, Bool) -> Bool -> TestM [(NotificationId, UserId)] getTeamQueue zusr msince msize onlyLast = parseEventList . responseJsonUnsafe <$> ( getTeamQueue' zusr msince (fst <$> msize) onlyLast @@ -1542,7 +1542,7 @@ getTeamQueue zusr msince msize onlyLast = EdMemberJoin uid -> uid _ -> error ("bad event type: " <> show (TE.eventType e)) -getTeamQueue' :: HasCallStack => UserId -> Maybe NotificationId -> Maybe Int -> Bool -> TestM ResponseLBS +getTeamQueue' :: (HasCallStack) => UserId -> Maybe NotificationId -> Maybe Int -> Bool -> TestM ResponseLBS getTeamQueue' zusr msince msize onlyLast = do g <- viewGalley get @@ -1581,7 +1581,7 @@ registerRemoteConv convId originUser name othMembers = do protocol = ProtocolProteus } -getFeatureStatusMulti :: forall cfg. KnownSymbol (FeatureSymbol cfg) => Multi.TeamFeatureNoConfigMultiRequest -> TestM ResponseLBS +getFeatureStatusMulti :: forall cfg. (KnownSymbol (FeatureSymbol cfg)) => Multi.TeamFeatureNoConfigMultiRequest -> TestM ResponseLBS getFeatureStatusMulti req = do g <- viewGalley post @@ -1593,20 +1593,20 @@ getFeatureStatusMulti req = do ------------------------------------------------------------------------------- -- Common Assertions -assertConvMemberWithRole :: HasCallStack => RoleName -> ConvId -> Qualified UserId -> TestM () +assertConvMemberWithRole :: (HasCallStack) => RoleName -> ConvId -> Qualified UserId -> TestM () assertConvMemberWithRole r c u = getSelfMember (qUnqualified u) c !!! do const 200 === statusCode const (Right u) === (fmap memId <$> responseJsonEither) const (Right r) === (fmap memConvRoleName <$> responseJsonEither) -assertConvMember :: HasCallStack => Qualified UserId -> ConvId -> TestM () +assertConvMember :: (HasCallStack) => Qualified UserId -> ConvId -> TestM () assertConvMember u c = getSelfMember (qUnqualified u) c !!! do const 200 === statusCode const (Right u) === (fmap memId <$> responseJsonEither) -assertNotConvMember :: HasCallStack => UserId -> ConvId -> TestM () +assertNotConvMember :: (HasCallStack) => UserId -> ConvId -> TestM () assertNotConvMember u c = getSelfMember u c !!! do const 200 === statusCode @@ -1627,7 +1627,7 @@ assertConvEquals c1 c2 = liftIO $ do otherMembers = Set.fromList . cmOthers . cnvMembers assertConv :: - HasCallStack => + (HasCallStack) => Response (Maybe Lazy.ByteString) -> ConvType -> Maybe UserId -> @@ -1639,7 +1639,7 @@ assertConv :: assertConv r t c s us n mt = assertConvWithRole r t c s us n mt roleNameWireAdmin assertConvWithRole :: - HasCallStack => + (HasCallStack) => Response (Maybe Lazy.ByteString) -> ConvType -> Maybe UserId -> @@ -1675,7 +1675,7 @@ assertConvWithRole r t c s us n mt role = do pure (cnvQualifiedId cnv) wsAssertOtr :: - HasCallStack => + (HasCallStack) => Qualified ConvId -> Qualified UserId -> ClientId -> @@ -1686,7 +1686,7 @@ wsAssertOtr :: wsAssertOtr = wsAssertOtr' "ZXhhbXBsZQ==" wsAssertOtr' :: - HasCallStack => + (HasCallStack) => Text -> Qualified ConvId -> Qualified UserId -> @@ -1704,7 +1704,7 @@ wsAssertOtr' evData conv usr from to txt n = do evtData e @?= EdOtrMessage (OtrMessage from to txt (Just evData)) wsAssertMLSWelcome :: - HasCallStack => + (HasCallStack) => Qualified UserId -> Qualified ConvId -> ByteString -> @@ -1719,7 +1719,7 @@ wsAssertMLSWelcome u cid welcome n = do evtData e @?= EdMLSWelcome welcome wsAssertMLSMessage :: - HasCallStack => + (HasCallStack) => Qualified ConvOrSubConvId -> Qualified UserId -> ByteString -> @@ -1731,7 +1731,7 @@ wsAssertMLSMessage qcs u message n = do assertMLSMessageEvent qcs u message e wsAssertClientRemoved :: - HasCallStack => + (HasCallStack) => ClientId -> Notification -> IO () @@ -1743,7 +1743,7 @@ wsAssertClientRemoved cid n = do (fromByteString . T.encodeUtf8 =<< eclient) @?= Just cid wsAssertClientAdded :: - HasCallStack => + (HasCallStack) => ClientId -> Notification -> IO () @@ -1755,7 +1755,7 @@ wsAssertClientAdded cid n = do (fromByteString . T.encodeUtf8 =<< eclient) @?= Just cid assertMLSMessageEvent :: - HasCallStack => + (HasCallStack) => Qualified ConvOrSubConvId -> Qualified UserId -> ByteString -> @@ -1772,10 +1772,10 @@ assertMLSMessageEvent qcs u message e = do evtData e @?= EdMLSMessage message -- | This assumes the default role name -wsAssertMemberJoin :: HasCallStack => Qualified ConvId -> Qualified UserId -> [Qualified UserId] -> Notification -> IO () +wsAssertMemberJoin :: (HasCallStack) => Qualified ConvId -> Qualified UserId -> [Qualified UserId] -> Notification -> IO () wsAssertMemberJoin conv usr new = wsAssertMemberJoinWithRole conv usr new roleNameWireAdmin -wsAssertMemberJoinWithRole :: HasCallStack => Qualified ConvId -> Qualified UserId -> [Qualified UserId] -> RoleName -> Notification -> IO () +wsAssertMemberJoinWithRole :: (HasCallStack) => Qualified ConvId -> Qualified UserId -> [Qualified UserId] -> RoleName -> Notification -> IO () wsAssertMemberJoinWithRole conv usr new role n = do let e = List1.head (WS.unpackPayload n) ntfTransient n @?= False @@ -1789,7 +1789,7 @@ assertJoinEvent conv usr new role e = do fmap (sort . mMembers) (evtData e ^? _EdMembersJoin) @?= Just (sort (fmap (`SimpleMember` role) new)) wsAssertFederationDeleted :: - HasCallStack => + (HasCallStack) => Domain -> Notification -> IO () @@ -1811,7 +1811,7 @@ assertFederationDeletedEvent dom e = do -- -- or if they can be combined in general. wsAssertMembersLeave :: - HasCallStack => + (HasCallStack) => Qualified ConvId -> Qualified UserId -> [Qualified UserId] -> @@ -1877,7 +1877,7 @@ wsAssertMemberLeave conv usr old reason n = do sorted (EdMembersLeave _ (QualifiedUserIdList m)) = EdMembersLeave reason (QualifiedUserIdList (sort m)) sorted x = x -wsAssertTyping :: HasCallStack => Qualified ConvId -> Qualified UserId -> TypingStatus -> Notification -> IO () +wsAssertTyping :: (HasCallStack) => Qualified ConvId -> Qualified UserId -> TypingStatus -> Notification -> IO () wsAssertTyping conv usr ts n = do let e = List1.head (WS.unpackPayload n) ntfTransient n @?= True @@ -1886,7 +1886,7 @@ wsAssertTyping conv usr ts n = do evtFrom e @?= usr evtData e @?= EdTyping ts -assertNoMsg :: HasCallStack => WS.WebSocket -> (Notification -> Assertion) -> TestM () +assertNoMsg :: (HasCallStack) => WS.WebSocket -> (Notification -> Assertion) -> TestM () assertNoMsg ws f = do x <- WS.awaitMatch (1 # Second) ws f liftIO $ case x of @@ -1919,7 +1919,7 @@ assertLeaveUpdate req qconvId remover alreadyPresentUsers = liftIO $ do ------------------------------------------------------------------------------- -- Helpers -testResponse :: HasCallStack => Int -> Maybe TestErrorLabel -> Assertions () +testResponse :: (HasCallStack) => Int -> Maybe TestErrorLabel -> Assertions () testResponse status mlabel = do const status === statusCode case mlabel of @@ -1943,16 +1943,16 @@ decodeConvCodeEvent r = case responseJsonUnsafe r of (Event _ _ _ _ (EdConvCodeUpdate c)) -> c _ -> error "Failed to parse ConversationCode from Event" -decodeConvId :: HasCallStack => Response (Maybe Lazy.ByteString) -> ConvId +decodeConvId :: (HasCallStack) => Response (Maybe Lazy.ByteString) -> ConvId decodeConvId = qUnqualified . decodeQualifiedConvId -decodeQualifiedConvId :: HasCallStack => Response (Maybe Lazy.ByteString) -> Qualified ConvId +decodeQualifiedConvId :: (HasCallStack) => Response (Maybe Lazy.ByteString) -> Qualified ConvId decodeQualifiedConvId = cnvQualifiedId . responseJsonUnsafe -decodeConvList :: HasCallStack => Response (Maybe Lazy.ByteString) -> [Conversation] +decodeConvList :: (HasCallStack) => Response (Maybe Lazy.ByteString) -> [Conversation] decodeConvList = convList . responseJsonUnsafeWithMsg "conversations" -decodeConvIdList :: HasCallStack => Response (Maybe Lazy.ByteString) -> [ConvId] +decodeConvIdList :: (HasCallStack) => Response (Maybe Lazy.ByteString) -> [ConvId] decodeConvIdList = convList . responseJsonUnsafeWithMsg "conversation-ids" decodeQualifiedConvIdList :: Response (Maybe Lazy.ByteString) -> Either String [Qualified ConvId] @@ -2114,7 +2114,7 @@ putConnectionQualified fromQualified to r = do payload = RequestBodyLBS . encode $ object ["status" .= r] -- | A copy of `assertConnections from Brig integration tests. -assertConnections :: HasCallStack => UserId -> [ConnectionStatus] -> TestM () +assertConnections :: (HasCallStack) => UserId -> [ConnectionStatus] -> TestM () assertConnections u cstat = do brig <- view tsUnversionedBrig resp <- listConnections brig u TestM [UserId] randomUsers n = replicateM n randomUser -randomUserTuple :: HasCallStack => TestM (UserId, Qualified UserId) +randomUserTuple :: (HasCallStack) => TestM (UserId, Qualified UserId) randomUserTuple = do qUid <- randomQualifiedUser pure (qUnqualified qUid, qUid) -randomUser :: HasCallStack => TestM UserId +randomUser :: (HasCallStack) => TestM UserId randomUser = qUnqualified <$> randomUser' False True True -randomQualifiedUser :: HasCallStack => TestM (Qualified UserId) +randomQualifiedUser :: (HasCallStack) => TestM (Qualified UserId) randomQualifiedUser = randomUser' False True True -randomQualifiedId :: MonadIO m => Domain -> m (Qualified (Id a)) +randomQualifiedId :: (MonadIO m) => Domain -> m (Qualified (Id a)) randomQualifiedId domain = Qualified <$> randomId <*> pure domain -randomTeamCreator :: HasCallStack => TestM UserId +randomTeamCreator :: (HasCallStack) => TestM UserId randomTeamCreator = qUnqualified <$> randomUser' True True True -randomTeamCreator' :: HasCallStack => TestM User +randomTeamCreator' :: (HasCallStack) => TestM User randomTeamCreator' = randomUser'' True True True -randomUser' :: HasCallStack => Bool -> Bool -> Bool -> TestM (Qualified UserId) +randomUser' :: (HasCallStack) => Bool -> Bool -> Bool -> TestM (Qualified UserId) randomUser' isCreator hasPassword hasEmail = userQualifiedId <$> randomUser'' isCreator hasPassword hasEmail -randomUser'' :: HasCallStack => Bool -> Bool -> Bool -> TestM User +randomUser'' :: (HasCallStack) => Bool -> Bool -> Bool -> TestM User randomUser'' isCreator hasPassword hasEmail = selfUser <$> randomUserProfile' isCreator hasPassword hasEmail -randomUserProfile' :: HasCallStack => Bool -> Bool -> Bool -> TestM SelfProfile +randomUserProfile' :: (HasCallStack) => Bool -> Bool -> Bool -> TestM SelfProfile randomUserProfile' isCreator hasPassword hasEmail = do b <- viewBrig e <- liftIO randomEmail @@ -2168,7 +2168,7 @@ randomUserProfile' isCreator hasPassword hasEmail = do <> ["team" .= BindingNewTeam (newNewTeam (unsafeRange "teamName") DefaultIcon) | isCreator] responseJsonUnsafe <$> (post (b . path "/i/users" . json p) TestM UserId +ephemeralUser :: (HasCallStack) => TestM UserId ephemeralUser = do b <- viewBrig name <- UUID.toText <$> liftIO nextRandom @@ -2177,10 +2177,10 @@ ephemeralUser = do user <- responseJsonError r pure $ User.userId user -randomClient :: HasCallStack => UserId -> LastPrekey -> TestM ClientId +randomClient :: (HasCallStack) => UserId -> LastPrekey -> TestM ClientId randomClient uid lk = randomClientWithCaps uid lk Nothing -randomClientWithCaps :: HasCallStack => UserId -> LastPrekey -> Maybe (Set Client.ClientCapability) -> TestM ClientId +randomClientWithCaps :: (HasCallStack) => UserId -> LastPrekey -> Maybe (Set Client.ClientCapability) -> TestM ClientId randomClientWithCaps uid lk caps = do b <- viewBrig resp <- @@ -2203,12 +2203,12 @@ randomClientWithCaps uid lk caps = do newClientCapabilities = caps } -ensureDeletedState :: HasCallStack => Bool -> UserId -> UserId -> TestM () +ensureDeletedState :: (HasCallStack) => Bool -> UserId -> UserId -> TestM () ensureDeletedState check from u = do state <- getDeletedState from u liftIO $ assertEqual "Unxpected deleted state" state (Just check) -getDeletedState :: HasCallStack => UserId -> UserId -> TestM (Maybe Bool) +getDeletedState :: (HasCallStack) => UserId -> UserId -> TestM (Maybe Bool) getDeletedState from u = do b <- view tsUnversionedBrig fmap profileDeleted . responseJsonMaybe @@ -2239,7 +2239,7 @@ getInternalClientsFull userSet = do . json userSet responseJsonError res -ensureClientCaps :: HasCallStack => UserId -> ClientId -> Client.ClientCapabilityList -> TestM () +ensureClientCaps :: (HasCallStack) => UserId -> ClientId -> Client.ClientCapabilityList -> TestM () ensureClientCaps uid cid caps = do UserClientsFull (Map.lookup uid -> (Just clnts)) <- getInternalClientsFull (UserSet $ Set.singleton uid) clnt <- assertOne . filter ((== cid) . clientId) $ Set.toList clnts @@ -2264,7 +2264,7 @@ deleteClient u c pw = do ] -- TODO: Refactor, as used also in brig -isUserDeleted :: HasCallStack => UserId -> TestM Bool +isUserDeleted :: (HasCallStack) => UserId -> TestM Bool isUserDeleted u = do b <- viewBrig r <- @@ -2278,7 +2278,7 @@ isUserDeleted u = do let decoded = fromMaybe (error $ "getStatus: failed to decode status" ++ show j) st pure $ decoded == Deleted where - maybeFromJSON :: FromJSON a => Value -> Maybe a + maybeFromJSON :: (FromJSON a) => Value -> Maybe a maybeFromJSON v = case fromJSON v of Success a -> Just a _ -> Nothing @@ -2352,7 +2352,7 @@ assertBroadcastMismatch localDomain BroadcastQualified = assertBroadcastMismatch _ _ = assertMismatch assertMismatchWithMessage :: - HasCallStack => + (HasCallStack) => Maybe String -> [(UserId, Set ClientId)] -> [(UserId, Set ClientId)] -> @@ -2370,7 +2370,7 @@ assertMismatchWithMessage mmsg missing redundant deleted = do formatMessage = maybe Imports.id (\msg -> ((msg <> "\n") <>)) mmsg assertMismatch :: - HasCallStack => + (HasCallStack) => [(UserId, Set ClientId)] -> [(UserId, Set ClientId)] -> [(UserId, Set ClientId)] -> @@ -2378,7 +2378,7 @@ assertMismatch :: assertMismatch = assertMismatchWithMessage Nothing assertMismatchQualified :: - HasCallStack => + (HasCallStack) => Client.QualifiedUserClients -> Client.QualifiedUserClients -> Client.QualifiedUserClients -> @@ -2405,7 +2405,7 @@ genRandom = liftIO . Q.generate $ Q.arbitrary defPassword :: PlainTextPassword6 defPassword = plainTextPassword6Unsafe "topsecretdefaultpassword" -randomEmail :: MonadIO m => m Email +randomEmail :: (MonadIO m) => m Email randomEmail = do uid <- liftIO nextRandom pure $ Email ("success+" <> UUID.toText uid) "simulator.amazonses.com" @@ -2604,11 +2604,11 @@ getUserProfile zusr uid = do res <- get (brig . zUser zusr . paths ["v1", "users", toByteString' uid]) responseJsonError res -upgradeClientToLH :: HasCallStack => UserId -> ClientId -> TestM () +upgradeClientToLH :: (HasCallStack) => UserId -> ClientId -> TestM () upgradeClientToLH zusr cid = putCapabilities zusr cid [ClientSupportsLegalholdImplicitConsent] -putCapabilities :: HasCallStack => UserId -> ClientId -> [ClientCapability] -> TestM () +putCapabilities :: (HasCallStack) => UserId -> ClientId -> [ClientCapability] -> TestM () putCapabilities zusr cid caps = do brig <- viewBrig void $ @@ -2620,7 +2620,7 @@ putCapabilities zusr cid caps = do . expect2xx ) -getUsersPrekeysClientUnqualified :: HasCallStack => UserId -> UserId -> ClientId -> TestM ResponseLBS +getUsersPrekeysClientUnqualified :: (HasCallStack) => UserId -> UserId -> ClientId -> TestM ResponseLBS getUsersPrekeysClientUnqualified zusr uid cid = do brig <- view tsUnversionedBrig get @@ -2629,7 +2629,7 @@ getUsersPrekeysClientUnqualified zusr uid cid = do . paths ["v1", "users", toByteString' uid, "prekeys", toByteString' cid] ) -getUsersPrekeyBundleUnqualified :: HasCallStack => UserId -> UserId -> TestM ResponseLBS +getUsersPrekeyBundleUnqualified :: (HasCallStack) => UserId -> UserId -> TestM ResponseLBS getUsersPrekeyBundleUnqualified zusr uid = do brig <- view tsUnversionedBrig get @@ -2638,7 +2638,7 @@ getUsersPrekeyBundleUnqualified zusr uid = do . paths ["v1", "users", toByteString' uid, "prekeys"] ) -getMultiUserPrekeyBundleUnqualified :: HasCallStack => UserId -> UserClients -> TestM ResponseLBS +getMultiUserPrekeyBundleUnqualified :: (HasCallStack) => UserId -> UserClients -> TestM ResponseLBS getMultiUserPrekeyBundleUnqualified zusr userClients = do brig <- view tsUnversionedBrig post @@ -2691,7 +2691,7 @@ withTempMockFederator' resp action = do -- FederatedRequest against it. makeFedRequestToServant :: forall (api :: Type). - HasServer api '[] => + (HasServer api '[]) => Domain -> Server api -> FederatedRequest -> @@ -2745,12 +2745,12 @@ aFewTimes action good = do (\_ -> pure . not . good) (\_ -> runReaderT (runTestM action) env) -aFewTimesAssertBool :: HasCallStack => String -> (a -> Bool) -> TestM a -> TestM () +aFewTimesAssertBool :: (HasCallStack) => String -> (a -> Bool) -> TestM a -> TestM () aFewTimesAssertBool msg good action = do result <- aFewTimes action good liftIO $ assertBool msg (good result) -checkUserUpdateEvent :: HasCallStack => UserId -> WS.WebSocket -> TestM () +checkUserUpdateEvent :: (HasCallStack) => UserId -> WS.WebSocket -> TestM () checkUserUpdateEvent uid w = WS.assertMatch_ checkTimeout w $ \notif -> do let j = Object $ List1.head (ntfPayload notif) let etype = j ^? key "type" . _String @@ -2758,7 +2758,7 @@ checkUserUpdateEvent uid w = WS.assertMatch_ checkTimeout w $ \notif -> do etype @?= Just "user.update" euser @?= Just (UUID.toText (toUUID uid)) -checkUserDeleteEvent :: HasCallStack => UserId -> WS.Timeout -> WS.WebSocket -> TestM () +checkUserDeleteEvent :: (HasCallStack) => UserId -> WS.Timeout -> WS.WebSocket -> TestM () checkUserDeleteEvent uid timeout_ w = WS.assertMatch_ timeout_ w $ \notif -> do let j = Object $ List1.head (ntfPayload notif) let etype = j ^? key "type" . _String @@ -2766,14 +2766,14 @@ checkUserDeleteEvent uid timeout_ w = WS.assertMatch_ timeout_ w $ \notif -> do etype @?= Just "user.delete" euser @?= Just (UUID.toText (toUUID uid)) -checkTeamMemberJoin :: HasCallStack => TeamId -> UserId -> WS.WebSocket -> TestM () +checkTeamMemberJoin :: (HasCallStack) => TeamId -> UserId -> WS.WebSocket -> TestM () checkTeamMemberJoin tid uid w = WS.assertMatch_ checkTimeout w $ \notif -> do ntfTransient notif @?= True let e = List1.head (WS.unpackPayload notif) e ^. eventTeam @?= tid e ^. eventData @?= EdMemberJoin uid -checkTeamMemberLeave :: HasCallStack => TeamId -> UserId -> WS.WebSocket -> TestM () +checkTeamMemberLeave :: (HasCallStack) => TeamId -> UserId -> WS.WebSocket -> TestM () checkTeamMemberLeave tid usr w = WS.assertMatch_ checkTimeout w $ \notif -> do ntfTransient notif @?= True let e = List1.head (WS.unpackPayload notif) @@ -2787,7 +2787,7 @@ checkTeamUpdateEvent tid upd w = WS.assertMatch_ checkTimeout w $ \notif -> do e ^. eventTeam @?= tid e ^. eventData @?= EdTeamUpdate upd -checkConvCreateEvent :: (MonadIO m, MonadCatch m) => HasCallStack => ConvId -> WS.WebSocket -> m () +checkConvCreateEvent :: (MonadIO m, MonadCatch m) => (HasCallStack) => ConvId -> WS.WebSocket -> m () checkConvCreateEvent cid w = WS.assertMatch_ checkTimeout w $ \notif -> do ntfTransient notif @?= False let e = List1.head (WS.unpackPayload notif) @@ -2797,7 +2797,7 @@ checkConvCreateEvent cid w = WS.assertMatch_ checkTimeout w $ \notif -> do other -> assertFailure $ "Unexpected event data: " <> show other wsAssertConvCreate :: - HasCallStack => + (HasCallStack) => Qualified ConvId -> Qualified UserId -> Notification -> @@ -2810,7 +2810,7 @@ wsAssertConvCreate conv eventFrom n = do evtFrom e @?= eventFrom wsAssertConvCreateWithRole :: - HasCallStack => + (HasCallStack) => Qualified ConvId -> Qualified UserId -> Qualified UserId -> @@ -2828,14 +2828,14 @@ wsAssertConvCreateWithRole conv eventFrom selfMember otherMembers n = do where toOtherMember (quid, role) = OtherMember quid Nothing role -checkTeamDeleteEvent :: HasCallStack => TeamId -> WS.WebSocket -> TestM () +checkTeamDeleteEvent :: (HasCallStack) => TeamId -> WS.WebSocket -> TestM () checkTeamDeleteEvent tid w = WS.assertMatch_ checkTimeout w $ \notif -> do ntfTransient notif @?= False let e = List1.head (WS.unpackPayload notif) e ^. eventTeam @?= tid e ^. eventData @?= EdTeamDelete -checkConvDeleteEvent :: HasCallStack => Qualified ConvId -> WS.WebSocket -> TestM () +checkConvDeleteEvent :: (HasCallStack) => Qualified ConvId -> WS.WebSocket -> TestM () checkConvDeleteEvent cid w = WS.assertMatch_ checkTimeout w $ \notif -> do ntfTransient notif @?= False let e = List1.head (WS.unpackPayload notif) @@ -2843,7 +2843,7 @@ checkConvDeleteEvent cid w = WS.assertMatch_ checkTimeout w $ \notif -> do evtConv e @?= cid evtData e @?= Conv.EdConvDelete -checkConvMemberLeaveEvent :: HasCallStack => Qualified ConvId -> Qualified UserId -> WS.WebSocket -> TestM () +checkConvMemberLeaveEvent :: (HasCallStack) => Qualified ConvId -> Qualified UserId -> WS.WebSocket -> TestM () checkConvMemberLeaveEvent cid usr w = WS.assertMatch_ checkTimeout w $ \notif -> do ntfTransient notif @?= False let e = List1.head (WS.unpackPayload notif) @@ -2863,11 +2863,11 @@ mockedFederatedBrigResponse users = do guardComponent Brig mockReply [mkProfile mem (Name name) | (mem, name) <- users] -fedRequestsForDomain :: HasCallStack => Domain -> Component -> [FederatedRequest] -> [FederatedRequest] +fedRequestsForDomain :: (HasCallStack) => Domain -> Component -> [FederatedRequest] -> [FederatedRequest] fedRequestsForDomain domain component = filter $ \req -> frTargetDomain req == domain && frComponent req == component -parseFedRequest :: FromJSON a => FederatedRequest -> Either String a +parseFedRequest :: (FromJSON a) => FederatedRequest -> Either String a parseFedRequest fr = eitherDecode (frBody fr) assertOne :: (HasCallStack, MonadIO m, Show a) => [a] -> m a @@ -2895,7 +2895,7 @@ iUpsertOne2OneConversation req = do galley <- viewGalley post (galley . path "/i/conversations/one2one/upsert" . Bilge.json req) -createOne2OneConvWithRemote :: HasCallStack => Local UserId -> Remote UserId -> TestM () +createOne2OneConvWithRemote :: (HasCallStack) => Local UserId -> Remote UserId -> TestM () createOne2OneConvWithRemote localUser remoteUser = do let convId = one2OneConvId BaseProtocolProteusTag (tUntagged localUser) (tUntagged remoteUser) mkRequest actor = @@ -2927,7 +2927,7 @@ matchFedRequest domain reqpath req = frTargetDomain req == domain && frRPC req == reqpath -spawn :: HasCallStack => CreateProcess -> Maybe ByteString -> IO ByteString +spawn :: (HasCallStack) => CreateProcess -> Maybe ByteString -> IO ByteString spawn cp minput = do (mout, ex) <- withCreateProcess cp @@ -2943,7 +2943,7 @@ spawn cp minput = do (Just out, ExitSuccess) -> pure out _ -> assertFailure "Process didn't finish successfully" -decodeMLSError :: ParseMLS a => ByteString -> IO a +decodeMLSError :: (ParseMLS a) => ByteString -> IO a decodeMLSError s = case decodeMLS' s of Left e -> assertFailure ("Could not parse MLS object: " <> Text.unpack e) Right x -> pure x @@ -2957,7 +2957,7 @@ wsAssertConvReceiptModeUpdate conv usr new n = do evtFrom e @?= usr evtData e @?= EdConvReceiptModeUpdate (ConversationReceiptModeUpdate new) -wsAssertBackendRemoveProposalWithEpoch :: HasCallStack => Qualified UserId -> Qualified ConvId -> LeafIndex -> Epoch -> Notification -> IO ByteString +wsAssertBackendRemoveProposalWithEpoch :: (HasCallStack) => Qualified UserId -> Qualified ConvId -> LeafIndex -> Epoch -> Notification -> IO ByteString wsAssertBackendRemoveProposalWithEpoch fromUser convId idx epoch n = do bs <- wsAssertBackendRemoveProposal fromUser (Conv <$> convId) idx n let msg = fromRight (error "Failed to parse Message") $ decodeMLS' @Message bs @@ -2966,7 +2966,7 @@ wsAssertBackendRemoveProposalWithEpoch fromUser convId idx epoch n = do _ -> assertFailure "unexpected message content" pure bs -wsAssertBackendRemoveProposal :: HasCallStack => Qualified UserId -> Qualified ConvOrSubConvId -> LeafIndex -> Notification -> IO ByteString +wsAssertBackendRemoveProposal :: (HasCallStack) => Qualified UserId -> Qualified ConvOrSubConvId -> LeafIndex -> Notification -> IO ByteString wsAssertBackendRemoveProposal fromUser cnvOrSubCnv idx n = do let e = List1.head (WS.unpackPayload n) ntfTransient n @?= False @@ -2991,7 +2991,7 @@ wsAssertBackendRemoveProposal fromUser cnvOrSubCnv idx n = do getMLSMessageData d = error ("Expected EdMLSMessage, but got " <> show d) wsAssertAddProposal :: - HasCallStack => + (HasCallStack) => Qualified UserId -> Qualified ConvId -> Notification -> diff --git a/services/galley/test/integration/API/Util/TeamFeature.hs b/services/galley/test/integration/API/Util/TeamFeature.hs index 3191a4849ce..749ea934531 100644 --- a/services/galley/test/integration/API/Util/TeamFeature.hs +++ b/services/galley/test/integration/API/Util/TeamFeature.hs @@ -46,7 +46,7 @@ withCustomSearchFeature flag action = do Util.withSettingsOverrides (\opts -> opts & settings . featureFlags . flagTeamSearchVisibility .~ flag) action putTeamSearchVisibilityAvailableInternal :: - HasCallStack => + (HasCallStack) => TeamId -> Public.FeatureStatus -> (MonadIO m, MonadHttp m, HasGalley m) => m () @@ -232,7 +232,7 @@ patchTeamFeatureInternalWithMod reqmod tid reqBody = do . reqmod getGuestLinkStatus :: - HasCallStack => + (HasCallStack) => (Request -> Request) -> UserId -> ConvId -> diff --git a/services/galley/test/integration/TestSetup.hs b/services/galley/test/integration/TestSetup.hs index d4d8c7151b0..a6b9ba84f52 100644 --- a/services/galley/test/integration/TestSetup.hs +++ b/services/galley/test/integration/TestSetup.hs @@ -164,13 +164,14 @@ runFedClient (FedClient mgr ep) domain = Right res -> pure res Left err -> assertFailure $ "Servant client failed with: " <> show err - makeClientRequest :: Domain -> Servant.BaseUrl -> Servant.Request -> HTTP.Request - makeClientRequest originDomain burl req = - let req' = Servant.defaultMakeClientRequest burl req - in req' - { HTTP.requestHeaders = - HTTP.requestHeaders req' - <> [ (originDomainHeaderName, toByteString' originDomain), - (versionHeader, toByteString' (versionInt (maxBound :: Version))) - ] - } + makeClientRequest :: Domain -> Servant.BaseUrl -> Servant.Request -> IO HTTP.Request + makeClientRequest originDomain burl req = do + req' <- Servant.defaultMakeClientRequest burl req + pure + req' + { HTTP.requestHeaders = + HTTP.requestHeaders req' + <> [ (originDomainHeaderName, toByteString' originDomain), + (versionHeader, toByteString' (versionInt (maxBound :: Version))) + ] + } diff --git a/services/galley/test/unit/Test/Galley/Intra/User.hs b/services/galley/test/unit/Test/Galley/Intra/User.hs index f90bdc7e139..f031206d079 100644 --- a/services/galley/test/unit/Test/Galley/Intra/User.hs +++ b/services/galley/test/unit/Test/Galley/Intra/User.hs @@ -35,7 +35,7 @@ tests = [ testChunkify ] -testChunkify :: HasCallStack => TestTree +testChunkify :: (HasCallStack) => TestTree testChunkify = testGroup "chunkify" diff --git a/services/gundeck/migrate-data/src/Gundeck/DataMigration.hs b/services/gundeck/migrate-data/src/Gundeck/DataMigration.hs index 6c01b748bf7..7bb99bb3f26 100644 --- a/services/gundeck/migrate-data/src/Gundeck/DataMigration.hs +++ b/services/gundeck/migrate-data/src/Gundeck/DataMigration.hs @@ -116,5 +116,5 @@ persistVersion (MigrationVersion v) desc time = C.write cql (C.params C.LocalQuo cql :: C.QueryString C.W (Int32, Text, UTCTime) () cql = "insert into data_migration (id, version, descr, date) values (1,?,?,?)" -info :: Log.MonadLogger m => String -> m () +info :: (Log.MonadLogger m) => String -> m () info = Log.info . Log.msg diff --git a/services/gundeck/migrate-data/src/Gundeck/DataMigration/Types.hs b/services/gundeck/migrate-data/src/Gundeck/DataMigration/Types.hs index 4ad3dbb20d9..99f9d47609a 100644 --- a/services/gundeck/migrate-data/src/Gundeck/DataMigration/Types.hs +++ b/services/gundeck/migrate-data/src/Gundeck/DataMigration/Types.hs @@ -53,7 +53,7 @@ instance (MonadIO m, MonadThrow m) => C.MonadClient (MigrationActionT m) where liftClient = liftCassandra localState f = local (\env -> env {cassandraClientState = f $ cassandraClientState env}) -instance MonadIO m => MonadLogger (MigrationActionT m) where +instance (MonadIO m) => MonadLogger (MigrationActionT m) where log level f = do env <- ask Logger.log (logger env) level f @@ -67,7 +67,7 @@ runMigrationAction :: Env -> MigrationActionT m a -> m a runMigrationAction env action = runReaderT (unMigrationAction action) env -liftCassandra :: MonadIO m => C.Client a -> MigrationActionT m a +liftCassandra :: (MonadIO m) => C.Client a -> MigrationActionT m a liftCassandra m = do env <- ask lift $ C.runClient (cassandraClientState env) m diff --git a/services/gundeck/migrate-data/src/V1_DeleteApnsVoipTokens.hs b/services/gundeck/migrate-data/src/V1_DeleteApnsVoipTokens.hs index 0c7645797b8..0dba1f02102 100644 --- a/services/gundeck/migrate-data/src/V1_DeleteApnsVoipTokens.hs +++ b/services/gundeck/migrate-data/src/V1_DeleteApnsVoipTokens.hs @@ -56,14 +56,14 @@ pageSize = 1000 -- | We do not use the push token types here because they will likely be -- changed in future breaking this migration. getPushTokens :: - MonadClient m => + (MonadClient m) => ConduitM () [(UserId, Text, Text, Int32, Maybe Text)] m () getPushTokens = paginateC cql (paramsP LocalQuorum () pageSize) x5 where cql :: PrepQuery R () (UserId, Text, Text, Int32, Maybe Text) cql = "SELECT usr, ptoken, app, transport, arn FROM user_push" -deletePushToken :: MonadClient m => (UserId, Text, Text, Int32) -> m () +deletePushToken :: (MonadClient m) => (UserId, Text, Text, Int32) -> m () deletePushToken pair = retry x5 $ write cql (params LocalQuorum pair) where diff --git a/services/gundeck/src/Gundeck/Aws.hs b/services/gundeck/src/Gundeck/Aws.hs index ea5fe968866..944a9d213bf 100644 --- a/services/gundeck/src/Gundeck/Aws.hs +++ b/services/gundeck/src/Gundeck/Aws.hs @@ -216,7 +216,7 @@ mkEnv lgr opts mgr = do (pure . QueueUrl . view SQS.getQueueUrlResponse_queueUrl) x -execute :: MonadIO m => Env -> Amazon a -> m a +execute :: (MonadIO m) => Env -> Amazon a -> m a execute e m = liftIO $ runResourceT (runReaderT (unAmazon m) e) -------------------------------------------------------------------------------- @@ -479,8 +479,10 @@ listen throttleMillis callback = do err . msg $ val "Failed to parse SQS event notification" Just e -> do info $ - "sqs-event" .= toText (e ^. evType) - ~~ "arn" .= toText (e ^. evEndpoint) + "sqs-event" + .= toText (e ^. evType) + ~~ "arn" + .= toText (e ^. evEndpoint) ~~ msg (val "Received SQS event") liftIO $ callback e for_ (m ^. message_receiptHandle) (void . send awsE . SQS.newDeleteMessage url) diff --git a/services/gundeck/src/Gundeck/Aws/Arn.hs b/services/gundeck/src/Gundeck/Aws/Arn.hs index 17588d08106..0ff914c5d57 100644 --- a/services/gundeck/src/Gundeck/Aws/Arn.hs +++ b/services/gundeck/src/Gundeck/Aws/Arn.hs @@ -114,7 +114,7 @@ instance ToText EndpointTopic where instance FromText EndpointTopic where fromText = parseOnly endpointTopicParser -mkSnsArn :: ToText topic => Region -> Account -> topic -> SnsArn topic +mkSnsArn :: (ToText topic) => Region -> Account -> topic -> SnsArn topic mkSnsArn r a t = let txt = Text.intercalate ":" ["arn:aws:sns", toText r, toText a, toText t] in SnsArn txt r a t @@ -164,8 +164,13 @@ endpointTopicParser = do transportParser :: Parser Transport transportParser = - string "GCM" $> GCM - <|> string "APNS_VOIP_SANDBOX" $> APNSVoIPSandbox - <|> string "APNS_VOIP" $> APNSVoIP - <|> string "APNS_SANDBOX" $> APNSSandbox - <|> string "APNS" $> APNS + string "GCM" + $> GCM + <|> string "APNS_VOIP_SANDBOX" + $> APNSVoIPSandbox + <|> string "APNS_VOIP" + $> APNSVoIP + <|> string "APNS_SANDBOX" + $> APNSSandbox + <|> string "APNS" + $> APNS diff --git a/services/gundeck/src/Gundeck/Monad.hs b/services/gundeck/src/Gundeck/Monad.hs index a3a9207864f..5320f725501 100644 --- a/services/gundeck/src/Gundeck/Monad.hs +++ b/services/gundeck/src/Gundeck/Monad.hs @@ -114,7 +114,7 @@ instance Redis.MonadRedis WithDefaultRedis where Redis.runRobust defaultConn action instance Redis.RedisCtx WithDefaultRedis (Either Redis.Reply) where - returnDecode :: Redis.RedisResult a => Redis.Reply -> WithDefaultRedis (Either Redis.Reply a) + returnDecode :: (Redis.RedisResult a) => Redis.Reply -> WithDefaultRedis (Either Redis.Reply a) returnDecode = Redis.liftRedis . Redis.returnDecode -- | 'Gundeck' doesn't have an instance for 'MonadRedis' because it contains two @@ -151,7 +151,7 @@ instance Redis.MonadRedis WithAdditionalRedis where pure ret instance Redis.RedisCtx WithAdditionalRedis (Either Redis.Reply) where - returnDecode :: Redis.RedisResult a => Redis.Reply -> WithAdditionalRedis (Either Redis.Reply a) + returnDecode :: (Redis.RedisResult a) => Redis.Reply -> WithAdditionalRedis (Either Redis.Reply a) returnDecode = Redis.liftRedis . Redis.returnDecode instance MonadLogger Gundeck where @@ -193,13 +193,16 @@ lookupReqId l r = case lookup requestIdName (requestHeaders r) of Nothing -> do localRid <- RequestId . UUID.toASCIIBytes <$> UUID.nextRandom Log.info l $ - "request-id" .= localRid - ~~ "method" .= requestMethod r - ~~ "path" .= rawPathInfo r + "request-id" + .= localRid + ~~ "method" + .= requestMethod r + ~~ "path" + .= rawPathInfo r ~~ msg (val "generated a new request id for local request") pure localRid -fromJsonBody :: FromJSON a => JsonRequest a -> Gundeck a +fromJsonBody :: (FromJSON a) => JsonRequest a -> Gundeck a fromJsonBody r = exceptT (throwM . mkError status400 "bad-request") pure (parseBody r) {-# INLINE fromJsonBody #-} diff --git a/services/gundeck/src/Gundeck/Notification.hs b/services/gundeck/src/Gundeck/Notification.hs index a64e3477982..f5c1c2a5082 100644 --- a/services/gundeck/src/Gundeck/Notification.hs +++ b/services/gundeck/src/Gundeck/Notification.hs @@ -21,12 +21,11 @@ module Gundeck.Notification ) where -import Bilge.IO hiding (options) +import Bilge.IO (post) import Bilge.Request import Bilge.Response import Control.Lens (view) import Control.Monad.Catch -import Control.Monad.Except import Data.ByteString.Conversion import Data.Id import Data.Misc (Milliseconds (..)) @@ -35,13 +34,13 @@ import Data.Time.Clock.POSIX import Data.UUID qualified as UUID import Gundeck.Monad import Gundeck.Notification.Data qualified as Data -import Gundeck.Options hiding (host, port) +import Gundeck.Options (brig) import Imports hiding (getLast) -import Network.HTTP.Types hiding (statusCode) +import Network.HTTP.Types (status400) import Network.Wai.Utilities.Error import System.Logger.Class import System.Logger.Class qualified as Log -import Util.Options hiding (host, port) +import Util.Options (Endpoint (Endpoint)) import Wire.API.Internal.Notification import Wire.API.Notification @@ -84,5 +83,7 @@ updateActivity uid clt = do when (statusCode r /= 200) $ do Log.warn $ Log.msg ("Could not update client activity" :: ByteString) - ~~ "user" .= UUID.toASCIIBytes (toUUID uid) - ~~ "client" .= clientToText clt + ~~ "user" + .= UUID.toASCIIBytes (toUUID uid) + ~~ "client" + .= clientToText clt diff --git a/services/gundeck/src/Gundeck/Notification/Data.hs b/services/gundeck/src/Gundeck/Notification/Data.hs index de18c7f5eaf..a240f37df03 100644 --- a/services/gundeck/src/Gundeck/Notification/Data.hs +++ b/services/gundeck/src/Gundeck/Notification/Data.hs @@ -106,7 +106,7 @@ add n tgts (JSON.encode -> payload) (notificationTTLSeconds -> t) = do \(? , ?) \ \USING TTL ?" -fetchId :: MonadClient m => UserId -> NotificationId -> Maybe ClientId -> m (Maybe QueuedNotification) +fetchId :: (MonadClient m) => UserId -> NotificationId -> Maybe ClientId -> m (Maybe QueuedNotification) fetchId u n c = runMaybeT $ do row <- MaybeT $ retry x1 $ query1 cqlById (params LocalQuorum (u, n)) MaybeT $ fetchPayload c row @@ -158,7 +158,7 @@ fetchLast u c = do \WHERE user = ? AND id < ? \ \ORDER BY id DESC" -fetchPayload :: MonadClient m => Maybe ClientId -> NotifRow -> m (Maybe QueuedNotification) +fetchPayload :: (MonadClient m) => Maybe ClientId -> NotifRow -> m (Maybe QueuedNotification) fetchPayload c (id_, mbPayload, mbPayloadRef, _mbPayloadRefSize, mbClients) = case (mbPayload, mbPayloadRef) of (Just payload, _) -> pure $ toNotifSingle c (id_, payload, mbClients) @@ -261,7 +261,7 @@ fetch u c (Just since) (fromIntegral . fromRange -> size) = do \WHERE user = ? AND id >= ? \ \ORDER BY id ASC" -deleteAll :: MonadClient m => UserId -> m () +deleteAll :: (MonadClient m) => UserId -> m () deleteAll u = write cql (params LocalQuorum (Identity u)) & retry x5 where cql :: PrepQuery W (Identity UserId) () diff --git a/services/gundeck/src/Gundeck/Presence/Data.hs b/services/gundeck/src/Gundeck/Presence/Data.hs index 158e8982217..bfe1773ba9c 100644 --- a/services/gundeck/src/Gundeck/Presence/Data.hs +++ b/services/gundeck/src/Gundeck/Presence/Data.hs @@ -24,7 +24,6 @@ module Gundeck.Presence.Data where import Control.Monad.Catch -import Control.Monad.Except import Data.Aeson as Aeson import Data.ByteString qualified as Strict import Data.ByteString.Builder (byteString) @@ -122,9 +121,13 @@ instance ToJSON PresenceData where instance FromJSON PresenceData where parseJSON = withObject "PresenceData" $ \o -> PresenceData - <$> o .: "r" - <*> o .:? "c" - <*> o .:? "t" .!= 0 + <$> o + .: "r" + <*> o + .:? "c" + <*> o + .:? "t" + .!= 0 toKey :: UserId -> ByteString toKey u = Lazy.toStrict $ runBuilder (byteString "user:" <> builder u) diff --git a/services/gundeck/src/Gundeck/Push.hs b/services/gundeck/src/Gundeck/Push.hs index 009052623d0..6f3bcbcf684 100644 --- a/services/gundeck/src/Gundeck/Push.hs +++ b/services/gundeck/src/Gundeck/Push.hs @@ -85,7 +85,7 @@ push ps = do throwM (mkError status500 "server-error" "Server Error") -- | Abstract over all effects in 'pushAll' (for unit testing). -class MonadThrow m => MonadPushAll m where +class (MonadThrow m) => MonadPushAll m where mpaNotificationTTL :: m NotificationTTL mpaMkNotificationId :: m NotificationId mpaListAllPresences :: [UserId] -> m [[Presence]] @@ -113,7 +113,7 @@ runWithBudget'' budget fallback action = do Just tbs -> runWithBudget' tbs budget fallback action -- | Abstract over all effects in 'nativeTargets' (for unit testing). -class Monad m => MonadNativeTargets m where +class (Monad m) => MonadNativeTargets m where mntgtLogErr :: SomeException -> m () mntgtLookupAddresses :: UserId -> m [Address] @@ -121,7 +121,7 @@ instance MonadNativeTargets Gundeck where mntgtLogErr e = Log.err (msg (val "Failed to get native push address: " +++ show e)) mntgtLookupAddresses rcp = Data.lookup rcp Data.One -class Monad m => MonadMapAsync m where +class (Monad m) => MonadMapAsync m where mntgtMapAsync :: (a -> m b) -> [a] -> m [Either SomeException b] mntgtPerPushConcurrency :: m (Maybe Int) @@ -223,7 +223,7 @@ data NewNotification = NewNotification nnRecipients :: List1 Recipient } -mkNewNotification :: forall m. MonadPushAll m => Push -> m NewNotification +mkNewNotification :: forall m. (MonadPushAll m) => Push -> m NewNotification mkNewNotification psh = NewNotification psh <$> mkNotif <*> rcps where mkNotif :: m Notification @@ -266,12 +266,12 @@ data WSTargets = WSTargets wstPresences :: List1 (Recipient, [Presence]) } -mkWSTargets :: MonadPushAll m => NewNotification -> m WSTargets +mkWSTargets :: (MonadPushAll m) => NewNotification -> m WSTargets mkWSTargets NewNotification {..} = do withPresences <- addPresences nnRecipients pure $ WSTargets nnPush nnNotification withPresences where - addPresences :: forall m. MonadPushAll m => List1 Recipient -> m (List1 (Recipient, [Presence])) + addPresences :: forall m. (MonadPushAll m) => List1 Recipient -> m (List1 (Recipient, [Presence])) addPresences (toList -> rcps) = do presences <- mpaListAllPresences $ fmap (view recipientId) rcps zip1 rcps presences @@ -388,7 +388,7 @@ addToken uid cid newtok = mpaRunWithBudget 1 (Left Public.AddTokenErrorNoBudget) "user" .= UUID.toASCIIBytes (toUUID uid) ~~ "token" - .= Text.take 16 (tokenText (newtok ^. token)) + .= Text.take 16 (tokenText (newtok ^. token)) ~~ msg (val "Registering push token") addr <- continue newtok cur lift $ Native.deleteTokens old (Just addr) @@ -514,19 +514,19 @@ updateEndpoint uid t arn e = do "user" .= UUID.toASCIIBytes (toUUID uid) ~~ "token" - .= Text.take 16 (t ^. token . to tokenText) + .= Text.take 16 (t ^. token . to tokenText) ~~ "tokenTransport" - .= show (t ^. tokenTransport) + .= show (t ^. tokenTransport) ~~ "tokenApp" - .= (t ^. tokenApp . to appNameText) + .= (t ^. tokenApp . to appNameText) ~~ "arn" - .= toText arn + .= toText arn ~~ "endpointTransport" - .= show (arn ^. snsTopic . endpointTransport) + .= show (arn ^. snsTopic . endpointTransport) ~~ "endpointAppName" - .= (arn ^. snsTopic . endpointAppName . to appNameText) + .= (arn ^. snsTopic . endpointAppName . to appNameText) ~~ "request" - .= unRequestId requestId + .= unRequestId requestId ~~ msg (val m) deleteToken :: UserId -> Token -> Gundeck (Maybe ()) diff --git a/services/gundeck/src/Gundeck/Push/Data.hs b/services/gundeck/src/Gundeck/Push/Data.hs index c688f64f4db..5c3fc33cd34 100644 --- a/services/gundeck/src/Gundeck/Push/Data.hs +++ b/services/gundeck/src/Gundeck/Push/Data.hs @@ -42,25 +42,25 @@ lookup u c = foldM mk [] =<< retry x1 (query q (params c (Identity u))) q = "select usr, transport, app, ptoken, arn, connection, client from user_push where usr = ?" mk as r = maybe as (: as) <$> mkAddr r -insert :: MonadClient m => UserId -> Transport -> AppName -> Token -> EndpointArn -> ConnId -> ClientId -> m () +insert :: (MonadClient m) => UserId -> Transport -> AppName -> Token -> EndpointArn -> ConnId -> ClientId -> m () insert u t a p e o c = retry x5 $ write q (params LocalQuorum (u, t, a, p, e, o, c)) where q :: PrepQuery W (UserId, Transport, AppName, Token, EndpointArn, ConnId, ClientId) () q = "insert into user_push (usr, transport, app, ptoken, arn, connection, client) values (?, ?, ?, ?, ?, ?, ?)" -updateArn :: MonadClient m => UserId -> Transport -> AppName -> Token -> EndpointArn -> m () +updateArn :: (MonadClient m) => UserId -> Transport -> AppName -> Token -> EndpointArn -> m () updateArn uid transport app token arn = retry x5 $ write q (params LocalQuorum (arn, uid, transport, app, token)) where q :: PrepQuery W (EndpointArn, UserId, Transport, AppName, Token) () q = {- `IF EXISTS`, but that requires benchmarking -} "update user_push set arn = ? where usr = ? and transport = ? and app = ? and ptoken = ?" -delete :: MonadClient m => UserId -> Transport -> AppName -> Token -> m () +delete :: (MonadClient m) => UserId -> Transport -> AppName -> Token -> m () delete u t a p = retry x5 $ write q (params LocalQuorum (u, t, a, p)) where q :: PrepQuery W (UserId, Transport, AppName, Token) () q = "delete from user_push where usr = ? and transport = ? and app = ? and ptoken = ?" -erase :: MonadClient m => UserId -> m () +erase :: (MonadClient m) => UserId -> m () erase u = retry x5 $ write q (params LocalQuorum (Identity u)) where q :: PrepQuery W (Identity UserId) () diff --git a/services/gundeck/src/Gundeck/Push/Native/Serialise.hs b/services/gundeck/src/Gundeck/Push/Native/Serialise.hs index bf9e0e491cc..648a888f834 100644 --- a/services/gundeck/src/Gundeck/Push/Native/Serialise.hs +++ b/services/gundeck/src/Gundeck/Push/Native/Serialise.hs @@ -35,7 +35,7 @@ import Gundeck.Push.Native.Types import Gundeck.Types import Imports -serialise :: HasCallStack => NativePush -> UserId -> Transport -> Either Failure LT.Text +serialise :: (HasCallStack) => NativePush -> UserId -> Transport -> Either Failure LT.Text serialise (NativePush nid prio _aps) uid transport = do case renderText transport prio o of Nothing -> Left PayloadTooLarge diff --git a/services/gundeck/src/Gundeck/Push/Websocket.hs b/services/gundeck/src/Gundeck/Push/Websocket.hs index e6b8f2121b5..a706d6cb5d9 100644 --- a/services/gundeck/src/Gundeck/Push/Websocket.hs +++ b/services/gundeck/src/Gundeck/Push/Websocket.hs @@ -59,7 +59,7 @@ class (Monad m, MonadThrow m, Log.MonadLogger m) => MonadBulkPush m where mbpBulkSend :: URI -> BulkPushRequest -> m (URI, Either SomeException BulkPushResponse) mbpDeleteAllPresences :: [Presence] -> m () mbpPosixTime :: m Milliseconds - mbpMapConcurrently :: Traversable t => (a -> m b) -> t a -> m (t b) + mbpMapConcurrently :: (Traversable t) => (a -> m b) -> t a -> m (t b) mbpMonitorBadCannons :: (URI, (SomeException, [Presence])) -> m () instance MonadBulkPush Gundeck where @@ -71,7 +71,7 @@ instance MonadBulkPush Gundeck where -- | Send a 'Notification's to associated 'Presence's. Send at most one request to each Cannon. -- Return the lists of 'Presence's successfully reached for each resp. 'Notification'. -bulkPush :: forall m. MonadBulkPush m => [(Notification, [Presence])] -> m [(NotificationId, [Presence])] +bulkPush :: forall m. (MonadBulkPush m) => [(Notification, [Presence])] -> m [(NotificationId, [Presence])] -- REFACTOR: make presences lists (and notification list) non-empty where applicable? are there -- better types to express more of our semantics / invariants? (what about duplicates in presence -- lists?) @@ -117,7 +117,7 @@ pushWsUnreachableCounter = Prom.metricHelp = "Number of times websocket pushes were not pushed due cannon being unreachable" } -logBadCannons :: Log.MonadLogger m => (URI, (SomeException, [Presence])) -> m () +logBadCannons :: (Log.MonadLogger m) => (URI, (SomeException, [Presence])) -> m () logBadCannons (uri, (err, prcs)) = do forM_ prcs $ \prc -> Log.warn $ @@ -128,10 +128,10 @@ logBadCannons (uri, (err, prcs)) = do ~~ Log.field "http_exception" (intercalate " | " . lines . show $ err) ~~ Log.msg (val "WebSocket presence unreachable: ") -logPrcsGone :: Log.MonadLogger m => Presence -> m () +logPrcsGone :: (Log.MonadLogger m) => Presence -> m () logPrcsGone prc = Log.debug $ logPresence prc ~~ Log.msg (val "WebSocket presence gone") -logSuccesses :: Log.MonadLogger m => (a, Presence) -> m () +logSuccesses :: (Log.MonadLogger m) => (a, Presence) -> m () logSuccesses (_, prc) = Log.debug $ logPresence prc ~~ Log.msg (val "WebSocket push success") fanOut :: [(Notification, [Presence])] -> [(URI, BulkPushRequest)] @@ -256,7 +256,7 @@ flowBack rawresps = FlowBack broken gone delivered lefts' ((_, Right _) : xs) = lefts' xs {-# INLINE mkPresencesByCannon #-} -mkPresencesByCannon :: MonadThrow m => [Presence] -> URI -> m [Presence] +mkPresencesByCannon :: (MonadThrow m) => [Presence] -> URI -> m [Presence] mkPresencesByCannon prcs uri = maybe (throwM err) pure $ Map.lookup uri mp where err = ErrorCall "internal error in Gundeck: invalid URL in bulkpush result" @@ -269,7 +269,7 @@ mkPresencesByCannon prcs uri = maybe (throwM err) pure $ Map.lookup uri mp go prc (Just prcs') = Just $ prc : prcs' {-# INLINE mkPresenceByPushTarget #-} -mkPresenceByPushTarget :: MonadThrow m => [Presence] -> PushTarget -> m Presence +mkPresenceByPushTarget :: (MonadThrow m) => [Presence] -> PushTarget -> m Presence mkPresenceByPushTarget prcs ptarget = maybe (throwM err) pure $ Map.lookup ptarget mp where err = ErrorCall "internal error in Cannon: invalid PushTarget in bulkpush response" @@ -283,7 +283,7 @@ bulkresource = URI . (\x -> x {URI.uriPath = "/i/bulkpush"}) . fromURI . resourc -- TODO: a Map-based implementation would be faster for sufficiently large inputs. do we want to -- take the time and benchmark the difference? move it to types-common? {-# INLINE groupAssoc #-} -groupAssoc :: Ord a => [(a, b)] -> [(a, [b])] +groupAssoc :: (Ord a) => [(a, b)] -> [(a, [b])] groupAssoc = groupAssoc' compare -- TODO: Also should we give 'Notification' an 'Ord' instance? diff --git a/services/gundeck/src/Gundeck/React.hs b/services/gundeck/src/Gundeck/React.hs index d97f4312ccc..9ffdf521cca 100644 --- a/services/gundeck/src/Gundeck/React.hs +++ b/services/gundeck/src/Gundeck/React.hs @@ -78,9 +78,9 @@ onUpdated ev = withEndpoint ev $ \e as -> logUserEvent (a ^. addrUser) ev $ msg (val "Removing superseded token") deleteToken (a ^. addrUser) ev (a ^. addrToken) (a ^. addrClient) if - | null sup -> pure () - | null cur -> deleteEndpoint ev - | otherwise -> updateEndpoint ev e (map (view addrUser) cur) + | null sup -> pure () + | null cur -> deleteEndpoint ev + | otherwise -> updateEndpoint ev e (map (view addrUser) cur) onFailure :: Event -> Gundeck () onFailure ev = withEndpoint ev $ \e as -> @@ -100,22 +100,28 @@ onPermFailure ev = withEndpoint ev $ \_ as -> do onTTLExpired :: Event -> Gundeck () onTTLExpired ev = Log.warn $ - "arn" .= toText (ev ^. evEndpoint) - ~~ "cause" .= toText (ev ^. evType) + "arn" + .= toText (ev ^. evEndpoint) + ~~ "cause" + .= toText (ev ^. evType) ~~ msg (val "Notification TTL expired") onUnknownFailure :: Event -> Text -> Gundeck () onUnknownFailure ev r = Log.warn $ - "arn" .= toText (ev ^. evEndpoint) - ~~ "cause" .= toText (ev ^. evType) + "arn" + .= toText (ev ^. evEndpoint) + ~~ "cause" + .= toText (ev ^. evType) ~~ msg (val "Unknown failure, reason: " +++ r) onUnhandledEventType :: Event -> Gundeck () onUnhandledEventType ev = Log.warn $ - "arn" .= toText (ev ^. evEndpoint) - ~~ "cause" .= toText (ev ^. evType) + "arn" + .= toText (ev ^. evEndpoint) + ~~ "cause" + .= toText (ev ^. evType) ~~ msg (val "Unhandled event type") ------------------------------------------------------------------------------- @@ -134,7 +140,8 @@ withEndpoint ev f = do case filter ((== (ev ^. evEndpoint)) . view addrEndpoint) as of [] -> do logEvent ev $ - "token" .= Text.take 16 (tokenText (ep ^. endpointToken)) + "token" + .= Text.take 16 (tokenText (ep ^. endpointToken)) ~~ msg (val "Deleting orphaned SNS endpoint") Aws.execute v (Aws.deleteEndpoint (ev ^. evEndpoint)) as' -> f ep as' @@ -154,7 +161,8 @@ updateEndpoint ev ep us = do deleteToken :: UserId -> Event -> Token -> ClientId -> Gundeck () deleteToken u ev tk cl = do logUserEvent u ev $ - "token" .= Text.take 16 (tokenText tk) + "token" + .= Text.take 16 (tokenText tk) ~~ msg (val "Deleting push token") i <- mkNotificationId let t = mkPushToken ev tk cl @@ -173,12 +181,15 @@ mkPushToken ev tk cl = logEvent :: Event -> (Msg -> Msg) -> Gundeck () logEvent ev f = Log.info $ - "arn" .= toText (ev ^. evEndpoint) - ~~ "cause" .= toText (ev ^. evType) + "arn" + .= toText (ev ^. evEndpoint) + ~~ "cause" + .= toText (ev ^. evType) ~~ f logUserEvent :: UserId -> Event -> (Msg -> Msg) -> Gundeck () logUserEvent u ev f = logEvent ev $ - "user" .= toByteString u + "user" + .= toByteString u ~~ f diff --git a/services/gundeck/src/Gundeck/Redis.hs b/services/gundeck/src/Gundeck/Redis.hs index a4784349db2..5a8ba319caa 100644 --- a/services/gundeck/src/Gundeck/Redis.hs +++ b/services/gundeck/src/Gundeck/Redis.hs @@ -85,7 +85,7 @@ connectRobust l retryStrategy connectLowLevel = do const $ Catch.Handler (\(e :: IOException) -> logEx (Log.err l) e "network error when connecting to Redis" >> pure True) ] . const -- ignore RetryStatus - logEx :: Show e => ((Msg -> Msg) -> IO ()) -> e -> ByteString -> IO () + logEx :: (Show e) => ((Msg -> Msg) -> IO ()) -> e -> ByteString -> IO () logEx lLevel e description = lLevel $ Log.msg (Log.val description) . Log.field "error" (show e) -- | Run a 'Redis' action through a 'RobustConnection'. diff --git a/services/gundeck/src/Gundeck/Redis/HedisExtensions.hs b/services/gundeck/src/Gundeck/Redis/HedisExtensions.hs index 0dee66eee8e..7842fc98822 100644 --- a/services/gundeck/src/Gundeck/Redis/HedisExtensions.hs +++ b/services/gundeck/src/Gundeck/Redis/HedisExtensions.hs @@ -164,7 +164,7 @@ instance RedisResult ClusterInfoResponse where $ Char8.lines bulkData decode r = Left r -clusterInfo :: RedisCtx m f => m (f ClusterInfoResponse) +clusterInfo :: (RedisCtx m f) => m (f ClusterInfoResponse) clusterInfo = sendRequest ["CLUSTER", "INFO"] checkedConnectCluster :: ConnectInfo -> IO Connection diff --git a/services/gundeck/src/Gundeck/Run.hs b/services/gundeck/src/Gundeck/Run.hs index 8dcfc3b764c..4780f1142a9 100644 --- a/services/gundeck/src/Gundeck/Run.hs +++ b/services/gundeck/src/Gundeck/Run.hs @@ -110,7 +110,7 @@ servantSitemap' env = Servant.hoistServer (Proxy @GundeckAPI) toServantHandler s toServantHandler :: Gundeck a -> Handler a toServantHandler m = Handler . ExceptT $ Right <$> runDirect env m -collectAuthMetrics :: MonadIO m => AWS.Env -> m () +collectAuthMetrics :: (MonadIO m) => AWS.Env -> m () collectAuthMetrics env = do liftIO $ forever $ do diff --git a/services/gundeck/src/Gundeck/ThreadBudget/Internal.hs b/services/gundeck/src/Gundeck/ThreadBudget/Internal.hs index cccfea4fdf6..12f0a36a8dd 100644 --- a/services/gundeck/src/Gundeck/ThreadBudget/Internal.hs +++ b/services/gundeck/src/Gundeck/ThreadBudget/Internal.hs @@ -66,12 +66,12 @@ cancelAllThreads (ThreadBudgetState _ ref) = readIORef ref >>= mapM_ cancel . mapMaybe snd . HM.elems . bmap -mkThreadBudgetState :: HasCallStack => MaxConcurrentNativePushes -> IO ThreadBudgetState +mkThreadBudgetState :: (HasCallStack) => MaxConcurrentNativePushes -> IO ThreadBudgetState mkThreadBudgetState limits = ThreadBudgetState limits <$> newIORef (BudgetMap 0 HM.empty) -- | Allocate the resources for a new action to be called (but don't call the action yet). allocate :: - IORef BudgetMap -> UUID -> Int -> MonadIO m => m Int + IORef BudgetMap -> UUID -> Int -> (MonadIO m) => m Int allocate ref key newspent = atomicModifyIORef' ref $ \(BudgetMap spent hm) -> @@ -81,7 +81,7 @@ allocate ref key newspent = -- | Register an already-allocated action with its 'Async'. register :: - IORef BudgetMap -> UUID -> Async () -> MonadIO m => m Int + IORef BudgetMap -> UUID -> Async () -> (MonadIO m) => m Int register ref key handle = atomicModifyIORef' ref $ \(BudgetMap spent hm) -> @@ -91,7 +91,7 @@ register ref key handle = -- | Remove an registered and/or allocated action from a 'BudgetMap'. unregister :: - IORef BudgetMap -> UUID -> MonadIO m => m () + IORef BudgetMap -> UUID -> (MonadIO m) => m () unregister ref key = atomicModifyIORef' ref $ \bhm@(BudgetMap spent hm) -> @@ -143,8 +143,10 @@ runWithBudget' (ThreadBudgetState limits ref) spent fallback action = do go :: UUID -> Int -> m a go key oldsize = do LC.debug $ - "key" LC..= toText key - LC.~~ "spent" LC..= oldsize + "key" + LC..= toText key + LC.~~ "spent" + LC..= oldsize LC.~~ LC.msg (LC.val "runWithBudget: go") handle <- async action _ <- register ref key (void handle) @@ -160,9 +162,12 @@ runWithBudget' (ThreadBudgetState limits ref) spent fallback action = do else threadBudgetSoftLimitBreachedCounter Prom.incCounter counter LC.warn $ - "spent" LC..= show oldsize - LC.~~ "soft-breach" LC..= soft' - LC.~~ "hard-breach" LC..= hard' + "spent" + LC..= show oldsize + LC.~~ "soft-breach" + LC..= soft' + LC.~~ "hard-breach" + LC..= hard' LC.~~ LC.msg ("runWithBudget: " <> limit <> " limit reached") -- | Fork a thread that checks with the given frequency if any async handles stored in the @@ -248,7 +253,7 @@ threadBudgetSoftLimitBreachedCounter = Prom.metricHelp = "Number of times soft limit for threads for native pushes was breached" } -threadDelayNominalDiffTime :: NominalDiffTime -> MonadIO m => m () +threadDelayNominalDiffTime :: NominalDiffTime -> (MonadIO m) => m () threadDelayNominalDiffTime = threadDelay . round . (* 1000000) . toRational staleTolerance :: NominalDiffTime @@ -291,7 +296,8 @@ removeStaleHandles ref = do warnStaleHandles :: Int -> BudgetMap -> m () warnStaleHandles num (BudgetMap spent _) = LC.warn $ - "spent" LC..= show spent + "spent" + LC..= show spent LC.~~ LC.msg ("watchThreadBudgetState: removed " <> show num <> " stale handles.") safeForever :: diff --git a/services/gundeck/src/Gundeck/Util.hs b/services/gundeck/src/Gundeck/Util.hs index bbcc42fba94..9b210881463 100644 --- a/services/gundeck/src/Gundeck/Util.hs +++ b/services/gundeck/src/Gundeck/Util.hs @@ -48,7 +48,7 @@ mapAsync :: mapAsync f = mapM waitCatch <=< mapM (async . f) {-# INLINE mapAsync #-} -maybeEqual :: Eq a => Maybe a -> Maybe a -> Bool +maybeEqual :: (Eq a) => Maybe a -> Maybe a -> Bool maybeEqual (Just x) (Just y) = x == y maybeEqual _ _ = False {-# INLINE maybeEqual #-} diff --git a/services/gundeck/src/Gundeck/Util/DelayQueue.hs b/services/gundeck/src/Gundeck/Util/DelayQueue.hs index f63781e8e94..0e160b1965d 100644 --- a/services/gundeck/src/Gundeck/Util/DelayQueue.hs +++ b/services/gundeck/src/Gundeck/Util/DelayQueue.hs @@ -54,7 +54,7 @@ new c d l = do queue <- newIORef PSQ.empty pure $! DelayQueue queue c d l -enqueue :: Ord k => DelayQueue k v -> k -> v -> IO Bool +enqueue :: (Ord k) => DelayQueue k v -> k -> v -> IO Bool enqueue (DelayQueue queue clock d l) k v = do time <- getTime clock let !p = time + delayTime d @@ -71,7 +71,7 @@ enqueue (DelayQueue queue clock d l) k v = do k q -dequeue :: Ord k => DelayQueue k v -> IO (Maybe (Either Delay v)) +dequeue :: (Ord k) => DelayQueue k v -> IO (Maybe (Either Delay v)) dequeue (DelayQueue queue clock _ _) = do time <- getTime clock atomicModifyIORef' queue $ \q -> @@ -80,7 +80,7 @@ dequeue (DelayQueue queue clock _ _) = do Just (_, p, v, q') | p <= time -> (q', Just (Right v)) Just (_, p, _, _) -> (q, Just (Left (Delay (p - time)))) -cancel :: Ord k => DelayQueue k v -> k -> IO Bool +cancel :: (Ord k) => DelayQueue k v -> k -> IO Bool cancel (DelayQueue queue _ _ _) k = atomicModifyIORef' queue $ swap . PSQ.alter (\pv -> (isJust pv, Nothing)) k diff --git a/services/gundeck/src/Gundeck/Util/Redis.hs b/services/gundeck/src/Gundeck/Util/Redis.hs index 5ae9c1b1886..891505c39ae 100644 --- a/services/gundeck/src/Gundeck/Util/Redis.hs +++ b/services/gundeck/src/Gundeck/Util/Redis.hs @@ -35,7 +35,7 @@ x1 = limitRetries 1 <> exponentialBackoff 100000 x3 :: RetryPolicy x3 = limitRetries 3 <> exponentialBackoff 100000 -handlers :: MonadLogger m => [a -> Handler m Bool] +handlers :: (MonadLogger m) => [a -> Handler m Bool] handlers = [ const . Handler $ \case RedisSimpleError (Error err) -> pure $ "READONLY" `BS.isPrefixOf` err @@ -57,7 +57,7 @@ data RedisError instance Exception RedisError -fromTxResult :: MonadThrow m => TxResult a -> m a +fromTxResult :: (MonadThrow m) => TxResult a -> m a fromTxResult = \case TxSuccess a -> pure a TxAborted -> throwM RedisTxAborted diff --git a/services/gundeck/test/integration/API.hs b/services/gundeck/test/integration/API.hs index ffc11bd7b80..e5e3a3cdbcc 100644 --- a/services/gundeck/test/integration/API.hs +++ b/services/gundeck/test/integration/API.hs @@ -897,19 +897,19 @@ testRedisMigration = do -- * Helpers -ensurePresent :: HasCallStack => UserId -> Int -> TestM () +ensurePresent :: (HasCallStack) => UserId -> Int -> TestM () ensurePresent u n = do gu <- view tsGundeck retryWhile ((n /=) . length . decodePresence) (getPresence gu (showUser u)) !!! (const n === length . decodePresence) -connectUser :: HasCallStack => CannonR -> UserId -> ConnId -> TestM (TChan ByteString) +connectUser :: (HasCallStack) => CannonR -> UserId -> ConnId -> TestM (TChan ByteString) connectUser ca uid con = do [(_, [ch])] <- connectUsersAndDevices ca [(uid, [con])] pure ch connectUsersAndDevices :: - HasCallStack => + (HasCallStack) => CannonR -> [(UserId, [ConnId])] -> TestM [(UserId, [TChan ByteString])] @@ -919,7 +919,7 @@ connectUsersAndDevices ca uidsAndConnIds = do strip = fmap (_2 %~ fmap fst) connectUsersAndDevicesWithSendingClients :: - HasCallStack => + (HasCallStack) => CannonR -> [(UserId, [ConnId])] -> TestM [(UserId, [(TChan ByteString, TChan ByteString)])] @@ -939,7 +939,7 @@ connectUsersAndDevicesWithSendingClients ca uidsAndConnIds = do -- in a Ping Writer and gives access to 'WS.Message's -- this can be used to test Ping/Pong behaviour on the control channel connectUsersAndDevicesWithSendingClientsRaw :: - HasCallStack => + (HasCallStack) => CannonR -> [(UserId, [ConnId])] -> TestM [(UserId, [(TChan WS.Message, TChan ByteString)])] @@ -958,7 +958,7 @@ connectUsersAndDevicesWithSendingClientsRaw ca uidsAndConnIds = do assertPresences :: (UserId, [ConnId]) -> TestM () assertPresences (uid, conns) = wsAssertPresences uid (length conns) -wsRun :: HasCallStack => CannonR -> UserId -> ConnId -> WS.ClientApp () -> TestM (Async ()) +wsRun :: (HasCallStack) => CannonR -> UserId -> ConnId -> WS.ClientApp () -> TestM (Async ()) wsRun ca uid (ConnId con) app = do liftIO $ async $ WS.runClientWith caHost caPort caPath caOpts caHdrs app where @@ -969,7 +969,7 @@ wsRun ca uid (ConnId con) app = do caOpts = WS.defaultConnectionOptions caHdrs = [("Z-User", showUser uid), ("Z-Connection", con)] -wsAssertPresences :: HasCallStack => UserId -> Int -> TestM () +wsAssertPresences :: (HasCallStack) => UserId -> Int -> TestM () wsAssertPresences uid numPres = do gu <- view tsGundeck retryWhile ((numPres /=) . length . decodePresence) (getPresence gu $ showUser uid) @@ -1003,10 +1003,10 @@ retryWhileN n f m = waitForMessageRaw :: TChan WS.Message -> IO (Maybe WS.Message) waitForMessageRaw = System.Timeout.timeout 3000000 . liftIO . atomically . readTChan -waitForMessage :: ToByteString a => TChan a -> IO (Maybe a) +waitForMessage :: (ToByteString a) => TChan a -> IO (Maybe a) waitForMessage = waitForMessage' 1000000 -waitForMessage' :: ToByteString a => Int -> TChan a -> IO (Maybe a) +waitForMessage' :: (ToByteString a) => Int -> TChan a -> IO (Maybe a) waitForMessage' musecs = System.Timeout.timeout musecs . liftIO . atomically . readTChan unregisterClient :: GundeckR -> UserId -> ClientId -> TestM (Response (Maybe BL.ByteString)) @@ -1062,7 +1062,7 @@ listPushTokens u = do (pure . pushTokens) (responseBody rs >>= decode) -listNotifications :: HasCallStack => UserId -> Maybe ClientId -> TestM [QueuedNotification] +listNotifications :: (HasCallStack) => UserId -> Maybe ClientId -> TestM [QueuedNotification] listNotifications u c = do rs <- getNotifications u c >= decode of @@ -1091,16 +1091,16 @@ getLastNotification u c = . paths ["notifications", "last"] . maybe id (queryItem "client" . toByteString') c -sendPush :: HasCallStack => Push -> TestM () +sendPush :: (HasCallStack) => Push -> TestM () sendPush push = sendPushes [push] -sendPushes :: HasCallStack => [Push] -> TestM () +sendPushes :: (HasCallStack) => [Push] -> TestM () sendPushes push = do gu <- view tsGundeck post (runGundeckR gu . path "i/push/v2" . json push) !!! const 200 === statusCode buildPush :: - HasCallStack => + (HasCallStack) => UserId -> [(UserId, RecipientClients)] -> List1 Object -> @@ -1122,7 +1122,7 @@ gcmToken = TokenSpec GCM 16 appName apnsToken :: TokenSpec apnsToken = TokenSpec APNSSandbox 32 appName -randomToken :: MonadIO m => ClientId -> TokenSpec -> m PushToken +randomToken :: (MonadIO m) => ClientId -> TokenSpec -> m PushToken randomToken c ts = liftIO $ do tok <- (Token . T.decodeUtf8) Prelude.. B16.encode Prelude.<$> randomBytes (tSize ts) pure $ pushToken (trans ts) (tName ts) tok c @@ -1168,17 +1168,17 @@ randomUser = do toRecipients :: [UserId] -> Range 1 1024 (Set Recipient) toRecipients = unsafeRange . Set.fromList . map (`recipient` RouteAny) -randomConnId :: MonadIO m => m ConnId +randomConnId :: (MonadIO m) => m ConnId randomConnId = liftIO $ ConnId <$> do r <- randomIO :: IO Word32 pure $ C.pack $ show r -randomClientId :: MonadIO m => m ClientId +randomClientId :: (MonadIO m) => m ClientId randomClientId = liftIO $ ClientId <$> (randomIO :: IO Word64) -randomBytes :: MonadIO m => Int -> m ByteString +randomBytes :: (MonadIO m) => Int -> m ByteString randomBytes n = liftIO $ BS.pack <$> replicateM n (randomIO :: IO Word8) textPayload :: Text -> List1 Object @@ -1193,7 +1193,7 @@ parseNotifications = responseBody >=> (^? key "notifications") >=> fromJSON' parseNotificationIds :: Response (Maybe BL.ByteString) -> Maybe [NotificationId] parseNotificationIds r = map (view queuedNotificationId) <$> parseNotifications r -fromJSON' :: FromJSON a => Value -> Maybe a +fromJSON' :: (FromJSON a) => Value -> Maybe a fromJSON' v = case fromJSON v of Success a -> Just a _ -> Nothing diff --git a/services/gundeck/test/unit/Aws/Arn.hs b/services/gundeck/test/unit/Aws/Arn.hs index ca661c8d0de..9d20bfaeec0 100644 --- a/services/gundeck/test/unit/Aws/Arn.hs +++ b/services/gundeck/test/unit/Aws/Arn.hs @@ -22,7 +22,7 @@ tests = ] ] -realWorldArnTest :: HasCallStack => (String -> IO ()) -> Assertion +realWorldArnTest :: (HasCallStack) => (String -> IO ()) -> Assertion realWorldArnTest step = do step "Given an ARN from a test environment" let arnText :: Text = "arn:aws:sns:eu-central-1:091205192927:endpoint/GCM/sven-test-782078216207/ded226c7-45b8-3f6c-9e89-f253340bbb60" @@ -39,7 +39,7 @@ realWorldArnTest step = do step "Expect values to be de-serialized correctly" (toText arnData) @?= arnText -madeUpArnTest :: HasCallStack => (String -> IO ()) -> Assertion +madeUpArnTest :: (HasCallStack) => (String -> IO ()) -> Assertion madeUpArnTest step = do step "Given an ARN with data to cover untested cases" let arnText :: Text = "arn:aws:sns:us-east-2:000000000001:endpoint/APNS/nodash-000000000002/8ffd8d14-db06-4f3a-a3bb-08264b9dbfb0" diff --git a/services/gundeck/test/unit/Json.hs b/services/gundeck/test/unit/Json.hs index d502874e32f..b83dbf006be 100644 --- a/services/gundeck/test/unit/Json.hs +++ b/services/gundeck/test/unit/Json.hs @@ -107,7 +107,7 @@ genPushTarget = PushTarget <$> arbitrary <*> (ConnId <$> genAlphaNum) genObject :: Gen Object genObject = fromList <$> listOf ((,) <$> genAlphaNum <*> (String <$> genAlphaNum)) -genAlphaNum :: IsString s => Gen s +genAlphaNum :: (IsString s) => Gen s genAlphaNum = fromString <$> listOf (elements (['a' .. 'z'] <> ['A' .. 'Z'] <> ['0' .. '9'])) shortListOf :: Gen a -> Gen [a] diff --git a/services/gundeck/test/unit/MockGundeck.hs b/services/gundeck/test/unit/MockGundeck.hs index 19d35241dbd..d662a62aa10 100644 --- a/services/gundeck/test/unit/MockGundeck.hs +++ b/services/gundeck/test/unit/MockGundeck.hs @@ -199,11 +199,11 @@ mkFakeAddrEndpoint (epid, transport, app) = Aws.mkSnsArn Tokyo (Account "acc") e -- 2. web socket delivery will NOT work, native push token registered, push will succeed -- 3. web socket delivery will NOT work, native push token registered, push will fail -- 4. web socket delivery will NOT work, no native push token registered -genMockEnv :: HasCallStack => Gen MockEnv +genMockEnv :: (HasCallStack) => Gen MockEnv genMockEnv = do -- This function generates a 'ClientInfo' that corresponds to one of the -- four scenarios above - let genClientInfo :: HasCallStack => UserId -> ClientId -> Gen ClientInfo + let genClientInfo :: (HasCallStack) => UserId -> ClientId -> Gen ClientInfo genClientInfo uid cid = do _ciNativeAddress <- QC.oneof @@ -250,12 +250,12 @@ genMockEnv = do validateMockEnv env & either error (const $ pure env) -- Try to shrink a 'MockEnv' by removing some users from '_meClientInfos'. -shrinkMockEnv :: HasCallStack => MockEnv -> [MockEnv] +shrinkMockEnv :: (HasCallStack) => MockEnv -> [MockEnv] shrinkMockEnv (MockEnv cis) = MockEnv . Map.fromList <$> filter (not . null) (shrinkList (const []) (Map.toList cis)) -validateMockEnv :: forall m. MonadError String m => MockEnv -> m () +validateMockEnv :: forall m. (MonadError String m) => MockEnv -> m () validateMockEnv env = do checkIdsInNativeAddresses where @@ -270,17 +270,17 @@ validateMockEnv env = do unless (uid == adr ^. addrUser && cid == adr ^. addrClient) $ do throwError (show (uid, cid, adr)) -genRecipients :: HasCallStack => Int -> MockEnv -> Gen [Recipient] +genRecipients :: (HasCallStack) => Int -> MockEnv -> Gen [Recipient] genRecipients numrcp env = do uids <- take numrcp <$> shuffle (allUsers env) genRecipient' env `mapM` uids -genRecipient :: HasCallStack => MockEnv -> Gen Recipient +genRecipient :: (HasCallStack) => MockEnv -> Gen Recipient genRecipient env = do uid <- QC.elements (allUsers env) genRecipient' env uid -genRecipient' :: HasCallStack => MockEnv -> UserId -> Gen Recipient +genRecipient' :: (HasCallStack) => MockEnv -> UserId -> Gen Recipient genRecipient' env uid = do route <- genRoute cids <- @@ -290,7 +290,7 @@ genRecipient' env uid = do ] pure $ Recipient uid route cids -genRoute :: HasCallStack => Gen Route +genRoute :: (HasCallStack) => Gen Route genRoute = QC.elements [minBound ..] genId :: Gen (Id a) @@ -301,7 +301,7 @@ genId = do genClientId :: Gen ClientId genClientId = ClientId <$> arbitrary -genProtoAddress :: HasCallStack => UserId -> ClientId -> Gen Address +genProtoAddress :: (HasCallStack) => UserId -> ClientId -> Gen Address genProtoAddress _addrUser _addrClient = do _addrTransport :: Transport <- QC.elements [minBound ..] arnEpId :: Text <- arbitrary @@ -314,7 +314,7 @@ genProtoAddress _addrUser _addrClient = do genPushes :: MockEnv -> Gen [Push] genPushes = listOf . genPush -genPush :: HasCallStack => MockEnv -> Gen Push +genPush :: (HasCallStack) => MockEnv -> Gen Push genPush env = do let alluids = allUsers env sender <- QC.elements alluids @@ -373,14 +373,14 @@ dropSomeDevices = RecipientClientsSome . unsafeList1 . take numdevs <$> QC.shuffle (toList cids) -shrinkPushes :: HasCallStack => [Push] -> [[Push]] +shrinkPushes :: (HasCallStack) => [Push] -> [[Push]] shrinkPushes = shrinkList shrinkPush where - shrinkPush :: HasCallStack => Push -> [Push] + shrinkPush :: (HasCallStack) => Push -> [Push] shrinkPush psh = (\rcps -> psh & pushRecipients .~ rcps) <$> shrinkRecipients (psh ^. pushRecipients) - shrinkRecipients :: HasCallStack => Range 1 1024 (Set Recipient) -> [Range 1 1024 (Set Recipient)] + shrinkRecipients :: (HasCallStack) => Range 1 1024 (Set Recipient) -> [Range 1 1024 (Set Recipient)] shrinkRecipients = fmap unsafeRange . map Set.fromList . filter (not . null) . shrinkList shrinkRecipient . Set.toList . fromRange - shrinkRecipient :: HasCallStack => Recipient -> [Recipient] + shrinkRecipient :: (HasCallStack) => Recipient -> [Recipient] shrinkRecipient _ = [] -- | See 'Payload'. @@ -400,7 +400,7 @@ genNotifs env = fmap uniqNotifs . listOf $ do where uniqNotifs = nubBy ((==) `on` (ntfId . fst)) -shrinkNotifs :: HasCallStack => [(Notification, [Presence])] -> [[(Notification, [Presence])]] +shrinkNotifs :: (HasCallStack) => [(Notification, [Presence])] -> [[(Notification, [Presence])]] shrinkNotifs = shrinkList (\(notif, prcs) -> (notif,) <$> shrinkList (const []) prcs) ---------------------------------------------------------------------- @@ -698,20 +698,20 @@ mockOldSimpleWebPush notif tgts _senderid mconnid connWhitelist = do newtype Pretty a = Pretty a deriving (Eq, Ord) -instance Aeson.ToJSON a => Show (Pretty a) where +instance (Aeson.ToJSON a) => Show (Pretty a) where show (Pretty a) = cs $ Aeson.encodePretty a -shrinkPretty :: HasCallStack => (a -> [a]) -> Pretty a -> [Pretty a] +shrinkPretty :: (HasCallStack) => (a -> [a]) -> Pretty a -> [Pretty a] shrinkPretty shrnk (Pretty xs) = Pretty <$> shrnk xs -sublist1Of :: HasCallStack => [a] -> Gen (List1 a) +sublist1Of :: (HasCallStack) => [a] -> Gen (List1 a) sublist1Of [] = error "sublist1Of: empty list" sublist1Of xs = sublistOf xs >>= \case [] -> sublist1Of xs c : cc -> pure (list1 c cc) -unsafeList1 :: HasCallStack => [a] -> List1 a +unsafeList1 :: (HasCallStack) => [a] -> List1 a unsafeList1 [] = error "unsafeList1: empty list" unsafeList1 (x : xs) = list1 x xs @@ -754,7 +754,7 @@ allUsers = fmap fst . allRecipients allRecipients :: MockEnv -> [(UserId, [ClientId])] allRecipients (MockEnv mp) = (_2 %~ Map.keys) <$> Map.toList mp -clientIdsOfUser :: HasCallStack => MockEnv -> UserId -> [ClientId] +clientIdsOfUser :: (HasCallStack) => MockEnv -> UserId -> [ClientId] clientIdsOfUser (MockEnv mp) uid = maybe (error "unknown UserId") Map.keys $ Map.lookup uid mp diff --git a/services/gundeck/test/unit/ThreadBudget.hs b/services/gundeck/test/unit/ThreadBudget.hs index 0627c91d436..7715d8c8a7c 100644 --- a/services/gundeck/test/unit/ThreadBudget.hs +++ b/services/gundeck/test/unit/ThreadBudget.hs @@ -119,7 +119,7 @@ delay' :: (MonadCatch m, MonadIO m) => Int -> m () delay' microsecs = threadDelay microsecs `catch` \AsyncCancelled -> pure () burstActions :: - HasCallStack => + (HasCallStack) => ThreadBudgetState -> LogHistory -> MilliSeconds -> @@ -211,7 +211,7 @@ data Response r | MeasureResponse Int -- concrete running threads deriving (Show, Generic, Generic1, Rank2.Functor, Rank2.Foldable, Rank2.Traversable) -generator :: HasCallStack => Model Symbolic -> Maybe (Gen (Command Symbolic)) +generator :: (HasCallStack) => Model Symbolic -> Maybe (Gen (Command Symbolic)) generator (Model Nothing) = Just $ Init <$> arbitrary generator (Model (Just st)) = Just $ @@ -221,16 +221,16 @@ generator (Model (Just st)) = pure $ Measure st ] -shrinker :: HasCallStack => Model Symbolic -> Command Symbolic -> [Command Symbolic] +shrinker :: (HasCallStack) => Model Symbolic -> Command Symbolic -> [Command Symbolic] shrinker _ (Init _) = [] shrinker _ (Run st n m) = Wait st (MilliSeconds 1) : (Run st <$> shrink n <*> shrink m) shrinker _ (Wait st n) = Wait st <$> shrink n shrinker _ (Measure _) = [] -initModel :: HasCallStack => Model r +initModel :: (HasCallStack) => Model r initModel = Model Nothing -semantics :: HasCallStack => Command Concrete -> IO (Response Concrete) +semantics :: (HasCallStack) => Command Concrete -> IO (Response Concrete) semantics (Init (NumberOfThreads limit)) = do tbs <- mkThreadBudgetState (MaxConcurrentNativePushes (Just limit) (Just limit)) @@ -254,17 +254,17 @@ semantics (Measure (opaque -> (tbs, _, _))) = concreteRunning <- budgetSpent tbs pure (MeasureResponse concreteRunning) -transition :: HasCallStack => Model r -> Command r -> Response r -> Model r +transition :: (HasCallStack) => Model r -> Command r -> Response r -> Model r transition (Model Nothing) (Init _) (InitResponse st) = Model (Just st) transition (Model (Just st)) Run {} RunResponse = Model (Just st) transition (Model (Just st)) Wait {} WaitResponse = Model (Just st) transition (Model (Just st)) Measure {} MeasureResponse {} = Model (Just st) transition _ _ _ = error "impossible." -precondition :: HasCallStack => Model Symbolic -> Command Symbolic -> Logic +precondition :: (HasCallStack) => Model Symbolic -> Command Symbolic -> Logic precondition _ _ = Top -postcondition :: HasCallStack => Model Concrete -> Command Concrete -> Response Concrete -> Logic +postcondition :: (HasCallStack) => Model Concrete -> Command Concrete -> Response Concrete -> Logic postcondition (Model Nothing) Init {} InitResponse {} = Top postcondition (Model (Just _)) Run {} RunResponse {} = Top postcondition (Model (Just _)) Wait {} WaitResponse {} = Top @@ -284,7 +284,7 @@ postcondition model@(Model (Just _)) cmd@Measure {} resp@(MeasureResponse concre postcondition m c r = error $ "impossible: " <> show (m, c, r) -mock :: HasCallStack => Model Symbolic -> Command Symbolic -> GenSym (Response Symbolic) +mock :: (HasCallStack) => Model Symbolic -> Command Symbolic -> GenSym (Response Symbolic) mock (Model Nothing) (Init _) = InitResponse <$> genSym mock (Model (Just _)) Run {} = pure RunResponse @@ -316,7 +316,7 @@ sm = -- | Remove resources created by the concrete 'STM.Commands', namely watcher and budgeted -- async threads. -shutdown :: Model Concrete -> MonadIO m => m () +shutdown :: Model Concrete -> (MonadIO m) => m () shutdown (Model Nothing) = pure () shutdown (Model (Just (opaque -> (tbs, watcher, _)))) = liftIO $ do cancelAllThreads tbs diff --git a/services/proxy/src/Proxy/API/Public.hs b/services/proxy/src/Proxy/API/Public.hs index de0bf2ccdd1..03fd4b65bd1 100644 --- a/services/proxy/src/Proxy/API/Public.hs +++ b/services/proxy/src/Proxy/API/Public.hs @@ -124,9 +124,12 @@ spotifyToken rq = do when (isError (Client.responseStatus res)) $ debug $ msg (val "unexpected upstream response") - ~~ "upstream" .= val "spotify::token" - ~~ "status" .= S (Client.responseStatus res) - ~~ "body" .= B.take 256 (Client.responseBody res) + ~~ "upstream" + .= val "spotify::token" + ~~ "status" + .= S (Client.responseStatus res) + ~~ "body" + .= B.take 256 (Client.responseBody res) pure $ plain (Client.responseBody res) & setStatus (Client.responseStatus res) @@ -149,9 +152,12 @@ soundcloudResolve url = do when (isError (Client.responseStatus res)) $ debug $ msg (val "unexpected upstream response") - ~~ "upstream" .= val "soundcloud::resolve" - ~~ "status" .= S (Client.responseStatus res) - ~~ "body" .= B.take 256 (Client.responseBody res) + ~~ "upstream" + .= val "soundcloud::resolve" + ~~ "status" + .= S (Client.responseStatus res) + ~~ "body" + .= B.take 256 (Client.responseBody res) pure $ plain (Client.responseBody res) & setStatus (Client.responseStatus res) @@ -176,9 +182,12 @@ soundcloudStream url = do unless (status302 == Client.responseStatus res) $ do debug $ msg (val "unexpected upstream response") - ~~ "upstream" .= val "soundcloud::stream" - ~~ "status" .= S (Client.responseStatus res) - ~~ "body" .= B.take 256 (Client.responseBody res) + ~~ "upstream" + .= val "soundcloud::stream" + ~~ "status" + .= S (Client.responseStatus res) + ~~ "body" + .= B.take 256 (Client.responseBody res) failWith "unexpected upstream response" case Res.getHeader hLocation res of Nothing -> failWith "missing location header" @@ -187,7 +196,7 @@ soundcloudStream url = do x2 :: RetryPolicy x2 = exponentialBackoff 5000 <> limitRetries 2 -handler :: MonadIO m => RetryStatus -> Handler m Bool +handler :: (MonadIO m) => RetryStatus -> Handler m Bool handler = const . Handler $ \case Client.HttpExceptionRequest _ Client.NoResponseDataReceived -> pure True Client.HttpExceptionRequest _ Client.IncompleteHeaders -> pure True diff --git a/services/proxy/src/Proxy/Proxy.hs b/services/proxy/src/Proxy/Proxy.hs index cc7f6c5f8fc..fe65dc4b920 100644 --- a/services/proxy/src/Proxy/Proxy.hs +++ b/services/proxy/src/Proxy/Proxy.hs @@ -66,8 +66,11 @@ lookupReqId l r = case lookup requestIdName (requestHeaders r) of Nothing -> do localRid <- RequestId . UUID.toASCIIBytes <$> UUID.nextRandom Log.info l $ - "request-id" .= localRid - ~~ "method" .= requestMethod r - ~~ "path" .= rawPathInfo r + "request-id" + .= localRid + ~~ "method" + .= requestMethod r + ~~ "path" + .= rawPathInfo r ~~ msg (val "generated a new request id for local request") pure localRid diff --git a/services/spar/default.nix b/services/spar/default.nix index afbe67eb872..fe5d88485e7 100644 --- a/services/spar/default.nix +++ b/services/spar/default.nix @@ -54,6 +54,7 @@ , raw-strings-qq , retry , saml2-web-sso +, semigroupoids , servant , servant-multipart , servant-openapi3 @@ -119,6 +120,7 @@ mkDerivation { QuickCheck raw-strings-qq saml2-web-sso + semigroupoids servant-multipart servant-server text diff --git a/services/spar/migrate-data/src/Spar/DataMigration/V2_UserV2.hs b/services/spar/migrate-data/src/Spar/DataMigration/V2_UserV2.hs index ac7d49efca6..59c30b74b1f 100644 --- a/services/spar/migrate-data/src/Spar/DataMigration/V2_UserV2.hs +++ b/services/spar/migrate-data/src/Spar/DataMigration/V2_UserV2.hs @@ -68,7 +68,7 @@ type CollisionResolver = -- | Use this if you want to paginate without crashing newtype CqlSafe a = CqlSafe {unCqlSafe :: Either String a} -instance Cql a => Cql (CqlSafe a) where +instance (Cql a) => Cql (CqlSafe a) where ctype = Tagged $ untag (ctype @a) toCql _ = error "CqlSafe is not meant for serialization" fromCql val = diff --git a/services/spar/spar.cabal b/services/spar/spar.cabal index 87b8fe0c455..f557ea74082 100644 --- a/services/spar/spar.cabal +++ b/services/spar/spar.cabal @@ -180,6 +180,7 @@ library , QuickCheck , raw-strings-qq , saml2-web-sso >=0.20 + , semigroupoids , servant-multipart , servant-server , text diff --git a/services/spar/src/Spar/API.hs b/services/spar/src/Spar/API.hs index adeaedef8ea..12a53e10b96 100644 --- a/services/spar/src/Spar/API.hs +++ b/services/spar/src/Spar/API.hs @@ -48,7 +48,6 @@ where import Brig.Types.Intra import Cassandra as Cas import Control.Lens hiding ((.=)) -import Control.Monad.Except import qualified Data.ByteString as SBS import Data.ByteString.Builder (toLazyByteString) import Data.Id @@ -244,7 +243,7 @@ authreqPrecheck :: authreqPrecheck msucc merr idpid = validateAuthreqParams msucc merr *> IdPConfigStore.getConfig idpid - $> NoContent + $> NoContent authreq :: ( Member Random r, @@ -278,7 +277,7 @@ authreq authreqttl msucc merr idpid = do redirectURLMaxLength :: Int redirectURLMaxLength = 140 -validateAuthreqParams :: Member (Error SparError) r => Maybe URI.URI -> Maybe URI.URI -> Sem r VerdictFormat +validateAuthreqParams :: (Member (Error SparError) r) => Maybe URI.URI -> Maybe URI.URI -> Sem r VerdictFormat validateAuthreqParams msucc merr = case (msucc, merr) of (Nothing, Nothing) -> pure VerdictFormatWeb (Just ok, Just err) -> do @@ -286,7 +285,7 @@ validateAuthreqParams msucc merr = case (msucc, merr) of pure $ VerdictFormatMobile ok err _ -> throwSparSem $ SparBadInitiateLoginQueryParams "need-both-redirect-urls" -validateRedirectURL :: Member (Error SparError) r => URI.URI -> Sem r () +validateRedirectURL :: (Member (Error SparError) r) => URI.URI -> Sem r () validateRedirectURL uri = do unless ((SBS.take 4 . URI.schemeBS . URI.uriScheme $ uri) == "wire") $ do throwSparSem $ SparBadInitiateLoginQueryParams "invalid-schema" @@ -325,12 +324,13 @@ authresp mbtid arbody = logErrors $ SAML2.authResp mbtid (SamlProtocolSettings.s logErrors action = catch @SparError action $ \case e@(SAML.CustomServant _) -> throw e e -> do - throw @SparError . SAML.CustomServant $ - errorPage + throw @SparError + . SAML.CustomServant + $ errorPage e (Multipart.inputs (SAML.authnResponseBodyRaw arbody)) -ssoSettings :: Member DefaultSsoCode r => Sem r SsoSettings +ssoSettings :: (Member DefaultSsoCode r) => Sem r SsoSettings ssoSettings = SsoSettings <$> DefaultSsoCode.get @@ -442,7 +442,8 @@ idpDelete mbzusr idpid (fromMaybe False -> purge) = withDebugLog "idpDelete" (co else do throwSparSem SparIdPHasBoundUsers when (Cas.hasMore page) $ - SAMLUserStore.nextPage page >>= assertEmptyOrPurge teamId + SAMLUserStore.nextPage page + >>= assertEmptyOrPurge teamId updateOldIssuers :: IdP -> Sem r () updateOldIssuers _ = pure () @@ -719,7 +720,7 @@ validateIdPUpdate zusr _idpMetadata _idpId = withDebugLog "validateIdPUpdate" (J . URI.serializeURIRef uri = _idpMetadata ^. SAML.edIssuer . SAML.fromIssuer -withDebugLog :: Member (Logger String) r => String -> (a -> Maybe String) -> Sem r a -> Sem r a +withDebugLog :: (Member (Logger String) r) => String -> (a -> Maybe String) -> Sem r a -> Sem r a withDebugLog msg showval action = do Logger.log Logger.Debug $ "entering " ++ msg val <- action @@ -747,7 +748,7 @@ authorizeIdP (Just zusr) idp = do GalleyAccess.assertHasPermission teamid CreateUpdateDeleteIdp zusr pure (zusr, teamid) -enforceHttps :: Member (Error SparError) r => URI.URI -> Sem r () +enforceHttps :: (Member (Error SparError) r) => URI.URI -> Sem r () enforceHttps uri = unless ((uri ^. URI.uriSchemeL . URI.schemeBSL) == "https") $ do throwSparSem . SparNewIdPWantHttps . T.fromStrict . SAML.renderURI $ uri @@ -787,9 +788,9 @@ internalPutSsoSettings SsoSettings {defaultSsoCode = Just code} = -- "Could not find IdP". IdPConfigStore.getConfig code *> DefaultSsoCode.store code - $> NoContent + $> NoContent -internalGetScimUserInfo :: Member ScimUserTimesStore r => UserSet -> Sem r ScimUserInfos +internalGetScimUserInfo :: (Member ScimUserTimesStore r) => UserSet -> Sem r ScimUserInfos internalGetScimUserInfo (UserSet uids) = do results <- ScimUserTimesStore.readMulti (Set.toList uids) let scimUserInfos = results <&> (\(uid, t, _) -> ScimUserInfo uid (Just t)) diff --git a/services/spar/src/Spar/App.hs b/services/spar/src/Spar/App.hs index 722b65ab91c..ee2c61ccbfe 100644 --- a/services/spar/src/Spar/App.hs +++ b/services/spar/src/Spar/App.hs @@ -40,7 +40,6 @@ import Bilge import qualified Cassandra as Cas import Control.Exception (assert) import Control.Lens hiding ((.=)) -import Control.Monad.Except import Data.Aeson as Aeson (encode, object, (.=)) import Data.Aeson.Text as Aeson (encodeToLazyText) import Data.ByteString (toStrict) @@ -104,7 +103,7 @@ import qualified Wire.Sem.Logger as Logger import Wire.Sem.Random (Random) import qualified Wire.Sem.Random as Random -throwSparSem :: Member (Error SparError) r => SparCustomError -> Sem r a +throwSparSem :: (Member (Error SparError) r) => SparCustomError -> Sem r a throwSparSem = throw . SAML.CustomError data Env = Env @@ -270,7 +269,7 @@ validateEmail mbTid uid email = do -- 'SAML.Response', and fills in the response id in the header if missing, we can just go for the -- latter. verdictHandler :: - HasCallStack => + (HasCallStack) => ( Member Random r, Member (Logger String) r, Member GalleyAccess r, @@ -312,7 +311,7 @@ data VerdictHandlerResult deriving (Eq, Show) verdictHandlerResult :: - HasCallStack => + (HasCallStack) => ( Member Random r, Member (Logger String) r, Member GalleyAccess r, @@ -395,7 +394,7 @@ moveUserToNewIssuer oldUserRef newUserRef uid = do SAMLUserStore.delete uid oldUserRef verdictHandlerResultCore :: - HasCallStack => + (HasCallStack) => ( Member Random r, Member (Logger String) r, Member GalleyAccess r, @@ -444,7 +443,7 @@ verdictHandlerResultCore idp = \case -- - A title element with contents @wire:sso:@. This is chosen to be easily parseable and -- not be the title of any page sent by the IdP while it negotiates with the user. -- - The page broadcasts a message to '*', to be picked up by the app. -verdictHandlerWeb :: HasCallStack => VerdictHandlerResult -> Sem r SAML.ResponseVerdict +verdictHandlerWeb :: (HasCallStack) => VerdictHandlerResult -> Sem r SAML.ResponseVerdict verdictHandlerWeb = pure . \case VerifyHandlerGranted cky _uid -> successPage cky @@ -610,13 +609,13 @@ deleteTeam team' = do SAMLUserStore.deleteByIssuer issuer IdPConfigStore.deleteConfig idp -sparToServerErrorWithLogging :: Member Reporter r => SparError -> Sem r ServerError +sparToServerErrorWithLogging :: (Member Reporter r) => SparError -> Sem r ServerError sparToServerErrorWithLogging err = do let errServant = sparToServerError err Reporter.report Nothing (servantToWaiError errServant) pure errServant -renderSparErrorWithLogging :: Member Reporter r => SparError -> Sem r (Either ServerError Wai.Error) +renderSparErrorWithLogging :: (Member Reporter r) => SparError -> Sem r (Either ServerError Wai.Error) renderSparErrorWithLogging err = do let errPossiblyWai = renderSparError err Reporter.report Nothing (either servantToWaiError id $ errPossiblyWai) diff --git a/services/spar/src/Spar/Data.hs b/services/spar/src/Spar/Data.hs index ad8915c45c1..fc79c7dfb7b 100644 --- a/services/spar/src/Spar/Data.hs +++ b/services/spar/src/Spar/Data.hs @@ -72,13 +72,13 @@ mkEnv opts now = dataEnvMaxTTLAssertions = maxttlAuthresp opts } -mkTTLAuthnRequests :: MonadError TTLError m => Env -> UTCTime -> m (TTL "authreq") +mkTTLAuthnRequests :: (MonadError TTLError m) => Env -> UTCTime -> m (TTL "authreq") mkTTLAuthnRequests (Env now maxttl _) = mkTTL now maxttl -mkTTLAuthnRequestsNDT :: MonadError TTLError m => Env -> NominalDiffTime -> m (TTL "authreq") +mkTTLAuthnRequestsNDT :: (MonadError TTLError m) => Env -> NominalDiffTime -> m (TTL "authreq") mkTTLAuthnRequestsNDT (Env _ maxttl _) = mkTTLNDT maxttl -mkTTLAssertions :: MonadError TTLError m => Env -> UTCTime -> m (TTL "authresp") +mkTTLAssertions :: (MonadError TTLError m) => Env -> UTCTime -> m (TTL "authresp") mkTTLAssertions (Env now _ maxttl) = mkTTL now maxttl mkTTL :: (MonadError TTLError m, KnownSymbol a) => UTCTime -> TTL a -> UTCTime -> m (TTL a) @@ -87,9 +87,9 @@ mkTTL now maxttl endOfLife = mkTTLNDT maxttl $ endOfLife `diffUTCTime` now mkTTLNDT :: (MonadError TTLError m, KnownSymbol a) => TTL a -> NominalDiffTime -> m (TTL a) mkTTLNDT maxttl ttlNDT = if - | actualttl > maxttl -> throwError $ TTLTooLong (showTTL actualttl) (showTTL maxttl) - | actualttl <= 0 -> throwError $ TTLNegative (showTTL actualttl) - | otherwise -> pure actualttl + | actualttl > maxttl -> throwError $ TTLTooLong (showTTL actualttl) (showTTL maxttl) + | actualttl <= 0 -> throwError $ TTLNegative (showTTL actualttl) + | otherwise -> pure actualttl where actualttl = TTL . nominalDiffToSeconds $ ttlNDT diff --git a/services/spar/src/Spar/Data/Instances.hs b/services/spar/src/Spar/Data/Instances.hs index ebcd75da449..ac5ae4a9cb6 100644 --- a/services/spar/src/Spar/Data/Instances.hs +++ b/services/spar/src/Spar/Data/Instances.hs @@ -34,6 +34,7 @@ where import Cassandra as Cas import Data.ByteString (toStrict) import Data.ByteString.Conversion (fromByteString, toByteString) +import Data.Functor.Alt (Alt (())) import qualified Data.Text.Encoding as T import Data.Text.Encoding.Error import qualified Data.Text.Lazy as LT @@ -125,7 +126,8 @@ instance Cql ScimTokenLookupKey where ScimTokenLookupKeyHashed h -> toCql h ScimTokenLookupKeyPlaintext t -> toCql t fromCql s@(CqlText _) = - ScimTokenLookupKeyHashed <$> fromCql s <|> ScimTokenLookupKeyPlaintext <$> fromCql s + (ScimTokenLookupKeyHashed <$> fromCql s) + (ScimTokenLookupKeyPlaintext <$> fromCql s) fromCql _ = Left "ScimTokenLookupKey: expected CqlText" instance Cql ScimUserCreationStatus where diff --git a/services/spar/src/Spar/Error.hs b/services/spar/src/Spar/Error.hs index 8e3f516abdf..1f90640df73 100644 --- a/services/spar/src/Spar/Error.hs +++ b/services/spar/src/Spar/Error.hs @@ -68,7 +68,7 @@ type SparError = SAML.Error SparCustomError -- FUTUREWORK: This instance should probably be inside saml2-web-sso instead. instance Exception SparError -throwSpar :: MonadError SparError m => SparCustomError -> m a +throwSpar :: (MonadError SparError m) => SparCustomError -> m a throwSpar = throwError . SAML.CustomError data SparCustomError @@ -130,7 +130,7 @@ data IdpDbError | IdpNotFound -- like 'SparIdPNotFound', but a database consistency error. (should we consolidate something anyway?) deriving (Eq, Show) -sparToServerErrorWithLogging :: MonadIO m => Log.Logger -> SparError -> m ServerError +sparToServerErrorWithLogging :: (MonadIO m) => Log.Logger -> SparError -> m ServerError sparToServerErrorWithLogging logger err = do let errServant = sparToServerError err liftIO $ Wai.logError logger (Nothing :: Maybe Wai.Request) (servantToWaiError errServant) diff --git a/services/spar/src/Spar/Intra/Brig.hs b/services/spar/src/Spar/Intra/Brig.hs index d2a97b56dcc..c98333d8a4d 100644 --- a/services/spar/src/Spar/Intra/Brig.hs +++ b/services/spar/src/Spar/Intra/Brig.hs @@ -331,12 +331,12 @@ checkHandleAvailable hnd = do . paths ["/i/users/handles", toByteString' hnd] let sCode = statusCode resp if - | sCode == 200 -> -- handle exists - pure False - | sCode == 404 -> -- handle not found - pure True - | otherwise -> - rethrow "brig" resp + | sCode == 200 -> -- handle exists + pure False + | sCode == 404 -> -- handle not found + pure True + | otherwise -> + rethrow "brig" resp -- | Call brig to delete a user. -- If the user wasn't deleted completely before, another deletion attempt will be made. diff --git a/services/spar/src/Spar/Intra/BrigApp.hs b/services/spar/src/Spar/Intra/BrigApp.hs index 97878fa990c..acca8893826 100644 --- a/services/spar/src/Spar/Intra/BrigApp.hs +++ b/services/spar/src/Spar/Intra/BrigApp.hs @@ -73,7 +73,7 @@ import Wire.API.User.Scim (ValidExternalId (..), runValidExternalIdEither) veidToUserSSOId :: ValidExternalId -> UserSSOId veidToUserSSOId = runValidExternalIdEither UserSSOId (UserScimExternalId . fromEmail) -veidFromUserSSOId :: MonadError String m => UserSSOId -> m ValidExternalId +veidFromUserSSOId :: (MonadError String m) => UserSSOId -> m ValidExternalId veidFromUserSSOId = \case UserSSOId uref -> case urefToEmail uref of @@ -93,7 +93,7 @@ veidFromUserSSOId = \case -- Note: the saml issuer is only needed in the case where a user has been invited via team -- settings and is now onboarded to saml/scim. If this case can safely be ruled out, it's ok -- to just set it to 'Nothing'. -veidFromBrigUser :: MonadError String m => User -> Maybe SAML.Issuer -> m ValidExternalId +veidFromBrigUser :: (MonadError String m) => User -> Maybe SAML.Issuer -> m ValidExternalId veidFromBrigUser usr mIssuer = case (userSSOId usr, userEmail usr, mIssuer) of (Just ssoid, _, _) -> veidFromUserSSOId ssoid (Nothing, Just email, Just issuer) -> pure $ EmailAndUref email (SAML.UserRef issuer (emailToSAMLNameID email)) diff --git a/services/spar/src/Spar/Options.hs b/services/spar/src/Spar/Options.hs index 41279364bd0..32c11360b13 100644 --- a/services/spar/src/Spar/Options.hs +++ b/services/spar/src/Spar/Options.hs @@ -32,7 +32,6 @@ where import Control.Exception import Control.Lens -import Control.Monad.Except import Data.Aeson hiding (fieldLabelModifier) import qualified Data.ByteString as SBS import Data.Time diff --git a/services/spar/src/Spar/Scim/Auth.hs b/services/spar/src/Spar/Scim/Auth.hs index 4ec989f9d4b..35e2b6a394f 100644 --- a/services/spar/src/Spar/Scim/Auth.hs +++ b/services/spar/src/Spar/Scim/Auth.hs @@ -69,7 +69,7 @@ import Wire.Sem.Random (Random) import qualified Wire.Sem.Random as Random -- | An instance that tells @hscim@ how authentication should be done for SCIM routes. -instance Member ScimTokenStore r => Scim.Class.Auth.AuthDB SparTag (Sem r) where +instance (Member ScimTokenStore r) => Scim.Class.Auth.AuthDB SparTag (Sem r) where -- Validate and resolve a given token authCheck :: Maybe ScimToken -> Scim.ScimHandler (Sem r) ScimTokenInfo authCheck Nothing = diff --git a/services/spar/src/Spar/Scim/User.hs b/services/spar/src/Spar/Scim/User.hs index 4b7d4cbdb61..9be802c389e 100644 --- a/services/spar/src/Spar/Scim/User.hs +++ b/services/spar/src/Spar/Scim/User.hs @@ -219,12 +219,12 @@ validateScimUser errloc tokinfo user = do Left err -> throwError err Right validatedUser -> pure validatedUser -tokenInfoToIdP :: Member IdPConfigStore r => ScimTokenInfo -> Scim.ScimHandler (Sem r) (Maybe IdP) +tokenInfoToIdP :: (Member IdPConfigStore r) => ScimTokenInfo -> Scim.ScimHandler (Sem r) (Maybe IdP) tokenInfoToIdP ScimTokenInfo {stiIdP} = mapM (lift . IdPConfigStore.getConfig) stiIdP -- | Validate a handle (@userName@). -validateHandle :: Member (Error Scim.ScimError) r => Text -> Sem r Handle +validateHandle :: (Member (Error Scim.ScimError) r) => Text -> Sem r Handle validateHandle txt = case parseHandle txt of Just h -> pure h Nothing -> @@ -279,8 +279,13 @@ validateScimUser' errloc midp richInfoLimit user = do -- be a little less brittle. uname <- do let err msg = - throw . Scim.badRequest Scim.InvalidValue . Just $ - Text.pack msg <> " (" <> errloc <> ")" + throw + . Scim.badRequest Scim.InvalidValue + . Just + $ Text.pack msg + <> " (" + <> errloc + <> ")" either err pure $ Brig.mkUserName (Scim.displayName user) veid richInfo <- validateRichInfo (Scim.extra user ^. ST.sueRichInfo) let active = Scim.active user @@ -320,8 +325,9 @@ validateScimUser' errloc midp richInfoLimit user = do throw $ ( Scim.badRequest Scim.InvalidValue - ( Just . Text.pack $ - show [RI.richInfoMapURN @Text, RI.richInfoAssocListURN @Text] + ( Just + . Text.pack + $ show [RI.richInfoMapURN @Text, RI.richInfoAssocListURN @Text] <> " together exceed the size limit: max " <> show richInfoLimit <> " characters, but got " @@ -702,7 +708,7 @@ updateVsuUref team uid old new = do BrigAccess.setVeid uid new toScimStoredUser' :: - HasCallStack => + (HasCallStack) => UTCTimeMillis -> UTCTimeMillis -> URIBS.URI -> @@ -733,7 +739,7 @@ toScimStoredUser' createdAt lastChangedAt baseuri uid usr = updScimStoredUser :: forall r. - Member Now r => + (Member Now r) => Scim.User ST.SparTag -> Scim.StoredUser ST.SparTag -> Sem r (Scim.StoredUser ST.SparTag) @@ -918,16 +924,16 @@ assertExternalIdInAllowedValues allowedValues errmsg tid veid = do unless isGood $ throwError Scim.conflict {Scim.detail = Just errmsg} -assertHandleUnused :: Member BrigAccess r => Handle -> Scim.ScimHandler (Sem r) () +assertHandleUnused :: (Member BrigAccess r) => Handle -> Scim.ScimHandler (Sem r) () assertHandleUnused = assertHandleUnused' "userName is already taken" -assertHandleUnused' :: Member BrigAccess r => Text -> Handle -> Scim.ScimHandler (Sem r) () +assertHandleUnused' :: (Member BrigAccess r) => Text -> Handle -> Scim.ScimHandler (Sem r) () assertHandleUnused' msg hndl = lift (BrigAccess.checkHandleAvailable hndl) >>= \case True -> pure () False -> throwError Scim.conflict {Scim.detail = Just msg} -assertHandleNotUsedElsewhere :: Member BrigAccess r => UserId -> Handle -> Scim.ScimHandler (Sem r) () +assertHandleNotUsedElsewhere :: (Member BrigAccess r) => UserId -> Handle -> Scim.ScimHandler (Sem r) () assertHandleNotUsedElsewhere uid hndl = do musr <- lift $ Brig.getBrigUser Brig.WithPendingInvitations uid unless ((userHandle =<< musr) == Just hndl) $ @@ -1018,7 +1024,7 @@ synthesizeStoredUser' :: URIBS.URI -> Locale -> Maybe Role -> - MonadError Scim.ScimError m => m (Scim.StoredUser ST.SparTag) + (MonadError Scim.ScimError m) => m (Scim.StoredUser ST.SparTag) synthesizeStoredUser' uid veid dname handle richInfo accStatus createdAt lastUpdatedAt baseuri locale mbRole = do let scimUser :: Scim.User ST.SparTag scimUser = @@ -1040,7 +1046,7 @@ synthesizeStoredUser' uid veid dname handle richInfo accStatus createdAt lastUpd synthesizeScimUser :: ST.ValidScimUser -> Scim.User ST.SparTag synthesizeScimUser info = let userName = info ^. ST.vsuHandle . to fromHandle - in (Scim.empty ST.userSchemas userName (ST.ScimUserExtra (info ^. ST.vsuRichInfo))) + in (Scim.empty @ST.SparTag ST.userSchemas userName (ST.ScimUserExtra (info ^. ST.vsuRichInfo))) { Scim.externalId = Brig.renderValidExternalId $ info ^. ST.vsuExternalId, Scim.displayName = Just $ fromName (info ^. ST.vsuName), Scim.active = Just . Scim.ScimBool $ info ^. ST.vsuActive, diff --git a/services/spar/src/Spar/Sem/AReqIDStore/Mem.hs b/services/spar/src/Spar/Sem/AReqIDStore/Mem.hs index 6768f59c308..736bfa5cb76 100644 --- a/services/spar/src/Spar/Sem/AReqIDStore/Mem.hs +++ b/services/spar/src/Spar/Sem/AReqIDStore/Mem.hs @@ -32,7 +32,7 @@ import Wire.API.User.Saml (AReqId) import Wire.Sem.Now aReqIDStoreToMem :: - Member Now r => + (Member Now r) => Sem (AReqIDStore ': r) a -> Sem r (Map AReqId SAML.Time, a) aReqIDStoreToMem = (runState mempty .) $ diff --git a/services/spar/src/Spar/Sem/AssIDStore/Mem.hs b/services/spar/src/Spar/Sem/AssIDStore/Mem.hs index 54dcca2d94d..01a7163083c 100644 --- a/services/spar/src/Spar/Sem/AssIDStore/Mem.hs +++ b/services/spar/src/Spar/Sem/AssIDStore/Mem.hs @@ -32,7 +32,7 @@ import Wire.API.User.Saml (AssId) import Wire.Sem.Now assIdStoreToMem :: - Member Now r => + (Member Now r) => Sem (AssIDStore ': r) a -> Sem r (Map AssId SAML.Time, a) assIdStoreToMem = (runState mempty .) $ diff --git a/services/spar/src/Spar/Sem/DefaultSsoCode/Spec.hs b/services/spar/src/Spar/Sem/DefaultSsoCode/Spec.hs index d4dd4ad848d..3f83e9b3459 100644 --- a/services/spar/src/Spar/Sem/DefaultSsoCode/Spec.hs +++ b/services/spar/src/Spar/Sem/DefaultSsoCode/Spec.hs @@ -30,7 +30,7 @@ import Test.Hspec.QuickCheck import Test.QuickCheck propsForInterpreter :: - PropConstraints r f => + (PropConstraints r f) => String -> (forall a. Sem r a -> IO (f a)) -> Spec @@ -48,15 +48,15 @@ propsForInterpreter interpreter lower = do -- A regular type synonym doesn't work due to dreaded impredicative -- polymorphism. class - (Arbitrary IdPId, CoArbitrary IdPId, Functor f, Member E.DefaultSsoCode r, forall z. Show z => Show (f z), forall z. Eq z => Eq (f z)) => + (Arbitrary IdPId, CoArbitrary IdPId, Functor f, Member E.DefaultSsoCode r, forall z. (Show z) => Show (f z), forall z. (Eq z) => Eq (f z)) => PropConstraints r f instance - (Arbitrary IdPId, CoArbitrary IdPId, Functor f, Member E.DefaultSsoCode r, forall z. Show z => Show (f z), forall z. Eq z => Eq (f z)) => + (Arbitrary IdPId, CoArbitrary IdPId, Functor f, Member E.DefaultSsoCode r, forall z. (Show z) => Show (f z), forall z. (Eq z) => Eq (f z)) => PropConstraints r f prop_storeGet :: - PropConstraints r f => + (PropConstraints r f) => Maybe (f (Maybe IdPId) -> String) -> (forall a. Sem r a -> IO (f a)) -> Property @@ -75,7 +75,7 @@ prop_storeGet = ) prop_getStore :: - PropConstraints r f => + (PropConstraints r f) => Maybe (f () -> String) -> (forall a. Sem r a -> IO (f a)) -> Property @@ -91,7 +91,7 @@ prop_getStore = ) prop_storeDelete :: - PropConstraints r f => + (PropConstraints r f) => Maybe (f () -> String) -> (forall a. Sem r a -> IO (f a)) -> Property @@ -109,7 +109,7 @@ prop_storeDelete = ) prop_deleteStore :: - PropConstraints r f => + (PropConstraints r f) => Maybe (f () -> String) -> (forall a. Sem r a -> IO (f a)) -> Property @@ -127,7 +127,7 @@ prop_deleteStore = ) prop_storeStore :: - PropConstraints r f => + (PropConstraints r f) => Maybe (f () -> String) -> (forall a. Sem r a -> IO (f a)) -> Property @@ -146,7 +146,7 @@ prop_storeStore = ) prop_deleteDelete :: - PropConstraints r f => + (PropConstraints r f) => Maybe (f () -> String) -> (forall a. Sem r a -> IO (f a)) -> Property @@ -163,7 +163,7 @@ prop_deleteDelete = ) prop_deleteGet :: - PropConstraints r f => + (PropConstraints r f) => Maybe (f (Maybe IdPId) -> String) -> (forall a. Sem r a -> IO (f a)) -> Property diff --git a/services/spar/src/Spar/Sem/IdPRawMetadataStore/Spec.hs b/services/spar/src/Spar/Sem/IdPRawMetadataStore/Spec.hs index f55560cf769..1a8805e8afe 100644 --- a/services/spar/src/Spar/Sem/IdPRawMetadataStore/Spec.hs +++ b/services/spar/src/Spar/Sem/IdPRawMetadataStore/Spec.hs @@ -30,15 +30,15 @@ import Test.Hspec.QuickCheck import Test.QuickCheck class - (Arbitrary IdPId, CoArbitrary IdPId, Arbitrary Text, CoArbitrary Text, Functor f, Member E.IdPRawMetadataStore r, forall z. Show z => Show (f z), forall z. Eq z => Eq (f z)) => + (Arbitrary IdPId, CoArbitrary IdPId, Arbitrary Text, CoArbitrary Text, Functor f, Member E.IdPRawMetadataStore r, forall z. (Show z) => Show (f z), forall z. (Eq z) => Eq (f z)) => PropConstraints r f instance - (Arbitrary IdPId, CoArbitrary IdPId, Arbitrary Text, CoArbitrary Text, Functor f, Member E.IdPRawMetadataStore r, forall z. Show z => Show (f z), forall z. Eq z => Eq (f z)) => + (Arbitrary IdPId, CoArbitrary IdPId, Arbitrary Text, CoArbitrary Text, Functor f, Member E.IdPRawMetadataStore r, forall z. (Show z) => Show (f z), forall z. (Eq z) => Eq (f z)) => PropConstraints r f prop_storeGetRaw :: - PropConstraints r f => + (PropConstraints r f) => Maybe (f (Maybe Text) -> String) -> (forall a. Sem r a -> IO (f a)) -> Property @@ -60,7 +60,7 @@ prop_storeGetRaw = ) prop_storeStoreRaw :: - PropConstraints r f => + (PropConstraints r f) => Maybe (f (Maybe Text) -> String) -> (forall a. Sem r a -> IO (f a)) -> Property @@ -84,7 +84,7 @@ prop_storeStoreRaw = ) prop_storeDeleteRaw :: - PropConstraints r f => + (PropConstraints r f) => Maybe (f (Maybe Text) -> String) -> (forall a. Sem r a -> IO (f a)) -> Property @@ -106,7 +106,7 @@ prop_storeDeleteRaw = ) prop_deleteGetRaw :: - PropConstraints r f => + (PropConstraints r f) => Maybe (f (Maybe Text) -> String) -> (forall a. Sem r a -> IO (f a)) -> Property @@ -131,7 +131,7 @@ prop_deleteGetRaw = ) propsForInterpreter :: - PropConstraints r f => + (PropConstraints r f) => (forall x. f x -> x) -> (forall a. Sem r a -> IO (f a)) -> Spec diff --git a/services/spar/src/Spar/Sem/SAML2.hs b/services/spar/src/Spar/Sem/SAML2.hs index 1e7168370b8..f94c87fe020 100644 --- a/services/spar/src/Spar/Sem/SAML2.hs +++ b/services/spar/src/Spar/Sem/SAML2.hs @@ -50,7 +50,7 @@ data SAML2 m a where SAML2 m resp Meta :: Text -> m Issuer -> m URI -> SAML2 m SPMetadata ToggleCookie :: - KnownSymbol name => + (KnownSymbol name) => ByteString -> Maybe (Text, NominalDiffTime) -> SAML2 m (SimpleSetCookie name) diff --git a/services/spar/src/Spar/Sem/SAML2/Library.hs b/services/spar/src/Spar/Sem/SAML2/Library.hs index 67059ce4c85..e728fe6d0be 100644 --- a/services/spar/src/Spar/Sem/SAML2/Library.hs +++ b/services/spar/src/Spar/Sem/SAML2/Library.hs @@ -62,10 +62,10 @@ wrapMonadClientSPImpl action = . show @SomeException ) -instance Member (Final IO) r => Catch.MonadThrow (SPImpl r) where +instance (Member (Final IO) r) => Catch.MonadThrow (SPImpl r) where throwM = SPImpl . embedFinal . Catch.throwM @IO -instance Member (Final IO) r => Catch.MonadCatch (SPImpl r) where +instance (Member (Final IO) r) => Catch.MonadCatch (SPImpl r) where catch (SPImpl m) handler = SPImpl $ withStrategicToFinal @IO $ do m' <- runS m @@ -76,21 +76,21 @@ instance Member (Final IO) r => Catch.MonadCatch (SPImpl r) where newtype SPImpl r a = SPImpl {unSPImpl :: Sem r a} deriving (Functor, Applicative, Monad) -instance Member (Input Opts) r => HasConfig (SPImpl r) where +instance (Member (Input Opts) r) => HasConfig (SPImpl r) where getConfig = SPImpl $ inputs saml instance - Member (Logger String) r => + (Member (Logger String) r) => HasLogger (SPImpl r) where logger lvl = SPImpl . Logger.log (Logger.samlFromLevel lvl) -instance Member (Embed IO) r => MonadIO (SPImpl r) where +instance (Member (Embed IO) r) => MonadIO (SPImpl r) where liftIO = SPImpl . embed @IO -instance Member (Embed IO) r => HasCreateUUID (SPImpl r) +instance (Member (Embed IO) r) => HasCreateUUID (SPImpl r) -instance Member (Embed IO) r => HasNow (SPImpl r) +instance (Member (Embed IO) r) => HasNow (SPImpl r) instance ( Member (Error SparError) r, @@ -130,7 +130,7 @@ instance Nothing -> IdPConfigStore.getIdPByIssuerV1 issuer Just team -> IdPConfigStore.getIdPByIssuerV2 issuer team -instance Member (Error SparError) r => MonadError SparError (SPImpl r) where +instance (Member (Error SparError) r) => MonadError SparError (SPImpl r) where throwError = SPImpl . throw catchError m handler = SPImpl $ catch (unSPImpl m) $ unSPImpl . handler diff --git a/services/spar/src/Spar/Sem/SAMLUserStore/Cassandra.hs b/services/spar/src/Spar/Sem/SAMLUserStore/Cassandra.hs index b7249074273..3436a83acd6 100644 --- a/services/spar/src/Spar/Sem/SAMLUserStore/Cassandra.hs +++ b/services/spar/src/Spar/Sem/SAMLUserStore/Cassandra.hs @@ -27,7 +27,6 @@ where import Cassandra as Cas import Control.Lens -import Control.Monad.Except import Data.Id import Imports import Polysemy @@ -43,13 +42,14 @@ samlUserStoreToCassandra :: Sem r a samlUserStoreToCassandra = interpret $ - embed . \case - Insert ur uid -> insertSAMLUser ur uid - Get ur -> getSAMLUser ur - DeleteByIssuer is -> deleteSAMLUsersByIssuer is - Delete uid ur -> deleteSAMLUser uid ur - GetAllByIssuerPaginated is -> getAllSAMLUsersByIssuerPaginated is - NextPage page -> nextPage' page + embed + . \case + Insert ur uid -> insertSAMLUser ur uid + Get ur -> getSAMLUser ur + DeleteByIssuer is -> deleteSAMLUsersByIssuer is + Delete uid ur -> deleteSAMLUser uid ur + GetAllByIssuerPaginated is -> getAllSAMLUsersByIssuerPaginated is + NextPage page -> nextPage' page nextPage' :: (HasCallStack, MonadClient m) => Cas.Page a -> m (Cas.Page a) nextPage' = Cas.liftClient . Cas.nextPage diff --git a/services/spar/src/Spar/Sem/ScimExternalIdStore/Spec.hs b/services/spar/src/Spar/Sem/ScimExternalIdStore/Spec.hs index 38ad7834c00..eab1ba7d47f 100644 --- a/services/spar/src/Spar/Sem/ScimExternalIdStore/Spec.hs +++ b/services/spar/src/Spar/Sem/ScimExternalIdStore/Spec.hs @@ -31,7 +31,7 @@ import Test.Hspec.QuickCheck import Test.QuickCheck propsForInterpreter :: - PropConstraints r f => + (PropConstraints r f) => String -> (forall a. f a -> a) -> (forall a. Sem r a -> IO (f a)) -> @@ -52,15 +52,15 @@ propsForInterpreter interpreter extract lower = do -- A regular type synonym doesn't work due to dreaded impredicative -- polymorphism. class - (Arbitrary UserId, CoArbitrary UserId, Arbitrary ScimUserCreationStatus, CoArbitrary ScimUserCreationStatus, Functor f, Member E.ScimExternalIdStore r, forall z. Show z => Show (f z), forall z. Eq z => Eq (f z)) => + (Arbitrary UserId, CoArbitrary UserId, Arbitrary ScimUserCreationStatus, CoArbitrary ScimUserCreationStatus, Functor f, Member E.ScimExternalIdStore r, forall z. (Show z) => Show (f z), forall z. (Eq z) => Eq (f z)) => PropConstraints r f instance - (CoArbitrary UserId, CoArbitrary ScimUserCreationStatus, Functor f, Member E.ScimExternalIdStore r, forall z. Show z => Show (f z), forall z. Eq z => Eq (f z)) => + (CoArbitrary UserId, CoArbitrary ScimUserCreationStatus, Functor f, Member E.ScimExternalIdStore r, forall z. (Show z) => Show (f z), forall z. (Eq z) => Eq (f z)) => PropConstraints r f prop_insertLookup :: - PropConstraints r f => + (PropConstraints r f) => Maybe (f (Maybe UserId) -> String) -> (forall a. Sem r a -> IO (f a)) -> Property @@ -81,7 +81,7 @@ prop_insertLookup = ) prop_lookupInsert :: - PropConstraints r f => + (PropConstraints r f) => Maybe (f () -> String) -> (forall a. Sem r a -> IO (f a)) -> Property @@ -99,7 +99,7 @@ prop_lookupInsert = ) prop_insertDelete :: - PropConstraints r f => + (PropConstraints r f) => Maybe (f () -> String) -> (forall a. Sem r a -> IO (f a)) -> Property @@ -119,7 +119,7 @@ prop_insertDelete = ) prop_deleteInsert :: - PropConstraints r f => + (PropConstraints r f) => Maybe (f () -> String) -> (forall a. Sem r a -> IO (f a)) -> Property @@ -139,7 +139,7 @@ prop_deleteInsert = ) prop_insertInsert :: - PropConstraints r f => + (PropConstraints r f) => Maybe (f (Maybe UserId) -> String) -> (forall a. Sem r a -> IO (f a)) -> Property @@ -162,7 +162,7 @@ prop_insertInsert = ) prop_deleteDelete :: - PropConstraints r f => + (PropConstraints r f) => Maybe (f () -> String) -> (forall a. Sem r a -> IO (f a)) -> Property @@ -181,7 +181,7 @@ prop_deleteDelete = ) prop_deleteLookup :: - PropConstraints r f => + (PropConstraints r f) => Maybe (f (Maybe UserId) -> String) -> (forall a. Sem r a -> IO (f a)) -> Property diff --git a/services/spar/src/Spar/Sem/ScimTokenStore/Cassandra.hs b/services/spar/src/Spar/Sem/ScimTokenStore/Cassandra.hs index 1dd8e176921..6f56b34e77c 100644 --- a/services/spar/src/Spar/Sem/ScimTokenStore/Cassandra.hs +++ b/services/spar/src/Spar/Sem/ScimTokenStore/Cassandra.hs @@ -25,7 +25,6 @@ module Spar.Sem.ScimTokenStore.Cassandra (scimTokenStoreToCassandra) where import Cassandra as Cas import Control.Arrow (Arrow ((&&&))) import Control.Lens -import Control.Monad.Except import Data.Id import Data.Time import Imports @@ -44,12 +43,13 @@ scimTokenStoreToCassandra :: Sem r a scimTokenStoreToCassandra = interpret $ - embed @m . \case - Insert st sti -> insertScimToken st sti - Lookup st -> lookupScimToken st - LookupByTeam tid -> getScimTokens tid - Delete tid ur -> deleteScimToken tid ur - DeleteByTeam tid -> deleteTeamScimTokens tid + embed @m + . \case + Insert st sti -> insertScimToken st sti + Lookup st -> lookupScimToken st + LookupByTeam tid -> getScimTokens tid + Delete tid ur -> deleteScimToken tid ur + DeleteByTeam tid -> deleteTeamScimTokens tid ---------------------------------------------------------------------- -- SCIM auth @@ -114,7 +114,7 @@ lookupScimToken token = do FROM team_provisioning_by_token WHERE token_ in (?, ?) |] - convert :: MonadClient m => ScimToken -> ScimTokenRow -> m (Maybe ScimTokenInfo) + convert :: (MonadClient m) => ScimToken -> ScimTokenRow -> m (Maybe ScimTokenInfo) convert plain row = do let tokenInfo = fromScimTokenRow row connvertPlaintextToken plain tokenInfo diff --git a/services/spar/src/Spar/Sem/Utils.hs b/services/spar/src/Spar/Sem/Utils.hs index 277a4a402b6..9ed9a421cd3 100644 --- a/services/spar/src/Spar/Sem/Utils.hs +++ b/services/spar/src/Spar/Sem/Utils.hs @@ -29,7 +29,7 @@ where import Bilge import Cassandra as Cas import qualified Control.Monad.Catch as Catch -import Control.Monad.Except +import Control.Monad.Except (ExceptT (..), MonadError, runExceptT) import qualified Data.Text.Lazy as LText import Imports hiding (log) import Polysemy @@ -67,10 +67,10 @@ interpretClientToIO ctx = interpret $ \case . show @SomeException pure $ action' `Catch.catch` \e -> handler' $ e <$ st -ttlErrorToSparError :: Member (Error SparError) r => Sem (Error TTLError ': r) a -> Sem r a +ttlErrorToSparError :: (Member (Error SparError) r) => Sem (Error TTLError ': r) a -> Sem r a ttlErrorToSparError = mapError (SAML.CustomError . SparCassandraTTLError) -idpDbErrorToSparError :: Member (Error SparError) r => Sem (Error IdpDbError ': r) a -> Sem r a +idpDbErrorToSparError :: (Member (Error SparError) r) => Sem (Error IdpDbError ': r) a -> Sem r a idpDbErrorToSparError = mapError (SAML.CustomError . IdpDbError) data RunHttpEnv r = RunHttpEnv @@ -83,10 +83,10 @@ newtype RunHttp r a = RunHttp } deriving newtype (Functor, Applicative, Monad, MonadError SparError, MonadReader (RunHttpEnv r)) -instance Member (Embed IO) r => MonadIO (RunHttp r) where +instance (Member (Embed IO) r) => MonadIO (RunHttp r) where liftIO = semToRunHttp . embed -instance Member (Embed IO) r => MonadHttp (RunHttp r) where +instance (Member (Embed IO) r) => MonadHttp (RunHttp r) where handleRequestWithCont r fribia = RunHttp $ lift $ @@ -97,7 +97,7 @@ semToRunHttp :: Sem r a -> RunHttp r a semToRunHttp = RunHttp . lift . lift . lift viaRunHttp :: - Member (Error SparError) r => + (Member (Error SparError) r) => RunHttpEnv r -> RunHttp r a -> Sem r a @@ -107,7 +107,7 @@ viaRunHttp env m = do Left err -> throw err Right a -> pure a -instance Member (Logger (TinyLog.Msg -> TinyLog.Msg)) r => TinyLog.MonadLogger (RunHttp r) where +instance (Member (Logger (TinyLog.Msg -> TinyLog.Msg)) r) => TinyLog.MonadLogger (RunHttp r) where log lvl msg = semToRunHttp $ Logger.log (Logger.fromLevel lvl) msg instance diff --git a/services/spar/src/Spar/Sem/VerdictFormatStore/Cassandra.hs b/services/spar/src/Spar/Sem/VerdictFormatStore/Cassandra.hs index c396fb28fbe..2f4dea03beb 100644 --- a/services/spar/src/Spar/Sem/VerdictFormatStore/Cassandra.hs +++ b/services/spar/src/Spar/Sem/VerdictFormatStore/Cassandra.hs @@ -25,7 +25,6 @@ where import Cassandra as Cas import Control.Lens -import Control.Monad.Except import Data.Time import Imports import Polysemy diff --git a/services/spar/src/Spar/Sem/VerdictFormatStore/Mem.hs b/services/spar/src/Spar/Sem/VerdictFormatStore/Mem.hs index 322dfd6b509..12ecf2368ad 100644 --- a/services/spar/src/Spar/Sem/VerdictFormatStore/Mem.hs +++ b/services/spar/src/Spar/Sem/VerdictFormatStore/Mem.hs @@ -34,7 +34,7 @@ import Wire.Sem.Now (Now, boolTTL) import qualified Wire.Sem.Now as Now verdictFormatStoreToMem :: - Member Now r => + (Member Now r) => Sem (VerdictFormatStore ': r) a -> Sem r (Map AReqId (SAML.Time, VerdictFormat), a) verdictFormatStoreToMem = diff --git a/services/spar/test-integration/Test/MetricsSpec.hs b/services/spar/test-integration/Test/MetricsSpec.hs index b4417b01566..1892bc41c23 100644 --- a/services/spar/test-integration/Test/MetricsSpec.hs +++ b/services/spar/test-integration/Test/MetricsSpec.hs @@ -29,7 +29,7 @@ import Data.String.Conversions import Imports import Util -spec :: HasCallStack => SpecWith TestEnv +spec :: (HasCallStack) => SpecWith TestEnv spec = describe "metrics" . it "works" $ do spar <- asks (^. teSpar) let p1 = "/sso/metadata" diff --git a/services/spar/test-integration/Test/Spar/APISpec.hs b/services/spar/test-integration/Test/Spar/APISpec.hs index ea777758532..6a1958b0905 100644 --- a/services/spar/test-integration/Test/Spar/APISpec.hs +++ b/services/spar/test-integration/Test/Spar/APISpec.hs @@ -193,7 +193,7 @@ specInitiateLogin = do let uuid = cs $ UUID.toText UUID.nil get ((env ^. teSpar) . path (cs $ "/sso/initiate-login/" -/ uuid)) `shouldRespondWith` ((== 404) . statusCode) - let checkRespBody :: HasCallStack => ResponseLBS -> Bool + let checkRespBody :: (HasCallStack) => ResponseLBS -> Bool checkRespBody (responseBody -> Just (cs -> bdy)) = all (`isInfixOf` bdy) @@ -219,7 +219,7 @@ specFinalizeLogin = do testRejectsSAMLResponseSayingAccessNotGranted context "access granted" $ do - let loginSuccess :: HasCallStack => ResponseLBS -> TestSpar () + let loginSuccess :: (HasCallStack) => ResponseLBS -> TestSpar () loginSuccess sparresp = liftIO $ do statusCode sparresp `shouldBe` 200 let bdy = maybe "" (cs @LByteString @String) (responseBody sparresp) @@ -229,7 +229,7 @@ specFinalizeLogin = do bdy `shouldContain` "window.opener.postMessage({type: 'AUTH_SUCCESS'}, receiverOrigin)" hasPersistentCookieHeader sparresp `shouldBe` Right () - let loginFailure :: HasCallStack => ResponseLBS -> TestSpar () + let loginFailure :: (HasCallStack) => ResponseLBS -> TestSpar () loginFailure sparresp = liftIO $ do statusCode sparresp `shouldBe` 200 let bdy = maybe "" (cs @LByteString @String) (responseBody sparresp) @@ -393,7 +393,7 @@ specFinalizeLogin = do (idp, (_, privcreds)) <- registerTestIdPWithMeta ownerid spmeta <- getTestSPMetadata tid - let loginSuccess :: HasCallStack => ResponseLBS -> TestSpar () + let loginSuccess :: (HasCallStack) => ResponseLBS -> TestSpar () loginSuccess sparresp = liftIO $ do statusCode sparresp `shouldBe` 200 @@ -423,7 +423,7 @@ specFinalizeLogin = do mbId2 `shouldSatisfy` isJust mbId1 `shouldBe` mbId2 -testGetPutDelete :: HasCallStack => (SparReq -> Maybe UserId -> IdPId -> IdPMetadataInfo -> Http ResponseLBS) -> SpecWith TestEnv +testGetPutDelete :: (HasCallStack) => (SparReq -> Maybe UserId -> IdPId -> IdPMetadataInfo -> Http ResponseLBS) -> SpecWith TestEnv testGetPutDelete whichone = do context "unknown IdP" $ do it "responds with 'not found'" $ do @@ -816,7 +816,7 @@ specCRUDIdentityProvider = do liftIO $ requri `shouldBe` idpmeta' ^. edRequestURI describe "new certs" $ do let -- Create a team, idp, and update idp with 'sampleIdPCert2'. - initidp :: HasCallStack => TestSpar (IdP, SignPrivCreds, SignPrivCreds) + initidp :: (HasCallStack) => TestSpar (IdP, SignPrivCreds, SignPrivCreds) initidp = do env <- ask (owner, _tid) <- callCreateUserWithTeam @@ -828,7 +828,7 @@ specCRUDIdentityProvider = do pure (idp, oldPrivKey, newPrivKey) -- Sign authn response with a given private key (which may be the one matching -- 'sampleIdPCert2' or not), and check the status of spars response. - check :: HasCallStack => Bool -> Int -> String -> Either String () -> TestSpar () + check :: (HasCallStack) => Bool -> Int -> String -> Either String () -> TestSpar () check useNewPrivKey expectedStatus expectedHtmlTitle expectedCookie = do (idp, oldPrivKey, newPrivKey) <- initidp let tid = idp ^. idpExtraInfo . team @@ -1043,7 +1043,7 @@ specCRUDIdentityProvider = do scimStoredUser <- createUser tok scimUser let checkScimSearch :: - HasCallStack => + (HasCallStack) => Scim.StoredUser SparTag -> Scim.User SparTag -> ReaderT TestEnv IO () @@ -1223,12 +1223,12 @@ specDeleteCornerCases = describe "delete corner cases" $ do (Just _) <- createViaSaml idp privcreds uref samlUserShouldSatisfy uref isJust where - samlUserShouldSatisfy :: HasCallStack => SAML.UserRef -> (Maybe UserId -> Bool) -> TestSpar () + samlUserShouldSatisfy :: (HasCallStack) => SAML.UserRef -> (Maybe UserId -> Bool) -> TestSpar () samlUserShouldSatisfy uref property = do muid <- getUserIdViaRef' uref liftIO $ muid `shouldSatisfy` property - createViaSamlResp :: HasCallStack => IdP -> SignPrivCreds -> SAML.UserRef -> TestSpar ResponseLBS + createViaSamlResp :: (HasCallStack) => IdP -> SignPrivCreds -> SAML.UserRef -> TestSpar ResponseLBS createViaSamlResp idp privCreds (SAML.UserRef _ subj) = do let tid = idp ^. idpExtraInfo . team authnReq <- negotiateAuthnRequest idp @@ -1238,7 +1238,7 @@ specDeleteCornerCases = describe "delete corner cases" $ do liftIO $ responseStatus createResp `shouldBe` status200 pure createResp - createViaSaml :: HasCallStack => IdP -> SignPrivCreds -> SAML.UserRef -> TestSpar (Maybe UserId) + createViaSaml :: (HasCallStack) => IdP -> SignPrivCreds -> SAML.UserRef -> TestSpar (Maybe UserId) createViaSaml idp privcreds uref = do resp <- createViaSamlResp idp privcreds uref liftIO $ do @@ -1398,7 +1398,7 @@ specAux :: SpecWith TestEnv specAux = do describe "test helper functions" $ do describe "createTeamMember" $ do - let check :: HasCallStack => Bool -> Int -> SpecWith TestEnv + let check :: (HasCallStack) => Bool -> Int -> SpecWith TestEnv check tryowner permsix = it ("works: tryowner == " <> show (tryowner, permsix)) $ do env <- ask @@ -1509,7 +1509,7 @@ specSsoSettings = do -- TODO: what else needs to be tested, beyond the pending tests listed here? -- TODO: what tests can go to saml2-web-sso package? -getSsoidViaAuthResp :: HasCallStack => SignedAuthnResponse -> TestSpar UserSSOId +getSsoidViaAuthResp :: (HasCallStack) => SignedAuthnResponse -> TestSpar UserSSOId getSsoidViaAuthResp aresp = do parsed :: AuthnResponse <- either error pure . parseFromDocument $ fromSignedAuthnResponse aresp diff --git a/services/spar/test-integration/Test/Spar/AppSpec.hs b/services/spar/test-integration/Test/Spar/AppSpec.hs index ccc5d4ac103..af05a544434 100644 --- a/services/spar/test-integration/Test/Spar/AppSpec.hs +++ b/services/spar/test-integration/Test/Spar/AppSpec.hs @@ -141,7 +141,7 @@ mkAuthnReqMobile idpid = do -- fresh, iff the verdict is "granted" the user will be created during the call to -- 'Spar.verdictHandler'. requestAccessVerdict :: - HasCallStack => + (HasCallStack) => IdP -> -- | is the verdict granted? Bool -> diff --git a/services/spar/test-integration/Test/Spar/DataSpec.hs b/services/spar/test-integration/Test/Spar/DataSpec.hs index 886f084f2d6..25f1ee2f468 100644 --- a/services/spar/test-integration/Test/Spar/DataSpec.hs +++ b/services/spar/test-integration/Test/Spar/DataSpec.hs @@ -25,7 +25,6 @@ where import Cassandra import Control.Lens -import Control.Monad.Except import Data.Kind (Type) import Imports import Polysemy diff --git a/services/spar/test-integration/Test/Spar/Scim/UserSpec.hs b/services/spar/test-integration/Test/Spar/Scim/UserSpec.hs index 681c3ae0685..b3831dc66f5 100644 --- a/services/spar/test-integration/Test/Spar/Scim/UserSpec.hs +++ b/services/spar/test-integration/Test/Spar/Scim/UserSpec.hs @@ -210,12 +210,12 @@ specImportToScimFromInvitation = check False check True where - createTeam :: HasCallStack => TestSpar (UserId, TeamId) + createTeam :: (HasCallStack) => TestSpar (UserId, TeamId) createTeam = do env <- ask call $ createUserWithTeam (env ^. teBrig) (env ^. teGalley) - invite :: HasCallStack => UserId -> TeamId -> TestSpar (UserId, Email) + invite :: (HasCallStack) => UserId -> TeamId -> TestSpar (UserId, Email) invite owner teamid = do env <- ask email <- randomEmail @@ -224,7 +224,7 @@ specImportToScimFromInvitation = emailInvited = fromMaybe (error "must have email") (userEmail memberInvited) pure (memberIdInvited, emailInvited) - addSamlIdP :: HasCallStack => UserId -> TestSpar (SAML.IdPConfig User.WireIdP, SAML.SignPrivCreds) + addSamlIdP :: (HasCallStack) => UserId -> TestSpar (SAML.IdPConfig User.WireIdP, SAML.SignPrivCreds) addSamlIdP userid = do env <- ask apiVersion <- view teWireIdPAPIVersion @@ -233,7 +233,7 @@ specImportToScimFromInvitation = pure (idp, privkey) reProvisionWithScim :: - HasCallStack => + (HasCallStack) => Bool -> Maybe (SAML.IdPConfig User.WireIdP) -> TeamId -> @@ -267,7 +267,7 @@ specImportToScimFromInvitation = (SAML.IdPConfig User.WireIdP, SAML.SignPrivCreds) -> Email -> UserId -> TestSpar () + signInWithSaml :: (HasCallStack) => (SAML.IdPConfig User.WireIdP, SAML.SignPrivCreds) -> Email -> UserId -> TestSpar () signInWithSaml (idp, privCreds) email userid = do let uref = SAML.UserRef tenant subj subj = emailToSAMLNameID email @@ -276,7 +276,7 @@ specImportToScimFromInvitation = liftIO $ mbUid `shouldBe` Just userid checkCsvDownload :: - HasCallStack => + (HasCallStack) => UserId -> TeamId -> SAML.IdPConfig User.WireIdP -> @@ -333,18 +333,18 @@ findUserByEmail tok email = do [fstUser] -> pure fstUser _ -> error "expected exactly one user" -assertSparCassandraUref :: HasCallStack => (SAML.UserRef, Maybe UserId) -> TestSpar () +assertSparCassandraUref :: (HasCallStack) => (SAML.UserRef, Maybe UserId) -> TestSpar () assertSparCassandraUref (uref, urefAnswer) = do liftIO . (`shouldBe` urefAnswer) =<< runSpar (SAMLUserStore.get uref) -assertSparCassandraScim :: HasCallStack => ((TeamId, Email), Maybe UserId) -> TestSpar () +assertSparCassandraScim :: (HasCallStack) => ((TeamId, Email), Maybe UserId) -> TestSpar () assertSparCassandraScim ((teamid, email), scimAnswer) = do liftIO . (`shouldBe` scimAnswer) =<< runSpar (ScimExternalIdStore.lookup teamid email) assertBrigCassandra :: - HasCallStack => + (HasCallStack) => UserId -> SAML.UserRef -> Scim.User.User SparTag -> @@ -504,7 +504,7 @@ specCreateUser = describe "POST /Users" $ do pendingWith "factor this out of the PUT tests we already wrote." testCsvData :: - HasCallStack => + (HasCallStack) => TeamId -> UserId -> UserId -> @@ -544,7 +544,7 @@ testCsvData tid owner uid mbeid mbsaml hasissuer = do Nothing -> "" ('n', CsvExport.tExportSAMLNamedId export) `shouldBe` ('n', haveSubject) -decodeCSV :: Csv.FromNamedRecord a => LByteString -> [a] +decodeCSV :: (Csv.FromNamedRecord a) => LByteString -> [a] decodeCSV bstr = either (error "could not decode csv") (V.toList . snd) (Csv.decodeByName bstr) @@ -715,7 +715,7 @@ testCreateUserNoIdP = do where -- cloned from brig's integration tests - searchUser :: HasCallStack => BrigReq -> UserId -> Name -> Bool -> TestSpar () + searchUser :: (HasCallStack) => BrigReq -> UserId -> Name -> Bool -> TestSpar () searchUser brig searcherId searchTarget shouldSucceed = do refreshIndex brig aFewTimesAssert @@ -779,7 +779,7 @@ testCreateUserWithSamlIdP = do let uid = userId brigUser eid = Scim.User.externalId user - sml :: HasCallStack => UserSSOId + sml :: (HasCallStack) => UserSSOId sml = fromJust $ ssoIdentity =<< userIdentity brigUser in testCsvData tid owner uid eid (Just sml) True @@ -958,7 +958,7 @@ testRichInfo = do (tok, (owner, _, _)) <- registerIdPAndScimToken let -- validate response checkStoredUser :: - HasCallStack => + (HasCallStack) => Scim.UserC.StoredUser SparTag -> RichInfo -> TestSpar () @@ -967,7 +967,7 @@ testRichInfo = do `shouldBe` ScimUserExtra rinf -- validate server state after the fact probeUser :: - HasCallStack => + (HasCallStack) => UserId -> RichInfo -> TestSpar () @@ -1053,12 +1053,12 @@ testScimCreateVsUserRef = do tenant' = idp ^. SAML.idpMetadata . SAML.edIssuer createViaSamlFails idp privCreds uref' -samlUserShouldSatisfy :: HasCallStack => SAML.UserRef -> (Maybe UserId -> Bool) -> TestSpar () +samlUserShouldSatisfy :: (HasCallStack) => SAML.UserRef -> (Maybe UserId -> Bool) -> TestSpar () samlUserShouldSatisfy uref property = do muid <- getUserIdViaRef' uref liftIO $ muid `shouldSatisfy` property -createViaSamlResp :: HasCallStack => IdP -> SAML.SignPrivCreds -> SAML.UserRef -> TestSpar ResponseLBS +createViaSamlResp :: (HasCallStack) => IdP -> SAML.SignPrivCreds -> SAML.UserRef -> TestSpar ResponseLBS createViaSamlResp idp privCreds (SAML.UserRef _ subj) = do authnReq <- negotiateAuthnRequest idp let tid = idp ^. SAML.idpExtraInfo . User.team @@ -1068,14 +1068,14 @@ createViaSamlResp idp privCreds (SAML.UserRef _ subj) = do SAML.mkAuthnResponseWithSubj subj privCreds idp spmeta authnReq True submitAuthnResponse tid authnResp IdP -> SAML.SignPrivCreds -> SAML.UserRef -> TestSpar () +createViaSamlFails :: (HasCallStack) => IdP -> SAML.SignPrivCreds -> SAML.UserRef -> TestSpar () createViaSamlFails idp privCreds uref = do resp <- createViaSamlResp idp privCreds uref liftIO $ do maybe (error "no body") cs (responseBody resp) `shouldNotContain` "wire:sso:error:success" -createViaSaml :: HasCallStack => IdP -> SAML.SignPrivCreds -> SAML.UserRef -> TestSpar (Maybe UserId) +createViaSaml :: (HasCallStack) => IdP -> SAML.SignPrivCreds -> SAML.UserRef -> TestSpar (Maybe UserId) createViaSaml idp privCreds uref = do resp <- createViaSamlResp idp privCreds uref liftIO $ do @@ -1127,7 +1127,7 @@ testCreateUserTimeout = do Just inviteeCode <- call $ getInvitationCode brig tid (inInvitation inv) pure (scimStoredUser, inv, inviteeCode) - searchUser :: HasCallStack => Spar.Types.ScimToken -> Scim.User.User tag -> Email -> Bool -> TestSpar () + searchUser :: (HasCallStack) => Spar.Types.ScimToken -> Scim.User.User tag -> Email -> Bool -> TestSpar () searchUser tok scimUser email shouldSucceed = do let handle = fromJust . parseHandle . Scim.User.userName $ scimUser tryquery qry = @@ -1214,7 +1214,7 @@ testFindSamlAutoProvisionedUserMigratedWithEmailInTeamWithSSO = do Just brigUser' <- runSpar $ Intra.getBrigUser Intra.NoPendingInvitations memberIdWithSSO liftIO $ userManagedBy brigUser' `shouldBe` ManagedByScim where - veidToText :: MonadError String m => ValidExternalId -> m Text + veidToText :: (MonadError String m) => ValidExternalId -> m Text veidToText veid = runValidExternalIdEither (\(SAML.UserRef _ subj) -> maybe (throwError "bad uref from brig") (pure . CI.original) $ SAML.shortShowNameID subj) @@ -1318,7 +1318,7 @@ testFindNoDeletedUsers = do liftIO $ users'' `shouldSatisfy` all ((/= userid) . scimUserId) -- | Test that users are not listed if not in the team associated with the token. -testUserListFailsWithNotFoundIfOutsideTeam :: HasCallStack => TestSpar () +testUserListFailsWithNotFoundIfOutsideTeam :: (HasCallStack) => TestSpar () testUserListFailsWithNotFoundIfOutsideTeam = do user <- randomScimUser (tokTeamA, _) <- registerIdPAndScimToken @@ -1366,7 +1366,7 @@ testGetUser = do storedUser' <- getUser tok (scimUserId storedUser) liftIO $ storedUser' `shouldBe` storedUser -shouldBeManagedBy :: HasCallStack => UserId -> ManagedBy -> TestSpar () +shouldBeManagedBy :: (HasCallStack) => UserId -> ManagedBy -> TestSpar () shouldBeManagedBy uid flag = do managedBy <- maybe (error "user not found") userManagedBy <$> runSpar (Intra.getBrigUser Intra.WithPendingInvitations uid) liftIO $ managedBy `shouldBe` flag @@ -1678,7 +1678,7 @@ testUpdateExternalId withidp = do (_owner, tid) <- call $ createUserWithTeam (env ^. teBrig) (env ^. teGalley) (,Nothing,tid) <$> registerScimToken tid Nothing - let checkUpdate :: HasCallStack => Bool -> TestSpar () + let checkUpdate :: (HasCallStack) => Bool -> TestSpar () checkUpdate hasChanged {- is externalId updated with a different value, or with itself? -} = do -- Create a user via SCIM email <- randomEmail @@ -2243,7 +2243,7 @@ specAzureQuirks = do specEmailValidation :: SpecWith TestEnv specEmailValidation = do describe "email validation" $ do - let setup :: HasCallStack => Bool -> TestSpar (UserId, Email) + let setup :: (HasCallStack) => Bool -> TestSpar (UserId, Email) setup enabled = do (tok, (_ownerid, teamid, idp)) <- registerIdPAndScimToken if enabled @@ -2321,7 +2321,7 @@ specSCIMManaged = do let Right nameid = SAML.emailNameID $ fromEmail oldEmail (_, cky) <- loginCreatedSsoUser nameid idp privCreds sessiontok <- do - let decodeToken :: HasCallStack => ResponseLBS -> ZAuth.Token ZAuth.Access + let decodeToken :: (HasCallStack) => ResponseLBS -> ZAuth.Token ZAuth.Access decodeToken r = fromMaybe (error "invalid access_token") $ do x <- responseBody r t <- x ^? key "access_token" . _String @@ -2372,7 +2372,7 @@ specSCIMManaged = do CsvExport.tExportManagedBy member @?= ManagedByScim CsvExport.tExportCreatedOn member `shouldSatisfy` isJust where - randomAlphaNum :: MonadIO m => m Text + randomAlphaNum :: (MonadIO m) => m Text randomAlphaNum = liftIO $ do nrs <- replicateM 21 (randomRIO (97, 122)) -- a-z pure (cs (map chr nrs)) diff --git a/services/spar/test-integration/Util/Core.hs b/services/spar/test-integration/Util/Core.hs index 003035dd373..1614167e961 100644 --- a/services/spar/test-integration/Util/Core.hs +++ b/services/spar/test-integration/Util/Core.hs @@ -262,7 +262,7 @@ cliOptsParser = -- removed the mock idp functionality. if you want to re-introduce it, -- -- would be a good place to look for code to steal. -mkEnv :: HasCallStack => IntegrationConfig -> Opts -> IO TestEnv +mkEnv :: (HasCallStack) => IntegrationConfig -> Opts -> IO TestEnv mkEnv tstOpts opts = do mgr :: Manager <- newManager defaultManagerSettings sparCtxLogger <- Log.mkLogger (samlToLevel $ saml opts ^. SAML.cfgLogLevel) (logNetStrings opts) (logFormat opts) @@ -290,11 +290,11 @@ mkEnv tstOpts opts = do tstOpts wireIdPAPIVersion -destroyEnv :: HasCallStack => TestEnv -> IO () +destroyEnv :: (HasCallStack) => TestEnv -> IO () destroyEnv _ = pure () it :: - HasCallStack => + (HasCallStack) => -- or, more generally: -- MonadIO m, Example (TestEnv -> m ()), Arg (TestEnv -> m ()) ~ TestEnv String -> @@ -303,7 +303,7 @@ it :: it msg bdy = Test.Hspec.it msg $ runReaderT bdy xit :: - HasCallStack => + (HasCallStack) => -- or, more generally: -- MonadIO m, Example (TestEnv -> m ()), Arg (TestEnv -> m ()) ~ TestEnv String -> @@ -337,7 +337,7 @@ retryNUntil n good m = (const (pure . not . good)) (const m) -aFewTimesAssert :: HasCallStack => TestSpar a -> (a -> Bool) -> TestSpar () +aFewTimesAssert :: (HasCallStack) => TestSpar a -> (a -> Bool) -> TestSpar () aFewTimesAssert action good = do result <- aFewTimes action good good result `assert` pure () @@ -351,7 +351,7 @@ aFewTimesRecover action = do (\_ -> action `runReaderT` env) -- | Duplicate of 'Spar.Intra.getBrigUser'. -getUserBrig :: HasCallStack => UserId -> TestSpar (Maybe User) +getUserBrig :: (HasCallStack) => UserId -> TestSpar (Maybe User) getUserBrig uid = do env <- ask let req = @@ -556,19 +556,19 @@ deleteUserNoWait brigreq uid = -- | See also: 'nextSAMLID', 'nextUserRef'. The names are chosed to be consistent with -- 'UUID.nextRandom'. -nextWireId :: MonadIO m => m (Id a) +nextWireId :: (MonadIO m) => m (Id a) nextWireId = Id <$> liftIO UUID.nextRandom -nextWireIdP :: MonadIO m => WireIdPAPIVersion -> m WireIdP +nextWireIdP :: (MonadIO m) => WireIdPAPIVersion -> m WireIdP nextWireIdP version = WireIdP <$> iid <*> pure (Just version) <*> pure [] <*> pure Nothing <*> idpHandle where iid = Id <$> liftIO UUID.nextRandom idpHandle = iid <&> IdPHandle . pack . show -nextSAMLID :: MonadIO m => m (ID a) +nextSAMLID :: (MonadIO m) => m (ID a) nextSAMLID = mkID . UUID.toText <$> liftIO UUID.nextRandom -nextHandle :: MonadIO m => m Handle +nextHandle :: (MonadIO m) => m Handle nextHandle = liftIO $ fromJust . parseHandle . cs . show <$> randomRIO (0 :: Int, 13371137) -- | Generate a 'SAML.UserRef' subject. @@ -581,7 +581,7 @@ nextSubject = liftIO $ do _ -> error "nextSubject: impossible" either (error . show) pure $ SAML.mkNameID unameId Nothing Nothing Nothing -nextUserRef :: MonadIO m => m SAML.UserRef +nextUserRef :: (MonadIO m) => m SAML.UserRef nextUserRef = liftIO $ do tenant <- UUID.toText <$> UUID.nextRandom SAML.UserRef @@ -619,10 +619,10 @@ getTeams u gly = do ) pure $ responseJsonUnsafe r -getTeamMemberIds :: HasCallStack => UserId -> TeamId -> TestSpar [UserId] +getTeamMemberIds :: (HasCallStack) => UserId -> TeamId -> TestSpar [UserId] getTeamMemberIds usr tid = (^. Team.userId) <$$> getTeamMembers usr tid -getTeamMembers :: HasCallStack => UserId -> TeamId -> TestSpar [Member.TeamMember] +getTeamMembers :: (HasCallStack) => UserId -> TeamId -> TestSpar [Member.TeamMember] getTeamMembers usr tid = do gly <- view teGalley resp <- @@ -633,7 +633,7 @@ getTeamMembers usr tid = do Right mems = responseJsonEither resp pure $ mems ^. Team.teamMembers -promoteTeamMember :: HasCallStack => UserId -> TeamId -> UserId -> TestSpar () +promoteTeamMember :: (HasCallStack) => UserId -> TeamId -> UserId -> TestSpar () promoteTeamMember usr tid memid = do gly <- view teGalley let bdy :: NewTeamMember @@ -653,12 +653,12 @@ zAuthAccess u c = header "Z-Type" "access" . zUser u . zConn c newTeam :: Galley.BindingNewTeam newTeam = Galley.BindingNewTeam $ Galley.newNewTeam (unsafeRange "teamName") DefaultIcon -randomEmail :: MonadIO m => m Email +randomEmail :: (MonadIO m) => m Email randomEmail = do uid <- liftIO nextRandom pure $ Email ("success+" <> UUID.toText uid) "simulator.amazonses.com" -randomPhone :: MonadIO m => m Phone +randomPhone :: (MonadIO m) => m Phone randomPhone = liftIO $ do nrs <- map show <$> replicateM 14 (randomRIO (0, 9) :: IO Int) let phone = parsePhone . cs $ "+0" ++ concat nrs @@ -749,7 +749,7 @@ endpointToSettings ep = Warp.settingsPort = fromIntegral $ ep ^. port } -endpointToURL :: MonadIO m => Endpoint -> Text -> m URI +endpointToURL :: (MonadIO m) => Endpoint -> Text -> m URI endpointToURL ep urlpath = either err pure url where url = parseURI' ("http://" <> urlhost <> ":" <> urlport) <&> (=/ urlpath) @@ -835,7 +835,7 @@ registerTestIdPFrom metadata mgr owner spar = do liftIO . runHttpT mgr $ do callIdpCreate apiVer spar (Just owner) metadata -getCookie :: KnownSymbol name => proxy name -> ResponseLBS -> Either String (SAML.SimpleSetCookie name) +getCookie :: (KnownSymbol name) => proxy name -> ResponseLBS -> Either String (SAML.SimpleSetCookie name) getCookie proxy rsp = do web :: Web.SetCookie <- Web.parseSetCookie @@ -856,7 +856,7 @@ hasPersistentCookieHeader rsp = do Left $ "expiration date should NOT empty: " <> show cky -tryLogin :: HasCallStack => SignPrivCreds -> IdP -> NameID -> TestSpar SAML.UserRef +tryLogin :: (HasCallStack) => SignPrivCreds -> IdP -> NameID -> TestSpar SAML.UserRef tryLogin privkey idp userSubject = do env <- ask let tid = idp ^. idpExtraInfo . team @@ -871,7 +871,7 @@ tryLogin privkey idp userSubject = do either (error . show) (pure . view userRefL) $ SAML.parseFromDocument (fromSignedAuthnResponse idpresp) -tryLoginFail :: HasCallStack => SignPrivCreds -> IdP -> NameID -> String -> TestSpar () +tryLoginFail :: (HasCallStack) => SignPrivCreds -> IdP -> NameID -> String -> TestSpar () tryLoginFail privkey idp userSubject bodyShouldContain = do env <- ask let tid = idp ^. idpExtraInfo . team @@ -969,10 +969,10 @@ loginCreatedSsoUser nameid idp privCreds = do let uid :: UserId uid = Id . fromMaybe (error "bad user field in /access response body") . UUID.fromText $ uidRaw - uidRaw :: HasCallStack => Text + uidRaw :: (HasCallStack) => Text uidRaw = accessToken ^?! Aeson.key "user" . _String - accessToken :: HasCallStack => Aeson.Value + accessToken :: (HasCallStack) => Aeson.Value accessToken = tok where tok = @@ -997,7 +997,7 @@ callAuthnReq sparreq_ idpid = assert test_parseAuthnReqResp $ do resp <- callAuthnReq' (sparreq_ . expect2xx) idpid either (err resp) pure $ parseAuthnReqResp (cs <$> responseBody resp) where - err :: forall n a. MonadIO n => ResponseLBS -> String -> n a + err :: forall n a. (MonadIO n) => ResponseLBS -> String -> n a err resp = liftIO . throwIO . ErrorCall . (<> ("; " <> show (responseBody resp))) test_parseAuthnReqResp :: Bool @@ -1009,7 +1009,7 @@ test_parseAuthnReqResp = isRight tst1 parseAuthnReqResp :: forall n. - MonadError String n => + (MonadError String n) => Maybe LText -> n (URI, SAML.AuthnRequest) parseAuthnReqResp Nothing = throwError "no response body" @@ -1032,11 +1032,11 @@ safeHead :: forall n a. (MonadError String n) => String -> [a] -> n a safeHead _ (a : _) = pure a safeHead msg [] = throwError $ msg <> ": []" -callAuthnReq' :: MonadHttp m => SparReq -> SAML.IdPId -> m ResponseLBS +callAuthnReq' :: (MonadHttp m) => SparReq -> SAML.IdPId -> m ResponseLBS callAuthnReq' sparreq_ idpid = do get $ sparreq_ . path (cs $ "/sso/initiate-login/" -/ SAML.idPIdToST idpid) -callAuthnReqPrecheck' :: MonadHttp m => SparReq -> SAML.IdPId -> m ResponseLBS +callAuthnReqPrecheck' :: (MonadHttp m) => SparReq -> SAML.IdPId -> m ResponseLBS callAuthnReqPrecheck' sparreq_ idpid = do head $ sparreq_ . path (cs $ "/sso/initiate-login/" -/ SAML.idPIdToST idpid) @@ -1046,7 +1046,7 @@ callIdpGet sparreq_ muid idpid = do either (liftIO . throwIO . ErrorCall . show) pure $ responseJsonEither @IdP resp -callIdpGet' :: MonadHttp m => SparReq -> Maybe UserId -> SAML.IdPId -> m ResponseLBS +callIdpGet' :: (MonadHttp m) => SparReq -> Maybe UserId -> SAML.IdPId -> m ResponseLBS callIdpGet' sparreq_ muid idpid = do get $ sparreq_ . maybe id zUser muid . path (cs $ "/identity-providers/" -/ SAML.idPIdToST idpid) @@ -1055,7 +1055,7 @@ callIdpGetRaw sparreq_ muid idpid = do resp <- callIdpGetRaw' (sparreq_ . expect2xx) muid idpid maybe (liftIO . throwIO $ ErrorCall "Nothing") (pure . cs) (responseBody resp) -callIdpGetRaw' :: MonadHttp m => SparReq -> Maybe UserId -> SAML.IdPId -> m ResponseLBS +callIdpGetRaw' :: (MonadHttp m) => SparReq -> Maybe UserId -> SAML.IdPId -> m ResponseLBS callIdpGetRaw' sparreq_ muid idpid = do get $ sparreq_ . maybe id zUser muid . path (cs $ "/identity-providers/" -/ SAML.idPIdToST idpid -/ "raw") @@ -1065,7 +1065,7 @@ callIdpGetAll sparreq_ muid = do either (liftIO . throwIO . ErrorCall . show) pure $ responseJsonEither resp -callIdpGetAll' :: MonadHttp m => SparReq -> Maybe UserId -> m ResponseLBS +callIdpGetAll' :: (MonadHttp m) => SparReq -> Maybe UserId -> m ResponseLBS callIdpGetAll' sparreq_ muid = do get $ sparreq_ . maybe id zUser muid . path "/identity-providers" @@ -1098,7 +1098,7 @@ callIdpCreateRaw sparreq_ muid ctyp metadata = do either (liftIO . throwIO . ErrorCall . show) pure $ responseJsonEither @IdP resp -callIdpCreateRaw' :: MonadHttp m => SparReq -> Maybe UserId -> ByteString -> LByteString -> m ResponseLBS +callIdpCreateRaw' :: (MonadHttp m) => SparReq -> Maybe UserId -> ByteString -> LByteString -> m ResponseLBS callIdpCreateRaw' sparreq_ muid ctyp metadata = do post $ sparreq_ @@ -1169,7 +1169,7 @@ callIdpUpdate' sparreq_ muid idpid metainfo = do either (liftIO . throwIO . ErrorCall . show) pure $ responseJsonEither @IdP resp -callIdpUpdate :: MonadHttp m => SparReq -> Maybe UserId -> IdPId -> IdPMetadataInfo -> m ResponseLBS +callIdpUpdate :: (MonadHttp m) => SparReq -> Maybe UserId -> IdPId -> IdPMetadataInfo -> m ResponseLBS callIdpUpdate sparreq_ muid idpid (IdPMetadataValue metadata _) = do put $ sparreq_ @@ -1178,7 +1178,7 @@ callIdpUpdate sparreq_ muid idpid (IdPMetadataValue metadata _) = do . body (RequestBodyLBS $ cs metadata) . header "Content-Type" "application/xml" -callIdpUpdateWithHandle :: MonadHttp m => SparReq -> Maybe UserId -> IdPId -> IdPMetadataInfo -> IdPHandle -> m ResponseLBS +callIdpUpdateWithHandle :: (MonadHttp m) => SparReq -> Maybe UserId -> IdPId -> IdPMetadataInfo -> IdPHandle -> m ResponseLBS callIdpUpdateWithHandle sparreq_ muid idpid (IdPMetadataValue metadata _) idpHandle = do put $ sparreq_ @@ -1191,14 +1191,14 @@ callIdpUpdateWithHandle sparreq_ muid idpid (IdPMetadataValue metadata _) idpHan callIdpDelete :: (Functor m, MonadHttp m) => SparReq -> Maybe UserId -> SAML.IdPId -> m () callIdpDelete sparreq_ muid idpid = void $ callIdpDelete' (sparreq_ . expect2xx) muid idpid -callIdpDelete' :: MonadHttp m => SparReq -> Maybe UserId -> SAML.IdPId -> m ResponseLBS +callIdpDelete' :: (MonadHttp m) => SparReq -> Maybe UserId -> SAML.IdPId -> m ResponseLBS callIdpDelete' sparreq_ muid idpid = do delete $ sparreq_ . maybe id zUser muid . path (cs $ "/identity-providers/" -/ SAML.idPIdToST idpid) -callIdpDeletePurge' :: MonadHttp m => SparReq -> Maybe UserId -> SAML.IdPId -> m ResponseLBS +callIdpDeletePurge' :: (MonadHttp m) => SparReq -> Maybe UserId -> SAML.IdPId -> m ResponseLBS callIdpDeletePurge' sparreq_ muid idpid = do delete $ sparreq_ @@ -1206,13 +1206,13 @@ callIdpDeletePurge' sparreq_ muid idpid = do . path (cs $ "/identity-providers/" -/ SAML.idPIdToST idpid) . queryItem "purge" "true" -callGetDefaultSsoCode :: MonadHttp m => SparReq -> m ResponseLBS +callGetDefaultSsoCode :: (MonadHttp m) => SparReq -> m ResponseLBS callGetDefaultSsoCode sparreq_ = do get $ sparreq_ . path "/sso/settings/" -callSetDefaultSsoCode :: MonadHttp m => SparReq -> SAML.IdPId -> m ResponseLBS +callSetDefaultSsoCode :: (MonadHttp m) => SparReq -> SAML.IdPId -> m ResponseLBS callSetDefaultSsoCode sparreq_ ssoCode = do let settings = RequestBodyLBS . Aeson.encode $ @@ -1225,7 +1225,7 @@ callSetDefaultSsoCode sparreq_ ssoCode = do . body settings . header "Content-Type" "application/json" -callDeleteDefaultSsoCode :: MonadHttp m => SparReq -> m ResponseLBS +callDeleteDefaultSsoCode :: (MonadHttp m) => SparReq -> m ResponseLBS callDeleteDefaultSsoCode sparreq_ = do let settings = RequestBodyLBS . Aeson.encode $ @@ -1274,10 +1274,10 @@ runSparE action = do ctx <- (^. teSparEnv) <$> ask liftIO $ runSparToIO ctx action -getSsoidViaSelf :: HasCallStack => UserId -> TestSpar UserSSOId +getSsoidViaSelf :: (HasCallStack) => UserId -> TestSpar UserSSOId getSsoidViaSelf uid = maybe (error "not found") pure =<< getSsoidViaSelf' uid -getSsoidViaSelf' :: HasCallStack => UserId -> TestSpar (Maybe UserSSOId) +getSsoidViaSelf' :: (HasCallStack) => UserId -> TestSpar (Maybe UserSSOId) getSsoidViaSelf' uid = do musr <- aFewTimes (runSpar $ Intra.getBrigUser Intra.NoPendingInvitations uid) isJust pure $ case userIdentity =<< musr of @@ -1287,21 +1287,21 @@ getSsoidViaSelf' uid = do Just (PhoneIdentity _) -> Nothing Nothing -> Nothing -getUserIdViaRef :: HasCallStack => UserRef -> TestSpar UserId +getUserIdViaRef :: (HasCallStack) => UserRef -> TestSpar UserId getUserIdViaRef uref = maybe (error "not found") pure =<< getUserIdViaRef' uref -getUserIdViaRef' :: HasCallStack => UserRef -> TestSpar (Maybe UserId) +getUserIdViaRef' :: (HasCallStack) => UserRef -> TestSpar (Maybe UserId) getUserIdViaRef' uref = do aFewTimes (runSpar $ SAMLUserStore.get uref) isJust -checkErr :: HasCallStack => Int -> Maybe TestErrorLabel -> Assertions () +checkErr :: (HasCallStack) => Int -> Maybe TestErrorLabel -> Assertions () checkErr status mlabel = do const status === statusCode case mlabel of Nothing -> pure () Just label -> const (Right label) === responseJsonEither -checkErrHspec :: HasCallStack => Int -> TestErrorLabel -> ResponseLBS -> Bool +checkErrHspec :: (HasCallStack) => Int -> TestErrorLabel -> ResponseLBS -> Bool checkErrHspec status label resp = status == statusCode resp && responseJsonEither resp == Right label -- | copied from brig integration tests @@ -1313,7 +1313,7 @@ stdInvitationRequest' :: Maybe User.Locale -> Maybe Role -> User.Email -> TeamIn stdInvitationRequest' loc role email = TeamInvitation.InvitationRequest loc role Nothing email Nothing -setRandomHandleBrig :: HasCallStack => UserId -> TestSpar () +setRandomHandleBrig :: (HasCallStack) => UserId -> TestSpar () setRandomHandleBrig uid = do env <- ask call (changeHandleBrig (env ^. teBrig) uid =<< liftIO randomHandle) @@ -1373,10 +1373,10 @@ checkChangeRoleOfTeamMember tid adminId targetId = forM_ [minBound ..] $ \role - [member'] <- filter ((== targetId) . (^. Member.userId)) <$> getTeamMembers adminId tid liftIO $ (member' ^. Member.permissions . to Member.permissionsRole) `shouldBe` Just role -eventually :: HasCallStack => TestSpar a -> TestSpar a +eventually :: (HasCallStack) => TestSpar a -> TestSpar a eventually = recoverAll (limitRetries 3 <> exponentialBackoff 100000) . const -getIdPByIssuer :: HasCallStack => Issuer -> TeamId -> TestSpar (Maybe IdP) +getIdPByIssuer :: (HasCallStack) => Issuer -> TeamId -> TestSpar (Maybe IdP) getIdPByIssuer issuer tid = do idpApiVersion <- view teWireIdPAPIVersion runSpar $ case idpApiVersion of diff --git a/services/spar/test-integration/Util/Email.hs b/services/spar/test-integration/Util/Email.hs index 13c8089284a..babae51a36e 100644 --- a/services/spar/test-integration/Util/Email.hs +++ b/services/spar/test-integration/Util/Email.hs @@ -63,7 +63,7 @@ changeEmailBrig brig usr newEmail = do Auth.PasswordLogin $ Auth.PasswordLoginData (Auth.LoginByEmail e) pw cl Nothing - login :: Auth.Login -> Auth.CookieType -> MonadHttp m => m ResponseLBS + login :: Auth.Login -> Auth.CookieType -> (MonadHttp m) => m ResponseLBS login l t = post $ brig @@ -71,10 +71,10 @@ changeEmailBrig brig usr newEmail = do . (if t == Auth.PersistentCookie then queryItem "persist" "true" else id) . json l - decodeCookie :: HasCallStack => Response a -> Bilge.Cookie + decodeCookie :: (HasCallStack) => Response a -> Bilge.Cookie decodeCookie = fromMaybe (error "missing zuid cookie") . Bilge.getCookie "zuid" - decodeToken :: HasCallStack => Response (Maybe LByteString) -> ZAuth.Token ZAuth.Access + decodeToken :: (HasCallStack) => Response (Maybe LByteString) -> ZAuth.Token ZAuth.Access decodeToken r = fromMaybe (error "invalid access_token") $ do x <- responseBody r t <- x ^? key "access_token" . _String @@ -106,7 +106,7 @@ activateEmail :: (MonadCatch m, MonadIO m, HasCallStack) => BrigReq -> Email -> - MonadHttp m => m () + (MonadHttp m) => m () activateEmail brig email = do act <- getActivationCode brig (Left email) case act of @@ -120,13 +120,13 @@ failActivatingEmail :: (MonadCatch m, MonadIO m, HasCallStack) => BrigReq -> Email -> - MonadHttp m => m () + (MonadHttp m) => m () failActivatingEmail brig email = do act <- getActivationCode brig (Left email) liftIO $ assertEqual "there should be no pending activation" act Nothing checkEmail :: - HasCallStack => + (HasCallStack) => UserId -> Maybe Email -> TestSpar () @@ -162,7 +162,7 @@ getActivationCode brig ep = do let acode = ActivationCode . Ascii.unsafeFromText <$> (lbs ^? key "code" . _String) pure $ (,) <$> akey <*> acode -setSamlEmailValidation :: HasCallStack => TeamId -> Feature.FeatureStatus -> TestSpar () +setSamlEmailValidation :: (HasCallStack) => TeamId -> Feature.FeatureStatus -> TestSpar () setSamlEmailValidation tid status = do galley <- view teGalley let req = put $ galley . paths p . json (Feature.WithStatusNoLock @Feature.ValidateSAMLEmailsConfig status Feature.trivialConfig Feature.FeatureTTLUnlimited) diff --git a/services/spar/test-integration/Util/Invitation.hs b/services/spar/test-integration/Util/Invitation.hs index 7bf394177f2..8a9d0fe6490 100644 --- a/services/spar/test-integration/Util/Invitation.hs +++ b/services/spar/test-integration/Util/Invitation.hs @@ -37,12 +37,12 @@ import Util import Wire.API.Team.Invitation (Invitation (..)) import Wire.API.User -headInvitation404 :: HasCallStack => BrigReq -> Email -> Http () +headInvitation404 :: (HasCallStack) => BrigReq -> Email -> Http () headInvitation404 brig email = do Bilge.head (brig . path "/teams/invitations/by-email" . contentJson . queryItem "email" (toByteString' email)) !!! const 404 === statusCode -getInvitation :: HasCallStack => BrigReq -> Email -> Http Invitation +getInvitation :: (HasCallStack) => BrigReq -> Email -> Http Invitation getInvitation brig email = responseJsonUnsafe <$> Bilge.get @@ -70,7 +70,7 @@ getInvitationCode brig t ref = do let lbs = fromMaybe "" $ responseBody r pure $ fromByteString (maybe (error "No code?") encodeUtf8 (lbs ^? key "code" . _String)) -registerInvitation :: HasCallStack => Email -> Name -> InvitationCode -> Bool -> TestSpar () +registerInvitation :: (HasCallStack) => Email -> Name -> InvitationCode -> Bool -> TestSpar () registerInvitation email name inviteeCode shouldSucceed = do env <- ask let brig = env ^. teBrig diff --git a/services/spar/test-integration/Util/Scim.hs b/services/spar/test-integration/Util/Scim.hs index 48a6407b8fa..fbba2a371ed 100644 --- a/services/spar/test-integration/Util/Scim.hs +++ b/services/spar/test-integration/Util/Scim.hs @@ -70,7 +70,7 @@ import Wire.API.User.Scim -- | Call 'registerTestIdP', then 'registerScimToken'. The user returned is the owner of the team; -- the IdP is registered with the team; the SCIM token can be used to manipulate the team. -registerIdPAndScimToken :: HasCallStack => TestSpar (ScimToken, (UserId, TeamId, IdP)) +registerIdPAndScimToken :: (HasCallStack) => TestSpar (ScimToken, (UserId, TeamId, IdP)) registerIdPAndScimToken = do env <- ask (owner, teamid) <- call $ createUserWithTeam (env ^. teBrig) (env ^. teGalley) @@ -81,7 +81,7 @@ registerIdPAndScimToken = do -- | Call 'registerTestIdPWithMeta', then 'registerScimToken'. The user returned is the owner of the team; -- the IdP is registered with the team; the SCIM token can be used to manipulate the team. -registerIdPAndScimTokenWithMeta :: HasCallStack => TestSpar (ScimToken, (UserId, TeamId, IdP, (IdPMetadataInfo, SAML.SignPrivCreds))) +registerIdPAndScimTokenWithMeta :: (HasCallStack) => TestSpar (ScimToken, (UserId, TeamId, IdP, (IdPMetadataInfo, SAML.SignPrivCreds))) registerIdPAndScimTokenWithMeta = do env <- ask (owner, teamid) <- call $ createUserWithTeam (env ^. teBrig) (env ^. teGalley) @@ -93,7 +93,7 @@ registerIdPAndScimTokenWithMeta = do -- -- FUTUREWORK(mangoiv): this is an integration test, it should use the -- API, and not directly manipulate the database -registerScimToken :: HasCallStack => TeamId -> Maybe IdPId -> TestSpar ScimToken +registerScimToken :: (HasCallStack) => TeamId -> Maybe IdPId -> TestSpar ScimToken registerScimToken teamid midpid = do tok <- ScimToken <$> do @@ -152,7 +152,7 @@ randomScimUserWithSubjectAndRichInfo richInfo = do ) _ -> error "randomScimUserWithSubject: impossible" pure - ( (Scim.User.empty userSchemas ("scimuser_" <> suffix) (ScimUserExtra richInfo)) + ( (Scim.User.empty @SparTag userSchemas ("scimuser_" <> suffix) (ScimUserExtra richInfo)) { Scim.User.displayName = Just ("ScimUser" <> suffix), Scim.User.externalId = Just externalId, Scim.User.emails = emails, @@ -171,33 +171,33 @@ randomScimUserWithSubjectAndRichInfo richInfo = do -- support externalIds that are not emails, and storing email addresses in `emails` in the -- scim schema. `randomScimUserWithEmail` is from a time where non-idp-authenticated users -- could only be provisioned with email as externalId. we should probably rework all that. -randomScimUserWithEmail :: MonadRandom m => m (Scim.User.User SparTag, Email) +randomScimUserWithEmail :: (MonadRandom m) => m (Scim.User.User SparTag, Email) randomScimUserWithEmail = do suffix <- cs <$> replicateM 7 (getRandomR ('0', '9')) let email = Email ("email" <> suffix) "example.com" externalId = fromEmail email pure - ( (Scim.User.empty userSchemas ("scimuser_" <> suffix) (ScimUserExtra mempty)) + ( (Scim.User.empty @SparTag userSchemas ("scimuser_" <> suffix) (ScimUserExtra mempty)) { Scim.User.displayName = Just ("ScimUser" <> suffix), Scim.User.externalId = Just externalId }, email ) -randomScimUserWithNick :: MonadRandom m => m (Scim.User.User SparTag, Text) +randomScimUserWithNick :: (MonadRandom m) => m (Scim.User.User SparTag, Text) randomScimUserWithNick = do suffix <- cs <$> replicateM 7 (getRandomR ('0', '9')) let nick = "nick" <> suffix externalId = nick pure - ( (Scim.User.empty userSchemas ("scimuser_" <> suffix) (ScimUserExtra mempty)) + ( (Scim.User.empty @SparTag userSchemas ("scimuser_" <> suffix) (ScimUserExtra mempty)) { Scim.User.displayName = Just ("ScimUser" <> suffix), Scim.User.externalId = Just externalId }, nick ) -randomScimEmail :: MonadRandom m => m Email.Email +randomScimEmail :: (MonadRandom m) => m Email.Email randomScimEmail = do let typ :: Maybe Text = Nothing primary :: Maybe Scim.ScimBool = Nothing -- TODO: where should we catch users with more than one @@ -208,7 +208,7 @@ randomScimEmail = do pure . Email.EmailAddress2 $ Email.unsafeEmailAddress localpart domainpart pure Email.Email {..} -randomScimPhone :: MonadRandom m => m Phone.Phone +randomScimPhone :: (MonadRandom m) => m Phone.Phone randomScimPhone = do let typ :: Maybe Text = Nothing value :: Maybe Text <- do @@ -222,7 +222,7 @@ randomScimPhone = do -- API wrappers createUser' :: - HasCallStack => + (HasCallStack) => ScimToken -> Scim.User.User SparTag -> TestSpar ResponseLBS @@ -235,7 +235,7 @@ createUser' tok user = do -- | Create a user. createUser :: - HasCallStack => + (HasCallStack) => ScimToken -> Scim.User.User SparTag -> TestSpar (Scim.StoredUser SparTag) @@ -244,7 +244,7 @@ createUser tok user = do pure (responseJsonUnsafe r) updateUser' :: - HasCallStack => + (HasCallStack) => ScimToken -> UserId -> Scim.User.User SparTag -> @@ -255,7 +255,7 @@ updateUser' tok userid user = do -- | Update a user. updateUser :: - HasCallStack => + (HasCallStack) => ScimToken -> UserId -> Scim.User.User SparTag -> @@ -266,7 +266,7 @@ updateUser tok userid user = do -- | Patch a user patchUser :: - HasCallStack => + (HasCallStack) => ScimToken -> UserId -> Scim.PatchOp.PatchOp SparTag -> @@ -277,7 +277,7 @@ patchUser tok uid patchOp = do -- | Patch a user patchUser' :: - HasCallStack => + (HasCallStack) => ScimToken -> UserId -> Scim.PatchOp.PatchOp SparTag -> @@ -288,7 +288,7 @@ patchUser' tok uid patchOp = do -- | Delete a user. deleteUser :: - HasCallStack => + (HasCallStack) => ScimToken -> UserId -> TestSpar (Scim.StoredUser SparTag) @@ -304,7 +304,7 @@ deleteUser tok userid = do -- | List all users. listUsers :: - HasCallStack => + (HasCallStack) => ScimToken -> Maybe Scim.Filter -> TestSpar [Scim.StoredUser SparTag] @@ -325,7 +325,7 @@ listUsers tok mbFilter = do -- | Get a user. getUser :: - HasCallStack => + (HasCallStack) => ScimToken -> UserId -> TestSpar (Scim.StoredUser SparTag) @@ -341,7 +341,7 @@ getUser tok userid = do -- | Create a SCIM token. createToken :: - HasCallStack => + (HasCallStack) => UserId -> CreateScimToken -> TestSpar CreateScimTokenResponse @@ -356,7 +356,7 @@ createToken zusr payload = do pure (responseJsonUnsafe r) createTokenFailsWith :: - HasCallStack => + (HasCallStack) => UserId -> CreateScimToken -> Int -> @@ -365,9 +365,10 @@ createTokenFailsWith :: createTokenFailsWith zusr payload expectedStatus expectedLabel = do env <- ask void $ - createToken_ zusr payload (env ^. teSpar) Maybe Lazy.Text @@ -375,7 +376,7 @@ errorLabel = fmap Error.label . responseJsonMaybe -- | Delete a SCIM token. deleteToken :: - HasCallStack => + (HasCallStack) => UserId -> -- | Token to delete ScimTokenId -> @@ -390,7 +391,7 @@ deleteToken zusr tokenid = do -- | List SCIM tokens. listTokens :: - HasCallStack => + (HasCallStack) => UserId -> TestSpar ScimTokenList listTokens zusr = do @@ -422,14 +423,15 @@ createUser_ auth user spar_ = do -- still some confusion here about the distinction between *validated* -- emails and *scim-provided* emails, which are two entirely -- different things. - call . post $ - ( spar_ - . paths ["scim", "v2", "Users"] - . scimAuth auth - . contentScim - . json user - . acceptScim - ) + call + . post + $ ( spar_ + . paths ["scim", "v2", "Users"] + . scimAuth auth + . contentScim + . json user + . acceptScim + ) -- | Update a user. updateUser_ :: @@ -444,26 +446,28 @@ updateUser_ :: SparReq -> TestSpar ResponseLBS updateUser_ auth muid user spar_ = do - call . put $ - ( spar_ - . paths (["scim", "v2", "Users"] <> maybeToList (toByteString' <$> muid)) - . scimAuth auth - . contentScim - . json user - . acceptScim - ) + call + . put + $ ( spar_ + . paths (["scim", "v2", "Users"] <> maybeToList (toByteString' <$> muid)) + . scimAuth auth + . contentScim + . json user + . acceptScim + ) -- | Patch a user patchUser_ :: Maybe ScimToken -> Maybe UserId -> Scim.PatchOp.PatchOp SparTag -> SparReq -> TestSpar ResponseLBS patchUser_ auth muid patchop spar_ = - call . patch $ - ( spar_ - . paths (["scim", "v2", "Users"] <> maybeToList (toByteString' <$> muid)) - . scimAuth auth - . contentScim - . json patchop - . acceptScim - ) + call + . patch + $ ( spar_ + . paths (["scim", "v2", "Users"] <> maybeToList (toByteString' <$> muid)) + . scimAuth auth + . contentScim + . json patchop + . acceptScim + ) -- | Delete a user. deleteUser_ :: @@ -475,13 +479,14 @@ deleteUser_ :: SparReq -> TestSpar ResponseLBS deleteUser_ auth uid spar_ = do - call . delete $ - ( spar_ - . paths (["scim", "v2", "Users"] <> (toByteString' <$> maybeToList uid)) - . scimAuth auth - . contentScim - . acceptScim - ) + call + . delete + $ ( spar_ + . paths (["scim", "v2", "Users"] <> (toByteString' <$> maybeToList uid)) + . scimAuth auth + . contentScim + . acceptScim + ) -- | List all users. listUsers_ :: @@ -493,18 +498,19 @@ listUsers_ :: SparReq -> TestSpar ResponseLBS listUsers_ auth mbFilter spar_ = do - call . get $ - ( spar_ - . paths ["scim", "v2", "Users"] - . queryItem' "filter" (toByteString' . Scim.renderFilter <$> mbFilter) - . scimAuth auth - . acceptScim - ) + call + . get + $ ( spar_ + . paths ["scim", "v2", "Users"] + . queryItem' "filter" (toByteString' . Scim.renderFilter <$> mbFilter) + . scimAuth auth + . acceptScim + ) filterBy :: Text -> Text -> Filter.Filter filterBy name value = Filter.FilterAttrCompare (Filter.topLevelAttrPath name) Filter.OpEq (Filter.ValString value) -filterForStoredUser :: HasCallStack => Scim.StoredUser SparTag -> Filter.Filter +filterForStoredUser :: (HasCallStack) => Scim.StoredUser SparTag -> Filter.Filter filterForStoredUser = filterBy "externalId" . fromJust . Scim.User.externalId . Scim.value . Scim.thing -- | Get one user. @@ -517,12 +523,13 @@ getUser_ :: SparReq -> TestSpar ResponseLBS getUser_ auth userid spar_ = do - call . get $ - ( spar_ - . paths ["scim", "v2", "Users", toByteString' userid] - . scimAuth auth - . acceptScim - ) + call + . get + $ ( spar_ + . paths ["scim", "v2", "Users", toByteString' userid] + . scimAuth auth + . acceptScim + ) -- | Create a SCIM token. createToken_ :: @@ -533,14 +540,15 @@ createToken_ :: SparReq -> TestSpar ResponseLBS createToken_ userid payload spar_ = do - call . post $ - ( spar_ - . paths ["scim", "auth-tokens"] - . zUser userid - . contentJson - . json payload - . acceptJson - ) + call + . post + $ ( spar_ + . paths ["scim", "auth-tokens"] + . zUser userid + . contentJson + . json payload + . acceptJson + ) -- | Delete a SCIM token. deleteToken_ :: @@ -552,12 +560,13 @@ deleteToken_ :: SparReq -> TestSpar ResponseLBS deleteToken_ userid tokenid spar_ = do - call . delete $ - ( spar_ - . paths ["scim", "auth-tokens"] - . queryItem "id" (toByteString' tokenid) - . zUser userid - ) + call + . delete + $ ( spar_ + . paths ["scim", "auth-tokens"] + . queryItem "id" (toByteString' tokenid) + . zUser userid + ) -- | List SCIM tokens. listTokens_ :: @@ -567,11 +576,12 @@ listTokens_ :: SparReq -> TestSpar ResponseLBS listTokens_ userid spar_ = do - call . get $ - ( spar_ - . paths ["scim", "auth-tokens"] - . zUser userid - ) + call + . get + $ ( spar_ + . paths ["scim", "auth-tokens"] + . zUser userid + ) ---------------------------------------------------------------------------- -- Utilities @@ -706,7 +716,7 @@ userShouldMatch u1 u2 = liftIO $ do check :: (Eq a, Show a) => Text -> -- field name - (forall u. IsUser u => Maybe (u -> a)) -> -- accessor (polymorphic) + (forall u. (IsUser u) => Maybe (u -> a)) -> -- accessor (polymorphic) IO () check field getField = case (getField <&> ($ u1), getField <&> ($ u2)) of (Just a1, Just a2) -> (field, a1) `shouldBe` (field, a2) @@ -716,7 +726,7 @@ userShouldMatch u1 u2 = liftIO $ do -- floor. This function calls the spar functions that do that. This allows us to express -- what we expect a user that comes back from spar to look like in terms of what it looked -- like when we sent it there. -whatSparReturnsFor :: HasCallStack => IdP -> Int -> Scim.User.User SparTag -> TestSpar (Either String (Scim.User.User SparTag)) +whatSparReturnsFor :: (HasCallStack) => IdP -> Int -> Scim.User.User SparTag -> TestSpar (Either String (Scim.User.User SparTag)) whatSparReturnsFor idp richInfoSizeLimit user = do eitherValidatedScimUser <- runSpar $ runError @Scim.ScimError $ validateScimUser' "whatSparReturnsFor" (Just idp) richInfoSizeLimit user pure $ case eitherValidatedScimUser of @@ -747,14 +757,16 @@ getDefaultUserLocale :: TestSpar Locale getDefaultUserLocale = do env <- ask LocaleUpdate defLocale <- - fmap responseJsonUnsafe . call . get $ - ( (env ^. teBrig) - . path "/i/users/locale" - . expect2xx - ) + fmap responseJsonUnsafe + . call + . get + $ ( (env ^. teBrig) + . path "/i/users/locale" + . expect2xx + ) pure defLocale -checkTeamMembersRole :: HasCallStack => TeamId -> UserId -> UserId -> Role -> TestSpar () +checkTeamMembersRole :: (HasCallStack) => TeamId -> UserId -> UserId -> Role -> TestSpar () checkTeamMembersRole tid owner uid role = do [member] <- filter ((== uid) . (^. Member.userId)) <$> getTeamMembers owner tid liftIO $ (member ^. Member.permissions . to Member.permissionsRole) `shouldBe` Just role diff --git a/services/spar/test/Arbitrary.hs b/services/spar/test/Arbitrary.hs index bac29a685da..bc7cc42d9c2 100644 --- a/services/spar/test/Arbitrary.hs +++ b/services/spar/test/Arbitrary.hs @@ -110,7 +110,7 @@ instance CoArbitrary Time instance CoArbitrary Issuer where coarbitrary (Issuer ur) = coarbitrary $ show ur -instance CoArbitrary a => CoArbitrary (URIRef a) where +instance (CoArbitrary a) => CoArbitrary (URIRef a) where coarbitrary = coarbitrary . show instance CoArbitrary (IdPConfig WireIdP) diff --git a/services/spar/test/Test/Spar/DataSpec.hs b/services/spar/test/Test/Spar/DataSpec.hs index 61af59b7c9a..bf7c9b03dcf 100644 --- a/services/spar/test/Test/Spar/DataSpec.hs +++ b/services/spar/test/Test/Spar/DataSpec.hs @@ -37,16 +37,16 @@ spec = do addTime (ttlToNominalDiffTime $ TTL 3) (Time $ parsetm "1924-07-14T08:30:00Z") `shouldBe` Time (parsetm "1924-07-14T08:30:03Z") -check :: HasCallStack => Int -> Env -> String -> Either TTLError (TTL "authresp") -> Spec +check :: (HasCallStack) => Int -> Env -> String -> Either TTLError (TTL "authresp") -> Spec check testnumber env (parsetm -> endOfLife) expectttl = it (show testnumber) $ mkTTLAssertions env endOfLife `shouldBe` expectttl -parsetm :: HasCallStack => String -> UTCTime +parsetm :: (HasCallStack) => String -> UTCTime parsetm = fromJust . parseTimeM True defaultTimeLocale "%Y-%m-%dT%H:%M:%S%QZ" {-# HLINT ignore "Eta reduce" #-} -- For clarity -mkDataEnv :: HasCallStack => String -> TTL "authresp" -> Env +mkDataEnv :: (HasCallStack) => String -> TTL "authresp" -> Env mkDataEnv now maxttl = Env (parsetm now) diff --git a/services/spar/test/Test/Spar/Scim/UserSpec.hs b/services/spar/test/Test/Spar/Scim/UserSpec.hs index 16dc0636a12..99888ac657c 100644 --- a/services/spar/test/Test/Spar/Scim/UserSpec.hs +++ b/services/spar/test/Test/Spar/Scim/UserSpec.hs @@ -64,16 +64,17 @@ spec = describe "deleteScimUser" $ do deleteUserAndAssertDeletionInSpar :: forall (r :: EffectRow). - Members - '[ Logger (Msg -> Msg), - BrigAccess, - ScimExternalIdStore.ScimExternalIdStore, - ScimUserTimesStore, - SAMLUserStore, - IdPConfigStore, - Embed IO - ] - r => + ( Members + '[ Logger (Msg -> Msg), + BrigAccess, + ScimExternalIdStore.ScimExternalIdStore, + ScimUserTimesStore, + SAMLUserStore, + IdPConfigStore, + Embed IO + ] + r + ) => UserAccount -> ScimTokenInfo -> Sem r (Either ScimError ()) @@ -113,12 +114,12 @@ interpretWithBrigAccessMock mock = . ignoringState idPToMem . mock -ignoringState :: Functor f => (a -> f (c, b)) -> a -> f b +ignoringState :: (Functor f) => (a -> f (c, b)) -> a -> f b ignoringState f = fmap snd . f mockBrig :: forall (r :: EffectRow) a. - Member (Embed IO) r => + (Member (Embed IO) r) => (UserId -> Maybe UserAccount) -> DeleteUserResult -> Sem (BrigAccess ': r) a -> diff --git a/tools/db/assets/src/Assets/Lib.hs b/tools/db/assets/src/Assets/Lib.hs index 036b31ae6b8..9a91599ef11 100644 --- a/tools/db/assets/src/Assets/Lib.hs +++ b/tools/db/assets/src/Assets/Lib.hs @@ -151,7 +151,7 @@ instance Cql AssetText where 0 -> pure $! ImageAssetText k _ -> Left $ "unexpected user asset type: " ++ show t where - required :: Cql r => Text -> Either String r + required :: (Cql r) => Text -> Either String r required f = maybe (Left ("Asset: Missing required field '" ++ show f ++ "'")) diff --git a/tools/db/find-undead/src/Work.hs b/tools/db/find-undead/src/Work.hs index 4803e7dfb24..87fceb70e64 100644 --- a/tools/db/find-undead/src/Work.hs +++ b/tools/db/find-undead/src/Work.hs @@ -55,7 +55,7 @@ runCommand l cas es indexStr mappingStr = do ---------------------------------------------------------------------------- -- Queries -logProgress :: MonadIO m => Logger -> [UUID] -> m () +logProgress :: (MonadIO m) => Logger -> [UUID] -> m () logProgress l uuids = Log.info l $ Log.field "Progress" (show $ length uuids) logDifference :: Logger -> ([UUID], [(UUID, Maybe AccountStatus, Maybe (Writetime ()))]) -> ES.BH IO () @@ -67,7 +67,7 @@ logDifference l (uuidsFromES, fromCas) = do mapM_ (logUUID l "Deleted") deletedUuidsFromCas mapM_ (logUUID l "Extra" . (,Nothing,Nothing)) extraUuids -logUUID :: MonadIO m => Logger -> ByteString -> (UUID, Maybe AccountStatus, Maybe (Writetime ())) -> m () +logUUID :: (MonadIO m) => Logger -> ByteString -> (UUID, Maybe AccountStatus, Maybe (Writetime ())) -> m () logUUID l f (uuid, _, time) = Log.info l $ Log.msg f @@ -101,7 +101,7 @@ esSearch = (ES.mkSearch Nothing (Just esFilter)) {ES.size = ES.Size chunkSize} extractHits :: ES.SearchResult User -> [User] extractHits = mapMaybe ES.hitSource . ES.hits . ES.searchHits -extractScrollId :: MonadThrow m => ES.SearchResult a -> m ES.ScrollId +extractScrollId :: (MonadThrow m) => ES.SearchResult a -> m ES.ScrollId extractScrollId res = maybe (throwM NoScrollId) pure (ES.scrollId res) usersInCassandra :: [UUID] -> Client [(UUID, Maybe AccountStatus, Maybe (Writetime ()))] diff --git a/tools/db/inconsistencies/src/DanglingHandles.hs b/tools/db/inconsistencies/src/DanglingHandles.hs index c6c7571169d..5538274a9b2 100644 --- a/tools/db/inconsistencies/src/DanglingHandles.hs +++ b/tools/db/inconsistencies/src/DanglingHandles.hs @@ -93,7 +93,7 @@ data WithWritetime a = WithWritetime } deriving (Generic) -instance Aeson.ToJSON a => Aeson.ToJSON (WithWritetime a) +instance (Aeson.ToJSON a) => Aeson.ToJSON (WithWritetime a) ---------------------------------------------------------------------------- -- Queries diff --git a/tools/db/inconsistencies/src/DanglingUserKeys.hs b/tools/db/inconsistencies/src/DanglingUserKeys.hs index 59f914fc686..12c9b09ea75 100644 --- a/tools/db/inconsistencies/src/DanglingUserKeys.hs +++ b/tools/db/inconsistencies/src/DanglingUserKeys.hs @@ -97,7 +97,7 @@ data WithWritetime a = WithWritetime } deriving (Generic) -instance Aeson.ToJSON a => Aeson.ToJSON (WithWritetime a) +instance (Aeson.ToJSON a) => Aeson.ToJSON (WithWritetime a) ---------------------------------------------------------------------------- -- Queries diff --git a/tools/db/inconsistencies/src/EmailLessUsers.hs b/tools/db/inconsistencies/src/EmailLessUsers.hs index 7aa277d7167..68f2fb25fd4 100644 --- a/tools/db/inconsistencies/src/EmailLessUsers.hs +++ b/tools/db/inconsistencies/src/EmailLessUsers.hs @@ -96,7 +96,7 @@ data WithWritetime a = WithWritetime } deriving (Generic) -instance Aeson.ToJSON a => Aeson.ToJSON (WithWritetime a) +instance (Aeson.ToJSON a) => Aeson.ToJSON (WithWritetime a) ---------------------------------------------------------------------------- -- Queries diff --git a/tools/db/inconsistencies/src/HandleLessUsers.hs b/tools/db/inconsistencies/src/HandleLessUsers.hs index cec0d5f6948..994b5d69957 100644 --- a/tools/db/inconsistencies/src/HandleLessUsers.hs +++ b/tools/db/inconsistencies/src/HandleLessUsers.hs @@ -72,7 +72,7 @@ data WithWritetime a = WithWritetime } deriving (Generic) -instance Aeson.ToJSON a => Aeson.ToJSON (WithWritetime a) +instance (Aeson.ToJSON a) => Aeson.ToJSON (WithWritetime a) ---------------------------------------------------------------------------- -- Queries diff --git a/tools/db/migrate-sso-feature-flag/src/Work.hs b/tools/db/migrate-sso-feature-flag/src/Work.hs index 36f5d5aba9b..8751c90c084 100644 --- a/tools/db/migrate-sso-feature-flag/src/Work.hs +++ b/tools/db/migrate-sso-feature-flag/src/Work.hs @@ -59,7 +59,7 @@ getSsoTeams = paginateC cql (paramsP LocalQuorum () pageSize) x5 writeSsoFlags :: [TeamId] -> Client () writeSsoFlags = mapM_ (`setSSOTeamConfig` FeatureStatusEnabled) where - setSSOTeamConfig :: MonadClient m => TeamId -> FeatureStatus -> m () + setSSOTeamConfig :: (MonadClient m) => TeamId -> FeatureStatus -> m () setSSOTeamConfig tid ssoTeamConfigStatus = do retry x5 $ write updateSSOTeamConfig (params LocalQuorum (ssoTeamConfigStatus, tid)) diff --git a/tools/db/move-team/src/Common.hs b/tools/db/move-team/src/Common.hs index 0b7f185f4e9..26a65089649 100644 --- a/tools/db/move-team/src/Common.hs +++ b/tools/db/move-team/src/Common.hs @@ -31,11 +31,11 @@ sourceJsonLines handle = .| C.linesUnboundedAscii .| mapC (either error id . eitherDecodeStrict) -sinkJsonLines :: ToJSON a => Handle -> ConduitT [a] Void IO () +sinkJsonLines :: (ToJSON a) => Handle -> ConduitT [a] Void IO () sinkJsonLines hd = C.mapM_ (mapM_ (LBS.hPutStr hd . (<> "\n") . encode)) -- FUTUREWORK: this is very slow. Look for alterantives. Maybe `batch` queries are faster. -sinkTableRows :: Tuple a => PrepQuery W a () -> ConduitM a Void Client () +sinkTableRows :: (Tuple a) => PrepQuery W a () -> ConduitM a Void Client () sinkTableRows insertQuery = go where go = do diff --git a/tools/db/move-team/src/Options.hs b/tools/db/move-team/src/Options.hs index f5d26ed767b..9d13bf9c867 100644 --- a/tools/db/move-team/src/Options.hs +++ b/tools/db/move-team/src/Options.hs @@ -149,5 +149,5 @@ cassandraSettingsParser ks = ) ) -parseUUID :: HasCallStack => String -> UUID +parseUUID :: (HasCallStack) => String -> UUID parseUUID = fromJust . Data.UUID.fromString diff --git a/tools/db/move-team/src/Types.hs b/tools/db/move-team/src/Types.hs index 3c3cfe4d722..3f7ef7ebe36 100644 --- a/tools/db/move-team/src/Types.hs +++ b/tools/db/move-team/src/Types.hs @@ -71,10 +71,10 @@ instance Cql AssetIgnoreData where toCql _ = error "AssetIgnoreData: you should not have any data of this" fromCql _ = pure AssetIgnoreData -instance ToJSON a => ToJSON (Cassandra.Set a) where +instance (ToJSON a) => ToJSON (Cassandra.Set a) where toJSON = toJSON . Cassandra.fromSet -instance FromJSON a => FromJSON (Cassandra.Set a) where +instance (FromJSON a) => FromJSON (Cassandra.Set a) where parseJSON = fmap Cassandra.Set . parseJSON instance ToJSON Blob where diff --git a/tools/db/move-team/src/Work.hs b/tools/db/move-team/src/Work.hs index b8a75722080..e0394c808be 100644 --- a/tools/db/move-team/src/Work.hs +++ b/tools/db/move-team/src/Work.hs @@ -155,7 +155,7 @@ runFullScans env@Env {..} users = do readSparUserAll env .| mapC (filter (haveId . view _3)) -appendJsonLines :: ToJSON a => FilePath -> ConduitM () [a] IO () -> IO () +appendJsonLines :: (ToJSON a) => FilePath -> ConduitM () [a] IO () -> IO () appendJsonLines path conduit = IO.withBinaryFile path IO.AppendMode $ \outH -> runConduit $ conduit .| sinkJsonLines outH diff --git a/tools/db/phone-users/src/PhoneUsers/Lib.hs b/tools/db/phone-users/src/PhoneUsers/Lib.hs index 8c913b7a0bf..8bf816461ea 100644 --- a/tools/db/phone-users/src/PhoneUsers/Lib.hs +++ b/tools/db/phone-users/src/PhoneUsers/Lib.hs @@ -62,16 +62,16 @@ getConferenceCalling client tid = do process :: Log.Logger -> Maybe Int -> ClientState -> ClientState -> IO Result process logger limit brigClient galleyClient = - runConduit $ - readUsers brigClient - -- .| Conduit.mapM (\chunk -> SIO.hPutStr stderr "." $> chunk) - .| Conduit.concat - .| (maybe (Conduit.filter (const True)) Conduit.take limit) - .| Conduit.mapM (getUserInfo logger brigClient galleyClient) - .| forever (CL.isolate 10000 .| (Conduit.foldMap infoToResult >>= yield)) - .| Conduit.takeWhile ((> 0) . usersSearched) - .| CL.scan (<>) mempty - `fuseUpstream` Conduit.mapM_ (\r -> Log.info logger $ "intermediate_result" .= show r) + runConduit + $ readUsers brigClient + -- .| Conduit.mapM (\chunk -> SIO.hPutStr stderr "." $> chunk) + .| Conduit.concat + .| (maybe (Conduit.filter (const True)) Conduit.take limit) + .| Conduit.mapM (getUserInfo logger brigClient galleyClient) + .| forever (CL.isolate 10000 .| (Conduit.foldMap infoToResult >>= yield)) + .| Conduit.takeWhile ((> 0) . usersSearched) + .| CL.scan (<>) mempty + `fuseUpstream` Conduit.mapM_ (\r -> Log.info logger $ "intermediate_result" .= show r) getUserInfo :: Log.Logger -> ClientState -> ClientState -> UserRow -> IO UserInfo getUserInfo logger brigClient galleyClient ur = do @@ -95,15 +95,16 @@ getUserInfo logger brigClient galleyClient ur = do Nothing -> pure ActivePersonalUser Just tid -> do isPaying <- isPayingTeam galleyClient tid - pure $ - if isPaying + pure + $ if isPaying then ActiveTeamUser Free else ActiveTeamUser Paid - Log.info logger $ - "active_phone_user" .= show apu - ~~ "user_record" .= show ur - ~~ "last_active_timestamps" .= show lastActiveTimeStamps - ~~ Log.msg (Log.val "active phone user found") + Log.info logger + $ "active_phone_user" + .= show apu + ~~ "user_record" .= show ur + ~~ "last_active_timestamps" .= show lastActiveTimeStamps + ~~ Log.msg (Log.val "active phone user found") pure apu else pure InactiveLast90Days pure $ PhoneUser userInfo diff --git a/tools/db/phone-users/src/PhoneUsers/Types.hs b/tools/db/phone-users/src/PhoneUsers/Types.hs index fc60a3ee038..9a19a26f001 100644 --- a/tools/db/phone-users/src/PhoneUsers/Types.hs +++ b/tools/db/phone-users/src/PhoneUsers/Types.hs @@ -77,7 +77,8 @@ galleyCassandraParser = <> value 9043 <> showDefault ) - <*> ( C.Keyspace . view packed + <*> ( C.Keyspace + . view packed <$> strOption ( long "galley-cassandra-keyspace" <> metavar "STRING" @@ -105,7 +106,8 @@ brigCassandraParser = <> value 9042 <> showDefault ) - <*> ( C.Keyspace . view packed + <*> ( C.Keyspace + . view packed <$> strOption ( long "brig-cassandra-keyspace" <> metavar "STRING" diff --git a/tools/db/repair-brig-clients-table/src/Work.hs b/tools/db/repair-brig-clients-table/src/Work.hs index 41eca357c92..3541c1b62fa 100644 --- a/tools/db/repair-brig-clients-table/src/Work.hs +++ b/tools/db/repair-brig-clients-table/src/Work.hs @@ -75,7 +75,7 @@ filterReportRemove dryRun l row@(user, client, Nothing, Nothing, Nothing, Nothin rm user client Log.info l (Log.msg @Text "removed!") where - rm :: MonadClient m => UserId -> Text -> m () + rm :: (MonadClient m) => UserId -> Text -> m () rm uid cid = retry x5 $ write rmq (params LocalQuorum (uid, cid)) diff --git a/tools/db/repair-handles/src/Options.hs b/tools/db/repair-handles/src/Options.hs index 31d7228e7bf..ece858a6058 100644 --- a/tools/db/repair-handles/src/Options.hs +++ b/tools/db/repair-handles/src/Options.hs @@ -35,7 +35,7 @@ settingsParser = <*> option auto (short 's' <> long "page-size" <> value 1000) <*> (Id . parseUUID <$> strArgument (metavar "TEAM-UUID")) -parseUUID :: HasCallStack => String -> UUID +parseUUID :: (HasCallStack) => String -> UUID parseUUID = fromJust . Data.UUID.fromString cassandraSettingsParser :: String -> Parser CassandraSettings diff --git a/tools/db/repair-handles/src/Work.hs b/tools/db/repair-handles/src/Work.hs index 70647a443d5..065941f385f 100644 --- a/tools/db/repair-handles/src/Work.hs +++ b/tools/db/repair-handles/src/Work.hs @@ -198,7 +198,7 @@ runCommand env@Env {..} = do tally (nErrs, nReset, nSet, nNoOp) (Right NoActionRequired {}) = (nErrs, nReset, nSet, nNoOp + 1) tally (nErrs, nReset, nSet, nNoOp) (Left _) = (nErrs + 1, nReset, nSet, nNoOp) - chunkify :: Monad m => Int -> ConduitT i [i] m () + chunkify :: (Monad m) => Int -> ConduitT i [i] m () chunkify n = void (C.map (: [])) .| C.chunksOfE n main :: IO () diff --git a/tools/fedcalls/src/Main.hs b/tools/fedcalls/src/Main.hs index 8c8775fa9a1..ad14e495706 100644 --- a/tools/fedcalls/src/Main.hs +++ b/tools/fedcalls/src/Main.hs @@ -103,7 +103,7 @@ filterCalls fedCall = <*> fmap pure (method fedCall) <*> pure (fedCalls fedCall) -parse :: HasFeds api => Proxy api -> [MakesCallTo] +parse :: (HasFeds api) => Proxy api -> [MakesCallTo] parse p = do fedCallM <- evalState (getFedCalls p) mempty fedCallI <- maybeToList $ filterCalls fedCallM diff --git a/tools/mlsstats/src/MlsStats/Run.hs b/tools/mlsstats/src/MlsStats/Run.hs index 803ea8a7bb5..ec3eb3bc370 100644 --- a/tools/mlsstats/src/MlsStats/Run.hs +++ b/tools/mlsstats/src/MlsStats/Run.hs @@ -101,7 +101,7 @@ runCommand s3 galleyTables brigTables queryPageSize = do upload "domain-user-client-group.csv" (domainUserClientGroup galleyTables queryPageSize) upload "user-conv.csv" (userConv galleyTables queryPageSize) -userClient :: MonadIO m => ClientState -> Int32 -> ConduitT () ByteString m () +userClient :: (MonadIO m) => ClientState -> Int32 -> ConduitT () ByteString m () userClient cassandra queryPageSize = do yield "user,client\r\n" ( transPipe @@ -114,7 +114,7 @@ userClient cassandra queryPageSize = do userClientCql :: PrepQuery R () (UserId, ClientId) userClientCql = "SELECT user, client FROM clients" -convGroupTeamProtocol :: MonadIO m => ClientState -> Int32 -> ConduitT () ByteString m () +convGroupTeamProtocol :: (MonadIO m) => ClientState -> Int32 -> ConduitT () ByteString m () convGroupTeamProtocol cassandra queryPageSize = do yield "conversation,group,team,protocol\r\n" ( transPipe @@ -143,7 +143,7 @@ convGroupTeamProtocol cassandra queryPageSize = do A.String s -> s _ -> "?" -domainUserClientGroup :: MonadIO m => ClientState -> Int32 -> ConduitT () ByteString m () +domainUserClientGroup :: (MonadIO m) => ClientState -> Int32 -> ConduitT () ByteString m () domainUserClientGroup cassandra queryPageSize = do yield "user_domain,user,client,group\r\n" ( transPipe @@ -166,7 +166,7 @@ domainUserClientGroup cassandra queryPageSize = do domainUserClientGroupCql :: PrepQuery R () (Domain, UserId, ClientId, GroupId) domainUserClientGroupCql = "SELECT user_domain, user, client, group_id FROM mls_group_member_client" -userConv :: MonadIO m => ClientState -> Int32 -> ConduitT () ByteString m () +userConv :: (MonadIO m) => ClientState -> Int32 -> ConduitT () ByteString m () userConv cassandra queryPageSize = do yield "user,conversation\r\n" ( transPipe diff --git a/tools/rex/Main.hs b/tools/rex/Main.hs index 12e9ad777c9..34401a8037e 100644 --- a/tools/rex/Main.hs +++ b/tools/rex/Main.hs @@ -356,7 +356,7 @@ getPeerConnectivityStats lgr seed dom = do Log.warn lgr . msg $ "Peer " <> show addr <> ":" <> show port <> " unreachable: " <> show e -serveIO :: MonadIO m => Opts -> IO RegistrySample -> m () +serveIO :: (MonadIO m) => Opts -> IO RegistrySample -> m () serveIO opts runSample = liftIO $ runSettings diff --git a/tools/stern/src/Stern/API.hs b/tools/stern/src/Stern/API.hs index 154b861e8ab..27e737e9623 100644 --- a/tools/stern/src/Stern/API.hs +++ b/tools/stern/src/Stern/API.hs @@ -469,7 +469,7 @@ getUserData uid mMaxConvs mMaxNotifs = do -- Utilities -instance FromByteString a => Servant.FromHttpApiData [a] where +instance (FromByteString a) => Servant.FromHttpApiData [a] where parseUrlPiece = maybe (Left "not a list of a's") (Right . fromList) . fromByteString' diff --git a/tools/stern/src/Stern/API/Routes.hs b/tools/stern/src/Stern/API/Routes.hs index 55113e85177..35dee177d32 100644 --- a/tools/stern/src/Stern/API/Routes.hs +++ b/tools/stern/src/Stern/API/Routes.hs @@ -505,7 +505,7 @@ instance Schema.ToSchema UserConnectionGroups where <*> ucgMissingLegalholdConsent Schema..= Schema.field "ucgMissingLegalholdConsent" Schema.schema <*> ucgTotal Schema..= Schema.field "ucgTotal" Schema.schema -doubleMaybeToEither :: Monad m => LText -> Maybe a -> Maybe b -> ExceptT Error m (Either a b) +doubleMaybeToEither :: (Monad m) => LText -> Maybe a -> Maybe b -> ExceptT Error m (Either a b) doubleMaybeToEither _ (Just a) Nothing = pure $ Left a doubleMaybeToEither _ Nothing (Just b) = pure $ Right b doubleMaybeToEither msg _ _ = throwE $ mkError status400 "either-params" ("Must use exactly one of two query params: " <> msg) diff --git a/tools/stern/src/Stern/App.hs b/tools/stern/src/Stern/App.hs index 6042f6b88c5..3a75f308748 100644 --- a/tools/stern/src/Stern/App.hs +++ b/tools/stern/src/Stern/App.hs @@ -89,7 +89,7 @@ deriving instance MonadUnliftIO App type App = AppT IO -instance MonadIO m => MonadLogger (AppT m) where +instance (MonadIO m) => MonadLogger (AppT m) where log l m = do g <- view applog r <- view requestId @@ -98,12 +98,12 @@ instance MonadIO m => MonadLogger (AppT m) where instance MonadLogger (ExceptT e App) where log l m = lift (LC.log l m) -instance MonadIO m => Bilge.MonadHttp (AppT m) where +instance (MonadIO m) => Bilge.MonadHttp (AppT m) where handleRequestWithCont req h = do m <- view httpManager liftIO $ Bilge.withResponse req m h -instance Monad m => HasRequestId (AppT m) where +instance (Monad m) => HasRequestId (AppT m) where getRequestId = view requestId instance HasRequestId (ExceptT e App) where diff --git a/tools/stern/src/Stern/Intra.hs b/tools/stern/src/Stern/Intra.hs index 79a2d1d87fc..ed283ad9e6f 100644 --- a/tools/stern/src/Stern/Intra.hs +++ b/tools/stern/src/Stern/Intra.hs @@ -76,7 +76,6 @@ import Bilge.RPC import Brig.Types.Intra import Control.Error import Control.Lens (view, (^.)) -import Control.Monad.Reader import Data.Aeson hiding (Error) import Data.Aeson.KeyMap qualified as KeyMap import Data.Aeson.Types (emptyArray) @@ -249,7 +248,7 @@ getUserProfiles uidsOrHandles = do prepareQS :: Either [UserId] [Handle] -> [Request -> Request] prepareQS (Left uids) = fmap (queryItem "ids") (toQS uids) prepareQS (Right handles) = fmap (queryItem "handles") (toQS handles) - toQS :: ToByteString a => [a] -> [ByteString] + toQS :: (ToByteString a) => [a] -> [ByteString] toQS = fmap (BS.intercalate "," . map toByteString') . chunksOf 50 @@ -315,8 +314,9 @@ revokeIdentity :: Either Email Phone -> Handler () revokeIdentity emailOrPhone = do info $ msg "Revoking user identity" b <- view brig - void . catchRpcErrors $ - rpc' + void + . catchRpcErrors + $ rpc' "brig" b ( method POST @@ -329,8 +329,9 @@ deleteAccount :: UserId -> Handler () deleteAccount uid = do info $ msg "Deleting account" b <- view brig - void . catchRpcErrors $ - rpc' + void + . catchRpcErrors + $ rpc' "brig" b ( method DELETE @@ -346,8 +347,9 @@ setStatusBindingTeam tid status = do <> UTF8.toString (BS.toStrict . encode $ status) ) g <- view galley - void . catchRpcErrors $ - rpc' + void + . catchRpcErrors + $ rpc' "galley" g ( method PUT @@ -360,8 +362,9 @@ deleteBindingTeam :: TeamId -> Handler () deleteBindingTeam tid = do info $ msg "Deleting team" g <- view galley - void . catchRpcErrors $ - rpc' + void + . catchRpcErrors + $ rpc' "galley" g ( method DELETE @@ -374,8 +377,9 @@ deleteBindingTeamForce :: TeamId -> Handler () deleteBindingTeamForce tid = do info $ msg "Deleting team with force flag" g <- view galley - void . catchRpcErrors $ - rpc' + void + . catchRpcErrors + $ rpc' "galley" g ( method DELETE @@ -388,8 +392,9 @@ changeEmail :: UserId -> EmailUpdate -> Handler () changeEmail u upd = do info $ msg "Updating email address" b <- view brig - void . catchRpcErrors $ - rpc' + void + . catchRpcErrors + $ rpc' "brig" b ( method PUT @@ -406,8 +411,9 @@ changePhone :: UserId -> PhoneUpdate -> Handler () changePhone u upd = do info $ msg "Updating phone number" b <- view brig - void . catchRpcErrors $ - rpc' + void + . catchRpcErrors + $ rpc' "brig" b ( method PUT @@ -445,7 +451,8 @@ getUserBindingTeam u = do listToMaybe $ fmap (view teamId) $ filter ((== Binding) . view teamBinding) $ - teams ^. teamListTeams + teams + ^. teamListTeams getInvoiceUrl :: TeamId -> InvoiceId -> Handler ByteString getInvoiceUrl tid iid = do @@ -484,8 +491,9 @@ setTeamBillingInfo :: TeamId -> TeamBillingInfo -> Handler () setTeamBillingInfo tid tbu = do info $ msg "Setting team billing info" i <- view ibis - void . catchRpcErrors $ - rpc' + void + . catchRpcErrors + $ rpc' "ibis" i ( method PUT @@ -517,8 +525,9 @@ setBlacklistStatus :: Bool -> Either Email Phone -> Handler () setBlacklistStatus status emailOrPhone = do info $ msg "Changing blacklist status" b <- view brig - void . catchRpcErrors $ - rpc' + void + . catchRpcErrors + $ rpc' "brig" b ( method (statusToMethod status) @@ -604,8 +613,9 @@ setTeamFeatureLockStatus :: setTeamFeatureLockStatus tid lstat = do info $ msg ("Setting lock status: " <> show (symbolVal (Proxy @(Public.FeatureSymbol cfg)), lstat)) gly <- view galley - fromResponseBody <=< catchRpcErrors $ - rpc' + fromResponseBody + <=< catchRpcErrors + $ rpc' "galley" gly ( method PUT @@ -626,8 +636,9 @@ getSearchVisibility :: TeamId -> Handler TeamSearchVisibilityView getSearchVisibility tid = do info $ msg "Getting TeamSearchVisibilityView value" gly <- view galley - fromResponseBody <=< catchRpcErrors $ - rpc' + fromResponseBody + <=< catchRpcErrors + $ rpc' "galley" gly ( method GET @@ -948,8 +959,9 @@ putSsoDomainRedirect domain config welcome = do -- }' -- curl -XPUT http://localhost/i/custom-backend/by-domain/${DOMAIN_EXAMPLE} -d "${DOMAIN_ENTRY}" g <- view galley - void . catchRpcErrors $ - rpc' + void + . catchRpcErrors + $ rpc' "galley" g ( method PUT @@ -968,8 +980,9 @@ deleteSsoDomainRedirect domain = do info $ msg "deleteSsoDomainRedirect" -- curl -XDELETE http://localhost/i/custom-backend/by-domain/${DOMAIN_EXAMPLE} g <- view galley - void . catchRpcErrors $ - rpc' + void + . catchRpcErrors + $ rpc' "galley" g ( method DELETE diff --git a/tools/stern/test/integration/Util.hs b/tools/stern/test/integration/Util.hs index acfa6afa731..dc6cf21de41 100644 --- a/tools/stern/test/integration/Util.hs +++ b/tools/stern/test/integration/Util.hs @@ -54,7 +54,7 @@ import Wire.API.User as User eventually :: (MonadIO m, MonadMask m, MonadUnliftIO m) => m a -> m a eventually = recoverAll (limitRetries 7 <> exponentialBackoff 50000) . const -createTeamWithNMembers :: HasCallStack => Int -> TestM (UserId, TeamId, [UserId]) +createTeamWithNMembers :: (HasCallStack) => Int -> TestM (UserId, TeamId, [UserId]) createTeamWithNMembers n = do (owner, tid) <- createBindingTeam mems <- replicateM n $ do @@ -62,32 +62,32 @@ createTeamWithNMembers n = do pure (mem ^. Team.userId) pure (owner, tid, mems) -createBindingTeam :: HasCallStack => TestM (UserId, TeamId) +createBindingTeam :: (HasCallStack) => TestM (UserId, TeamId) createBindingTeam = do first User.userId <$> createBindingTeam' -createBindingTeam' :: HasCallStack => TestM (User, TeamId) +createBindingTeam' :: (HasCallStack) => TestM (User, TeamId) createBindingTeam' = do owner <- randomTeamCreator' refreshIndex pure (owner, fromMaybe (error "createBindingTeam: no team id") (owner.userTeam)) -randomTeamCreator' :: HasCallStack => TestM User +randomTeamCreator' :: (HasCallStack) => TestM User randomTeamCreator' = randomUser'' True True True -randomUser :: HasCallStack => TestM UserId +randomUser :: (HasCallStack) => TestM UserId randomUser = qUnqualified <$> randomUser' False True True -randomUser' :: HasCallStack => Bool -> Bool -> Bool -> TestM (Qualified UserId) +randomUser' :: (HasCallStack) => Bool -> Bool -> Bool -> TestM (Qualified UserId) randomUser' isCreator hasPassword hasEmail = userQualifiedId <$> randomUser'' isCreator hasPassword hasEmail -randomUser'' :: HasCallStack => Bool -> Bool -> Bool -> TestM User +randomUser'' :: (HasCallStack) => Bool -> Bool -> Bool -> TestM User randomUser'' isCreator hasPassword hasEmail = selfUser <$> randomUserProfile' isCreator hasPassword hasEmail -randomUserProfile' :: HasCallStack => Bool -> Bool -> Bool -> TestM SelfProfile +randomUserProfile' :: (HasCallStack) => Bool -> Bool -> Bool -> TestM SelfProfile randomUserProfile' isCreator hasPassword hasEmail = randomUserProfile'' isCreator hasPassword hasEmail <&> fst -randomUserProfile'' :: HasCallStack => Bool -> Bool -> Bool -> TestM (SelfProfile, (Email, Phone)) +randomUserProfile'' :: (HasCallStack) => Bool -> Bool -> Bool -> TestM (SelfProfile, (Email, Phone)) randomUserProfile'' isCreator hasPassword hasEmail = do b <- view tsBrig e <- liftIO randomEmail @@ -101,25 +101,25 @@ randomUserProfile'' isCreator hasPassword hasEmail = do <> ["team" .= BindingNewTeam (newNewTeam (unsafeRange "teamName") DefaultIcon) | isCreator] (,(e, p)) . responseJsonUnsafe <$> (post (b . path "/i/users" . Bilge.json pl) m Phone +randomPhone :: (MonadIO m) => m Phone randomPhone = liftIO $ do nrs <- map show <$> replicateM 14 (randomRIO (0, 9) :: IO Int) let phone = parsePhone . Text.pack $ "+0" ++ concat nrs pure $ fromMaybe (error "Invalid random phone#") phone -randomEmailUser :: HasCallStack => TestM (UserId, Email) +randomEmailUser :: (HasCallStack) => TestM (UserId, Email) randomEmailUser = randomUserProfile'' False False True <&> bimap (User.userId . selfUser) fst -randomPhoneUser :: HasCallStack => TestM (UserId, Phone) +randomPhoneUser :: (HasCallStack) => TestM (UserId, Phone) randomPhoneUser = randomUserProfile'' False False True <&> bimap (User.userId . selfUser) snd -randomEmailPhoneUser :: HasCallStack => TestM (UserId, (Email, Phone)) +randomEmailPhoneUser :: (HasCallStack) => TestM (UserId, (Email, Phone)) randomEmailPhoneUser = randomUserProfile'' False False True <&> first (User.userId . selfUser) defPassword :: PlainTextPassword8 defPassword = plainTextPassword8Unsafe "topsecretdefaultpassword" -randomEmail :: MonadIO m => m Email +randomEmail :: (MonadIO m) => m Email randomEmail = do uid <- liftIO nextRandom pure $ Email ("success+" <> UUID.toText uid) "simulator.amazonses.com" @@ -135,7 +135,7 @@ setHandle uid h = do !!! do const 200 === statusCode -randomHandle :: MonadIO m => m Text +randomHandle :: (MonadIO m) => m Text randomHandle = liftIO $ do nrs <- replicateM 21 (randomRIO (97, 122)) -- a-z pure (Text.pack (map chr nrs)) @@ -145,10 +145,10 @@ refreshIndex = do brig <- view tsBrig post (brig . path "/i/index/refresh") !!! const 200 === statusCode -addUserToTeam :: HasCallStack => UserId -> TeamId -> TestM TeamMember +addUserToTeam :: (HasCallStack) => UserId -> TeamId -> TestM TeamMember addUserToTeam = addUserToTeamWithRole Nothing -addUserToTeamWithRole :: HasCallStack => Maybe Role -> UserId -> TeamId -> TestM TeamMember +addUserToTeamWithRole :: (HasCallStack) => Maybe Role -> UserId -> TeamId -> TestM TeamMember addUserToTeamWithRole role inviter tid = do (inv, rsp2) <- addUserToTeamWithRole' role inviter tid let invitee :: User = responseJsonUnsafe rsp2 @@ -160,7 +160,7 @@ addUserToTeamWithRole role inviter tid = do liftIO $ assertEqual "Wrong cookie" (Just "zuid") (setCookieName <$> zuid) pure mem -addUserToTeamWithRole' :: HasCallStack => Maybe Role -> UserId -> TeamId -> TestM (Invitation, ResponseLBS) +addUserToTeamWithRole' :: (HasCallStack) => Maybe Role -> UserId -> TeamId -> TestM (Invitation, ResponseLBS) addUserToTeamWithRole' role inviter tid = do brig <- view tsBrig inviteeEmail <- randomEmail @@ -187,7 +187,7 @@ acceptInviteBody email code = "team_code" .= code ] -getInvitationCode :: HasCallStack => TeamId -> InvitationId -> TestM InvitationCode +getInvitationCode :: (HasCallStack) => TeamId -> InvitationId -> TestM InvitationCode getInvitationCode t ref = do brig <- view tsBrig let getm :: TestM (Maybe InvitationCode) @@ -233,7 +233,7 @@ zConn = header "Z-Connection" zType :: ByteString -> Request -> Request zType = header "Z-Type" -getTeamMember :: HasCallStack => UserId -> TeamId -> UserId -> TestM TeamMember +getTeamMember :: (HasCallStack) => UserId -> TeamId -> UserId -> TestM TeamMember getTeamMember getter tid gettee = do g <- view tsGalley getTeamMember' g getter tid gettee diff --git a/tools/test-stats/Main.hs b/tools/test-stats/Main.hs index 7c97134cbbb..c825fca8fbc 100644 --- a/tools/test-stats/Main.hs +++ b/tools/test-stats/Main.hs @@ -166,6 +166,6 @@ pushToPostgresql opts (reports, failedRuns, successfulRuns) = do map (testCaseRunId,) report.failureDesc void $ MonoidalMap.traverseWithKey saveTestCaseRun reports -extractId :: HasCallStack => [Only Int] -> IO Int +extractId :: (HasCallStack) => [Only Int] -> IO Int extractId [] = error $ "No ID returned by query" extractId (Only x : _) = pure x From 0d874118cea62526fb1111b6861b21012f6897f5 Mon Sep 17 00:00:00 2001 From: Magnus Viernickel Date: Wed, 19 Jun 2024 14:51:17 +0200 Subject: [PATCH 32/64] [chore] update warp --- .../src/HTTP2/Client/Manager/Internal.hs | 14 ++-- .../test/Test/HTTP2/Client/ManagerSpec.hs | 14 +++- .../src/Wire/API/Federation/Client.hs | 2 +- nix/haskell-pins.nix | 66 ++++++++++++++++--- nix/manual-overrides.nix | 16 +---- 5 files changed, 80 insertions(+), 32 deletions(-) diff --git a/libs/http2-manager/src/HTTP2/Client/Manager/Internal.hs b/libs/http2-manager/src/HTTP2/Client/Manager/Internal.hs index 4861a150a4a..5ec47c2fff0 100644 --- a/libs/http2-manager/src/HTTP2/Client/Manager/Internal.hs +++ b/libs/http2-manager/src/HTTP2/Client/Manager/Internal.hs @@ -15,6 +15,7 @@ import Control.Monad import Control.Monad.IO.Class import Data.ByteString import qualified Data.ByteString as BS +import qualified Data.ByteString.Char8 as C8 import Data.IORef import Data.Map import qualified Data.Map as Map @@ -291,9 +292,9 @@ startPersistentHTTP2Connection :: startPersistentHTTP2Connection ctx (tlsEnabled, hostname, port) cl removeTrailingDot tcpConnectTimeout sendReqMVar = do liveReqs <- newIORef mempty let clientConfig = - HTTP2.ClientConfig + HTTP2.defaultClientConfig { HTTP2.scheme = if tlsEnabled then "https" else "http", - HTTP2.authority = hostname, + HTTP2.authority = C8.unpack hostname, HTTP2.cacheLimit = cl } -- Sends error to requests which show up too late, i.e. after the @@ -333,7 +334,7 @@ startPersistentHTTP2Connection ctx (tlsEnabled, hostname, port) cl removeTrailin bracket connectTCPWithTimeout NS.close $ \sock -> do bracket (mkTransport sock transportConfig) cleanupTransport $ \transport -> bracket (allocHTTP2Config transport) HTTP2.freeSimpleConfig $ \http2Cfg -> do - let runAction = HTTP2.run clientConfig http2Cfg $ \sendReq -> do + let runAction = HTTP2.run clientConfig http2Cfg $ \sendReq _aux -> do handleRequests liveReqs sendReq -- Any request threads still hanging about after 'runAction' finishes -- are canceled with 'ConnectionAlreadyClosed'. @@ -451,6 +452,9 @@ allocHTTP2Config (SecureTransport ssl) = do error "openssl: SSL.read returned more bytes than asked for, this is probably a bug" | otherwise -> readData (acc <> chunk) (n - chunkLen) + let s = fromMaybe (error "http2-manager: SSL without socket") $ SSL.sslSocket ssl + mysa <- NS.getSocketName s + peersa <- NS.getPeerName s pure HTTP2.Config @@ -459,5 +463,7 @@ allocHTTP2Config (SecureTransport ssl) = do HTTP2.confSendAll = SSL.write ssl, HTTP2.confReadN = readData mempty, HTTP2.confPositionReadMaker = HTTP2.defaultPositionReadMaker, - HTTP2.confTimeoutManager = timmgr + HTTP2.confTimeoutManager = timmgr, + HTTP2.confMySockAddr = mysa, + HTTP2.confPeerSockAddr = peersa } diff --git a/libs/http2-manager/test/Test/HTTP2/Client/ManagerSpec.hs b/libs/http2-manager/test/Test/HTTP2/Client/ManagerSpec.hs index 04593bf39ab..f3498187306 100644 --- a/libs/http2-manager/test/Test/HTTP2/Client/ManagerSpec.hs +++ b/libs/http2-manager/test/Test/HTTP2/Client/ManagerSpec.hs @@ -23,7 +23,7 @@ import qualified Data.ByteString.Lazy.Char8 as LBS import Data.IORef import Data.Map (Map) import qualified Data.Map as Map -import Data.Maybe (isJust) +import Data.Maybe (fromMaybe, isJust) import Data.Streaming.Network (bindPortTCP, bindRandomPortTCP) import Data.Unique import Foreign.Marshal.Alloc (mallocBytes) @@ -33,8 +33,10 @@ import HTTP2.Client.Manager.Internal import Network.HTTP.Types import qualified Network.HTTP2.Client as Client import qualified Network.HTTP2.Client as HTTP2 +import Network.HTTP2.Server (defaultServerConfig) import qualified Network.HTTP2.Server as Server import Network.Socket +import qualified Network.Socket as NS import qualified OpenSSL.Session as SSL import System.Random (randomRIO) import qualified System.TimeManager @@ -293,6 +295,10 @@ allocServerConfig (Right ssl) = do error "openssl: SSL.read returned more bytes than asked for, this is probably a bug" | otherwise -> readData (prevChunk <> chunk) (n - chunkLen) + + let s = fromMaybe (error "http2-manager: SSL without socket") $ SSL.sslSocket ssl + mysa <- NS.getSocketName s + peersa <- NS.getPeerName s pure Server.Config { Server.confWriteBuffer = buf, @@ -300,7 +306,9 @@ allocServerConfig (Right ssl) = do Server.confSendAll = SSL.write ssl, Server.confReadN = readData mempty, Server.confPositionReadMaker = Server.defaultPositionReadMaker, - Server.confTimeoutManager = timmgr + Server.confTimeoutManager = timmgr, + Server.confMySockAddr = mysa, + Server.confPeerSockAddr = peersa } testServerOnSocket :: Maybe SSL.SSLContext -> Socket -> IORef Int -> IORef (Map Unique (Async ())) -> IO () @@ -322,7 +330,7 @@ testServerOnSocket mCtx listenSock connsCounter conns = do cleanup cfg = do Server.freeSimpleConfig cfg `finally` (shutdownSSL `finally` close sock) thread <- async $ bracket (allocServerConfig serverCfgParam) cleanup $ \cfg -> do - Server.run cfg testServer `finally` modifyIORef conns (Map.delete connKey) + Server.run defaultServerConfig cfg testServer `finally` modifyIORef conns (Map.delete connKey) modifyIORef conns $ Map.insert connKey thread testServer :: Server.Request -> Server.Aux -> (Server.Response -> [Server.PushPromise] -> IO ()) -> IO () diff --git a/libs/wire-api-federation/src/Wire/API/Federation/Client.hs b/libs/wire-api-federation/src/Wire/API/Federation/Client.hs index 2f6fcde3051..98f653e6083 100644 --- a/libs/wire-api-federation/src/Wire/API/Federation/Client.hs +++ b/libs/wire-api-federation/src/Wire/API/Federation/Client.hs @@ -120,7 +120,7 @@ instance VersionedMonad Version (FederatorClient c) where liftCodensity :: Codensity IO a -> FederatorClient c a liftCodensity = FederatorClient . lift . lift . lift -headersFromTable :: HTTP2.HeaderTable -> [HTTP.Header] +headersFromTable :: HTTP2.TokenHeaderTable -> [HTTP.Header] headersFromTable (headerList, _) = flip map headerList $ first HTTP2.tokenKey -- This opens a new http2 connection. Using a http2-manager leads to this problem https://wearezeta.atlassian.net/browse/WPB-4787 diff --git a/nix/haskell-pins.nix b/nix/haskell-pins.nix index 9b6b99d8195..cc3694f7fd4 100644 --- a/nix/haskell-pins.nix +++ b/nix/haskell-pins.nix @@ -258,7 +258,30 @@ let hash = "sha256-E35PVxi/4iJFfWts3td52KKZKQt4dj9KFP3SvWG77Cc="; }; }; + + # open PR https://github.com/yesodweb/wai/pull/958 for sending connection: close when closing connection + warp = { + packages.warp = "warp"; + src = pkgs.fetchFromGitHub { + owner = "yesodweb"; + repo = "wai"; + rev = "8b20c9db265a202a2c7ba2a9ec8786a1ee59957b"; + hash = "sha256-fKUSiRl38FKY1gFSmbksktoqoLfQrDxRRWEh4k+RRW4="; + }; + }; + + # this contains an important fix to the initialization of the window size + # and should be switched to upstream as soon as we can + http2 = { + src = pkgs.fetchFromGitHub { + owner = "kazu-yamamoto"; + repo = "http2"; + rev = "80921ad15fac05715ede7063d57585d4e7049f99"; + hash = "sha256-AQPZzx0SiIPbWG2AguGcDITTQLKW9OX1qxmiS+wrHN8="; + }; + }; }; + hackagePins = { # Major re-write upstream, we should get rid of this dependency rather than # adapt to upstream, this will go away when completing servantification. @@ -267,16 +290,38 @@ let sha256 = "sha256-DSMckKIeVE/buSMg8Mq+mUm1bYPYB7veA11Ns7vTBbc="; }; - http2 = { - version = "4.1.4"; - sha256 = "sha256-r4Bu0vourKMkBO1cPeJVszSbAqHopmkv9EeTHcaTfuo="; + # start pinned dependencies for http2 + http-semantics = { + version = "0.1.1"; + sha256 = "sha256-znxplxXjPWNrGR7//7e6HS9CaS1ID/aXUhRYfWakTWU="; }; - # warp is not compatible with - warp = { - version = "3.3.30"; - sha256 = "sha256-VrK27a2wFtezh9qabcXGe2tw9EwBmI8mKwmpCtXq9rc="; + network-run = { + version = "0.3.0"; + sha256 = "sha256-FP2GZKwacC+TLLwEIVgKBtnKplYPf5xOIjDfvlbQV0o="; + }; + time-manager = { + version = "0.1.0"; + sha256 = "sha256-WRe9LZrOIPJVBFk0vMN2IMoxgP0a0psQCiCiOFWJc74="; + }; + auto-update = { + version = "0.2.0"; + sha256 = "sha256-d/0IDjaaCLz8tlx88z8Ew8ol9PrSRPVWaUwTbim70yE="; }; + + network-control = { + version = "0.1.0"; + sha256 = "sha256-D6pKb6+0Pr08FnObGbXBVMv04ys3N731p7U+GYH1oEg="; + }; + # end pinned dependencies for http2 + + # pinned for warp + warp-tls = { + version = "3.4.5"; + sha256 = "sha256-3cDi/+n7wHfcWT/iFWAsGdLYXtKYXmvzolDt+ACJnaM="; + }; + # end pinned for warp + # PR: https://github.com/wireapp/wire-server/pull/4027 HsOpenSSL = { version = "0.11.7.7"; @@ -311,11 +356,12 @@ let gitPins; # AttrSet hackagePackages = lib.attrsets.mapAttrs - (pkg: { version, sha256 }: + (pkg: args: hself.callHackageDirect { - ver = version; - inherit pkg sha256; + ver = args.version; + sha256 = args.sha256 or ""; + inherit pkg; } { } ) diff --git a/nix/manual-overrides.nix b/nix/manual-overrides.nix index 86a55d8754f..d2d6a1baef8 100644 --- a/nix/manual-overrides.nix +++ b/nix/manual-overrides.nix @@ -70,20 +70,8 @@ hself: hsuper: { tls = hsuper.tls_2_0_5; tls-session-manager = hsuper.tls-session-manager_0_0_5; - # for warp (and its transitive deps) - # we have a PR open https://github.com/yesodweb/wai/pull/958 - # unfortunately, because of breakage in http2, our fork has moved beyond what - # we can use in wire itself, hence the patch - # the version of warp is pinned in ./haskell-pins.nix - warp = hlib.addTestToolDepends - (hlib.appendPatches hsuper.warp [ - (fetchpatch { - url = "https://github.com/yesodweb/wai/commit/ef993a357822d9bc2a2040afcb656b31c378491c.patch"; - stripLen = 1; - sha256 = "sha256-rv/ujqyBmpsChQg2uS3/HUgQZCA3SzBiF8kUnZJN0xs="; - }) - ]) [ curl ]; - # end for warp + # warp requires curl in its testsuite + warp = hlib.addTestToolDepends hsuper.warp [ curl ]; # ----------------- # flags and patches From 2f2f13ebab1e96a2d537c55db5c238dc3a3def4d Mon Sep 17 00:00:00 2001 From: Magnus Viernickel Date: Wed, 19 Jun 2024 14:52:36 +0200 Subject: [PATCH 33/64] Revert "[chore] update warp" This reverts commit 0d874118cea62526fb1111b6861b21012f6897f5. --- .../src/HTTP2/Client/Manager/Internal.hs | 14 ++-- .../test/Test/HTTP2/Client/ManagerSpec.hs | 14 +--- .../src/Wire/API/Federation/Client.hs | 2 +- nix/haskell-pins.nix | 66 +++---------------- nix/manual-overrides.nix | 16 ++++- 5 files changed, 32 insertions(+), 80 deletions(-) diff --git a/libs/http2-manager/src/HTTP2/Client/Manager/Internal.hs b/libs/http2-manager/src/HTTP2/Client/Manager/Internal.hs index 5ec47c2fff0..4861a150a4a 100644 --- a/libs/http2-manager/src/HTTP2/Client/Manager/Internal.hs +++ b/libs/http2-manager/src/HTTP2/Client/Manager/Internal.hs @@ -15,7 +15,6 @@ import Control.Monad import Control.Monad.IO.Class import Data.ByteString import qualified Data.ByteString as BS -import qualified Data.ByteString.Char8 as C8 import Data.IORef import Data.Map import qualified Data.Map as Map @@ -292,9 +291,9 @@ startPersistentHTTP2Connection :: startPersistentHTTP2Connection ctx (tlsEnabled, hostname, port) cl removeTrailingDot tcpConnectTimeout sendReqMVar = do liveReqs <- newIORef mempty let clientConfig = - HTTP2.defaultClientConfig + HTTP2.ClientConfig { HTTP2.scheme = if tlsEnabled then "https" else "http", - HTTP2.authority = C8.unpack hostname, + HTTP2.authority = hostname, HTTP2.cacheLimit = cl } -- Sends error to requests which show up too late, i.e. after the @@ -334,7 +333,7 @@ startPersistentHTTP2Connection ctx (tlsEnabled, hostname, port) cl removeTrailin bracket connectTCPWithTimeout NS.close $ \sock -> do bracket (mkTransport sock transportConfig) cleanupTransport $ \transport -> bracket (allocHTTP2Config transport) HTTP2.freeSimpleConfig $ \http2Cfg -> do - let runAction = HTTP2.run clientConfig http2Cfg $ \sendReq _aux -> do + let runAction = HTTP2.run clientConfig http2Cfg $ \sendReq -> do handleRequests liveReqs sendReq -- Any request threads still hanging about after 'runAction' finishes -- are canceled with 'ConnectionAlreadyClosed'. @@ -452,9 +451,6 @@ allocHTTP2Config (SecureTransport ssl) = do error "openssl: SSL.read returned more bytes than asked for, this is probably a bug" | otherwise -> readData (acc <> chunk) (n - chunkLen) - let s = fromMaybe (error "http2-manager: SSL without socket") $ SSL.sslSocket ssl - mysa <- NS.getSocketName s - peersa <- NS.getPeerName s pure HTTP2.Config @@ -463,7 +459,5 @@ allocHTTP2Config (SecureTransport ssl) = do HTTP2.confSendAll = SSL.write ssl, HTTP2.confReadN = readData mempty, HTTP2.confPositionReadMaker = HTTP2.defaultPositionReadMaker, - HTTP2.confTimeoutManager = timmgr, - HTTP2.confMySockAddr = mysa, - HTTP2.confPeerSockAddr = peersa + HTTP2.confTimeoutManager = timmgr } diff --git a/libs/http2-manager/test/Test/HTTP2/Client/ManagerSpec.hs b/libs/http2-manager/test/Test/HTTP2/Client/ManagerSpec.hs index f3498187306..04593bf39ab 100644 --- a/libs/http2-manager/test/Test/HTTP2/Client/ManagerSpec.hs +++ b/libs/http2-manager/test/Test/HTTP2/Client/ManagerSpec.hs @@ -23,7 +23,7 @@ import qualified Data.ByteString.Lazy.Char8 as LBS import Data.IORef import Data.Map (Map) import qualified Data.Map as Map -import Data.Maybe (fromMaybe, isJust) +import Data.Maybe (isJust) import Data.Streaming.Network (bindPortTCP, bindRandomPortTCP) import Data.Unique import Foreign.Marshal.Alloc (mallocBytes) @@ -33,10 +33,8 @@ import HTTP2.Client.Manager.Internal import Network.HTTP.Types import qualified Network.HTTP2.Client as Client import qualified Network.HTTP2.Client as HTTP2 -import Network.HTTP2.Server (defaultServerConfig) import qualified Network.HTTP2.Server as Server import Network.Socket -import qualified Network.Socket as NS import qualified OpenSSL.Session as SSL import System.Random (randomRIO) import qualified System.TimeManager @@ -295,10 +293,6 @@ allocServerConfig (Right ssl) = do error "openssl: SSL.read returned more bytes than asked for, this is probably a bug" | otherwise -> readData (prevChunk <> chunk) (n - chunkLen) - - let s = fromMaybe (error "http2-manager: SSL without socket") $ SSL.sslSocket ssl - mysa <- NS.getSocketName s - peersa <- NS.getPeerName s pure Server.Config { Server.confWriteBuffer = buf, @@ -306,9 +300,7 @@ allocServerConfig (Right ssl) = do Server.confSendAll = SSL.write ssl, Server.confReadN = readData mempty, Server.confPositionReadMaker = Server.defaultPositionReadMaker, - Server.confTimeoutManager = timmgr, - Server.confMySockAddr = mysa, - Server.confPeerSockAddr = peersa + Server.confTimeoutManager = timmgr } testServerOnSocket :: Maybe SSL.SSLContext -> Socket -> IORef Int -> IORef (Map Unique (Async ())) -> IO () @@ -330,7 +322,7 @@ testServerOnSocket mCtx listenSock connsCounter conns = do cleanup cfg = do Server.freeSimpleConfig cfg `finally` (shutdownSSL `finally` close sock) thread <- async $ bracket (allocServerConfig serverCfgParam) cleanup $ \cfg -> do - Server.run defaultServerConfig cfg testServer `finally` modifyIORef conns (Map.delete connKey) + Server.run cfg testServer `finally` modifyIORef conns (Map.delete connKey) modifyIORef conns $ Map.insert connKey thread testServer :: Server.Request -> Server.Aux -> (Server.Response -> [Server.PushPromise] -> IO ()) -> IO () diff --git a/libs/wire-api-federation/src/Wire/API/Federation/Client.hs b/libs/wire-api-federation/src/Wire/API/Federation/Client.hs index 98f653e6083..2f6fcde3051 100644 --- a/libs/wire-api-federation/src/Wire/API/Federation/Client.hs +++ b/libs/wire-api-federation/src/Wire/API/Federation/Client.hs @@ -120,7 +120,7 @@ instance VersionedMonad Version (FederatorClient c) where liftCodensity :: Codensity IO a -> FederatorClient c a liftCodensity = FederatorClient . lift . lift . lift -headersFromTable :: HTTP2.TokenHeaderTable -> [HTTP.Header] +headersFromTable :: HTTP2.HeaderTable -> [HTTP.Header] headersFromTable (headerList, _) = flip map headerList $ first HTTP2.tokenKey -- This opens a new http2 connection. Using a http2-manager leads to this problem https://wearezeta.atlassian.net/browse/WPB-4787 diff --git a/nix/haskell-pins.nix b/nix/haskell-pins.nix index cc3694f7fd4..9b6b99d8195 100644 --- a/nix/haskell-pins.nix +++ b/nix/haskell-pins.nix @@ -258,30 +258,7 @@ let hash = "sha256-E35PVxi/4iJFfWts3td52KKZKQt4dj9KFP3SvWG77Cc="; }; }; - - # open PR https://github.com/yesodweb/wai/pull/958 for sending connection: close when closing connection - warp = { - packages.warp = "warp"; - src = pkgs.fetchFromGitHub { - owner = "yesodweb"; - repo = "wai"; - rev = "8b20c9db265a202a2c7ba2a9ec8786a1ee59957b"; - hash = "sha256-fKUSiRl38FKY1gFSmbksktoqoLfQrDxRRWEh4k+RRW4="; - }; - }; - - # this contains an important fix to the initialization of the window size - # and should be switched to upstream as soon as we can - http2 = { - src = pkgs.fetchFromGitHub { - owner = "kazu-yamamoto"; - repo = "http2"; - rev = "80921ad15fac05715ede7063d57585d4e7049f99"; - hash = "sha256-AQPZzx0SiIPbWG2AguGcDITTQLKW9OX1qxmiS+wrHN8="; - }; - }; }; - hackagePins = { # Major re-write upstream, we should get rid of this dependency rather than # adapt to upstream, this will go away when completing servantification. @@ -290,38 +267,16 @@ let sha256 = "sha256-DSMckKIeVE/buSMg8Mq+mUm1bYPYB7veA11Ns7vTBbc="; }; - # start pinned dependencies for http2 - http-semantics = { - version = "0.1.1"; - sha256 = "sha256-znxplxXjPWNrGR7//7e6HS9CaS1ID/aXUhRYfWakTWU="; - }; - - network-run = { - version = "0.3.0"; - sha256 = "sha256-FP2GZKwacC+TLLwEIVgKBtnKplYPf5xOIjDfvlbQV0o="; - }; - time-manager = { - version = "0.1.0"; - sha256 = "sha256-WRe9LZrOIPJVBFk0vMN2IMoxgP0a0psQCiCiOFWJc74="; - }; - auto-update = { - version = "0.2.0"; - sha256 = "sha256-d/0IDjaaCLz8tlx88z8Ew8ol9PrSRPVWaUwTbim70yE="; - }; - - network-control = { - version = "0.1.0"; - sha256 = "sha256-D6pKb6+0Pr08FnObGbXBVMv04ys3N731p7U+GYH1oEg="; + http2 = { + version = "4.1.4"; + sha256 = "sha256-r4Bu0vourKMkBO1cPeJVszSbAqHopmkv9EeTHcaTfuo="; }; - # end pinned dependencies for http2 - # pinned for warp - warp-tls = { - version = "3.4.5"; - sha256 = "sha256-3cDi/+n7wHfcWT/iFWAsGdLYXtKYXmvzolDt+ACJnaM="; + # warp is not compatible with + warp = { + version = "3.3.30"; + sha256 = "sha256-VrK27a2wFtezh9qabcXGe2tw9EwBmI8mKwmpCtXq9rc="; }; - # end pinned for warp - # PR: https://github.com/wireapp/wire-server/pull/4027 HsOpenSSL = { version = "0.11.7.7"; @@ -356,12 +311,11 @@ let gitPins; # AttrSet hackagePackages = lib.attrsets.mapAttrs - (pkg: args: + (pkg: { version, sha256 }: hself.callHackageDirect { - ver = args.version; - sha256 = args.sha256 or ""; - inherit pkg; + ver = version; + inherit pkg sha256; } { } ) diff --git a/nix/manual-overrides.nix b/nix/manual-overrides.nix index d2d6a1baef8..86a55d8754f 100644 --- a/nix/manual-overrides.nix +++ b/nix/manual-overrides.nix @@ -70,8 +70,20 @@ hself: hsuper: { tls = hsuper.tls_2_0_5; tls-session-manager = hsuper.tls-session-manager_0_0_5; - # warp requires curl in its testsuite - warp = hlib.addTestToolDepends hsuper.warp [ curl ]; + # for warp (and its transitive deps) + # we have a PR open https://github.com/yesodweb/wai/pull/958 + # unfortunately, because of breakage in http2, our fork has moved beyond what + # we can use in wire itself, hence the patch + # the version of warp is pinned in ./haskell-pins.nix + warp = hlib.addTestToolDepends + (hlib.appendPatches hsuper.warp [ + (fetchpatch { + url = "https://github.com/yesodweb/wai/commit/ef993a357822d9bc2a2040afcb656b31c378491c.patch"; + stripLen = 1; + sha256 = "sha256-rv/ujqyBmpsChQg2uS3/HUgQZCA3SzBiF8kUnZJN0xs="; + }) + ]) [ curl ]; + # end for warp # ----------------- # flags and patches From 8d690250b1a1a2617fcdbbc42c5dd499e10c72ed Mon Sep 17 00:00:00 2001 From: Mango The Fourth <40720523+MangoIV@users.noreply.github.com> Date: Wed, 19 Jun 2024 15:00:54 +0200 Subject: [PATCH 34/64] [fix] remove redundant MonadMonitor constraint in brig (#4095) --- services/brig/src/Brig/User/Search/Index.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/services/brig/src/Brig/User/Search/Index.hs b/services/brig/src/Brig/User/Search/Index.hs index a02cb3b192e..24be42ce4ed 100644 --- a/services/brig/src/Brig/User/Search/Index.hs +++ b/services/brig/src/Brig/User/Search/Index.hs @@ -173,12 +173,12 @@ withAdditionalESUrl action = do -------------------------------------------------------------------------------- -- Updates -reindex :: (MonadLogger m, MonadIndexIO m, C.MonadClient m, Prom.MonadMonitor IndexIO) => UserId -> m () +reindex :: (MonadLogger m, MonadIndexIO m, C.MonadClient m) => UserId -> m () reindex u = do ixu <- lookupIndexUser u updateIndex (maybe (IndexDeleteUser u) (IndexUpdateUser IndexUpdateIfNewerVersion) ixu) -updateIndex :: (MonadIndexIO m, Prom.MonadMonitor IndexIO) => IndexUpdate -> m () +updateIndex :: (MonadIndexIO m) => IndexUpdate -> m () updateIndex (IndexUpdateUser updateType iu) = liftIndexIO $ do Prom.incCounter indexUpdateCounter info $ From 10f7a65ba73f5b7964ece3f2871859982605d5ae Mon Sep 17 00:00:00 2001 From: Jan Schumacher <155645800+jschumacher-wire@users.noreply.github.com> Date: Thu, 20 Jun 2024 11:49:04 +0200 Subject: [PATCH 35/64] moving docker images from Julia's private repo to quay (#4099) --- deploy/dockerephemeral/docker-compose.yaml | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/deploy/dockerephemeral/docker-compose.yaml b/deploy/dockerephemeral/docker-compose.yaml index 38db77dd5a0..7b669d8a0f8 100644 --- a/deploy/dockerephemeral/docker-compose.yaml +++ b/deploy/dockerephemeral/docker-compose.yaml @@ -21,7 +21,7 @@ services: fake_dynamodb: container_name: demo_wire_dynamodb # image: cnadiminti/dynamodb-local:2018-04-11 - image: julialongtin/dynamodb_local:0.0.9 + image: quay.io/wire/dynamodb_local:0.0.9 ulimits: nofile: soft: 65536 @@ -45,7 +45,7 @@ services: fake_localstack: container_name: demo_wire_localstack # image: localstack/localstack:0.8.0 # NB: this is younger than 0.8.6! - image: julialongtin/localstack:0.0.9 + image: quay.io/wire/localstack:0.0.9 ports: - 127.0.0.1:4569:4579 # ses # needed for local integration tests - 127.0.0.1:4575:4575 # sns @@ -209,7 +209,7 @@ services: build: context: . dockerfile_inline: | - FROM julialongtin/elasticsearch:0.0.9-amd64 + FROM quay.io/wire/elasticsearch:0.0.9-amd64 RUN /usr/share/elasticsearch/bin/elasticsearch-plugin install x-pack -b # this seems to be necessary to run X-Pack on Alpine (https://discuss.elastic.co/t/elasticsearch-failing-to-start-due-to-x-pack/85125/7) RUN rm -rf /usr/share/elasticsearch/plugins/x-pack/platform/linux-x86_64 @@ -238,7 +238,7 @@ services: cassandra: container_name: demo_wire_cassandra #image: cassandra:3.11.2 - image: julialongtin/cassandra:0.0.9 + image: quay.io/wire/cassandra:0.0.9 ports: - "127.0.0.1:9042:9042" ulimits: From 5b1e57cc3882b6923839c8886dbbb60a82776adc Mon Sep 17 00:00:00 2001 From: Stefan Matting Date: Thu, 20 Jun 2024 18:23:11 +0200 Subject: [PATCH 36/64] WPB 2690 (#4098) Co-authored-by: jschaul --- changelog.d/2-features/WPB-2690-coturn-drain | 1 + changelog.d/3-bug-fixes/tmp-pid | 1 + charts/coturn/Chart.yaml | 2 +- .../templates/configmap-coturn-conf-template.yaml | 2 ++ charts/coturn/templates/statefulset.yaml | 4 +++- charts/coturn/values.yaml | 14 +++++++------- 6 files changed, 15 insertions(+), 9 deletions(-) create mode 100644 changelog.d/2-features/WPB-2690-coturn-drain create mode 100644 changelog.d/3-bug-fixes/tmp-pid diff --git a/changelog.d/2-features/WPB-2690-coturn-drain b/changelog.d/2-features/WPB-2690-coturn-drain new file mode 100644 index 00000000000..f805466c3c5 --- /dev/null +++ b/changelog.d/2-features/WPB-2690-coturn-drain @@ -0,0 +1 @@ +charts/coturn: support putting coturn into 'drain' mode when terminating pods, denying new incoming client connections. This speeds up graceful coturn restarts significantly. diff --git a/changelog.d/3-bug-fixes/tmp-pid b/changelog.d/3-bug-fixes/tmp-pid new file mode 100644 index 00000000000..f3be4e444a0 --- /dev/null +++ b/changelog.d/3-bug-fixes/tmp-pid @@ -0,0 +1 @@ +charts/coturn: use allowed dir to write PID file diff --git a/charts/coturn/Chart.yaml b/charts/coturn/Chart.yaml index a5b11da7b38..6a8abef6c9d 100644 --- a/charts/coturn/Chart.yaml +++ b/charts/coturn/Chart.yaml @@ -11,4 +11,4 @@ version: 0.0.42 # This is the version number of the application being deployed. This version number should be # incremented each time you make changes to the application. Versions are not expected to # follow Semantic Versioning. They should reflect the version the application is using. -appVersion: 4.6.2-federation-wireapp.12 +appVersion: 4.6.2-federation-wireapp.16 diff --git a/charts/coturn/templates/configmap-coturn-conf-template.yaml b/charts/coturn/templates/configmap-coturn-conf-template.yaml index b020ee5080d..73bea8326a9 100644 --- a/charts/coturn/templates/configmap-coturn-conf-template.yaml +++ b/charts/coturn/templates/configmap-coturn-conf-template.yaml @@ -26,6 +26,8 @@ data: ## don't turn on coturn's cli. no-cli + pidfile="/var/tmp/turnserver.pid" + ## turn, stun. listening-ip={{ default "__COTURN_EXT_IP__" .Values.coturnTurnListenIP }} listening-port={{ .Values.coturnTurnListenPort }} diff --git a/charts/coturn/templates/statefulset.yaml b/charts/coturn/templates/statefulset.yaml index d2b9c7ef9b7..e8f75fa0762 100644 --- a/charts/coturn/templates/statefulset.yaml +++ b/charts/coturn/templates/statefulset.yaml @@ -127,6 +127,8 @@ spec: readOnly: true {{- end }} command: + - /usr/bin/dumb-init + - -- - /bin/sh - -c - | @@ -142,7 +144,7 @@ spec: command: - /bin/sh - -c - - exec /usr/local/bin/pre-stop-hook "$POD_IP" {{ .Values.coturnMetricsListenPort }} + - "exec /usr/local/bin/pre-stop-hook \"$POD_IP\" {{ .Values.coturnMetricsListenPort }}" {{- end }} ports: diff --git a/charts/coturn/values.yaml b/charts/coturn/values.yaml index 10279a6aa3e..fbcc5de5b5b 100644 --- a/charts/coturn/values.yaml +++ b/charts/coturn/values.yaml @@ -93,17 +93,17 @@ metrics: serviceMonitor: enabled: false -# This chart optionally supports waiting for traffic to drain from coturn -# before pods are terminated. Warning: coturn does not have any way to steer -# incoming client traffic away from itself on its own, so this functionality -# relies on external traffic management (e.g. service discovery for active coturn -# instances) to prevent clients from sending new requests to pods which are in a -# terminating state. +# This chart supports waiting for traffic to drain from coturn +# before pods are actually terminated. Once in 'drain' mode, no new connections +# are accepted, but old ones are kept alive. +# If you have 2 or more replicas, it's recommended to set this to true, +# and if you only have one coturn replica you may want this to be false, as +# otherwise while the pod restarts, no new calls can be established. coturnGracefulTermination: false # Grace period for terminating coturn pods, after which they will be forcibly # terminated. This setting is only effective when coturnGracefulTermination is # set to true. -coturnGracePeriodSeconds: 86400 # one day +coturnGracePeriodSeconds: 43200 # 12 hours livenessProbe: timeoutSeconds: 5 From 5b2df31c8eb8432f3a2d2b92c9c416eb9ff538c1 Mon Sep 17 00:00:00 2001 From: Leif Battermann Date: Fri, 21 Jun 2024 13:16:07 +0200 Subject: [PATCH 37/64] WPB-9677 fix stern endpoint `/i/users/meta-info` (#4101) --- changelog.d/3-bug-fixes/WBP-9677 | 1 + tools/stern/src/Stern/API.hs | 16 +++++--- tools/stern/src/Stern/API/Routes.hs | 2 +- tools/stern/src/Stern/Intra.hs | 57 ++++++++++++++++++++++------- 4 files changed, 57 insertions(+), 19 deletions(-) create mode 100644 changelog.d/3-bug-fixes/WBP-9677 diff --git a/changelog.d/3-bug-fixes/WBP-9677 b/changelog.d/3-bug-fixes/WBP-9677 new file mode 100644 index 00000000000..d769d8c7458 --- /dev/null +++ b/changelog.d/3-bug-fixes/WBP-9677 @@ -0,0 +1 @@ +fixed stern endpoint `/i/users/meta-info` diff --git a/tools/stern/src/Stern/API.hs b/tools/stern/src/Stern/API.hs index 27e737e9623..8783812b365 100644 --- a/tools/stern/src/Stern/API.hs +++ b/tools/stern/src/Stern/API.hs @@ -426,24 +426,30 @@ getConsentLog e = do getUserData :: UserId -> Maybe Int -> Maybe Int -> Handler UserMetaInfo getUserData uid mMaxConvs mMaxNotifs = do + -- brig account <- Intra.getUserProfiles (Left [uid]) >>= noSuchUser . listToMaybe conns <- Intra.getUserConnections uid - convs <- Intra.getUserConversations uid (fromMaybe 1 mMaxConvs) clts <- Intra.getUserClients uid + cookies <- Intra.getUserCookies uid + properties <- Intra.getUserProperties uid + + -- galley + convs <- Intra.getUserConversations uid (fromMaybe 1 mMaxConvs) + + -- gundeck notfs <- - ( Intra.getUserNotifications uid (fromMaybe 10 mMaxNotifs) + ( Intra.getUserNotifications uid (fromMaybe 100 mMaxNotifs) <&> toJSON @[QueuedNotification] ) `catchE` (pure . String . T.pack . show) + + -- galeb consent <- (Intra.getUserConsentValue uid <&> toJSON @ConsentValue) `catchE` (pure . String . T.pack . show) consentLog <- (Intra.getUserConsentLog uid <&> toJSON @ConsentLog) `catchE` (pure . String . T.pack . show) - cookies <- Intra.getUserCookies uid - properties <- Intra.getUserProperties uid - -- Get all info from Marketo too let em = userEmail $ accountUser account marketo <- do let noEmail = MarketoResult $ KeyMap.singleton "results" emptyArray diff --git a/tools/stern/src/Stern/API/Routes.hs b/tools/stern/src/Stern/API/Routes.hs index 35dee177d32..feba0168cd9 100644 --- a/tools/stern/src/Stern/API/Routes.hs +++ b/tools/stern/src/Stern/API/Routes.hs @@ -399,7 +399,7 @@ type SternAPI = :> "meta-info" :> QueryParam' [Required, Strict, Description "A valid UserId"] "id" UserId :> QueryParam' [Optional, Strict, Description "Max number of conversation (default 1)"] "max_conversations" Int - :> QueryParam' [Optional, Strict, Description "Max number of notifications (default 10)"] "max_notifications" Int + :> QueryParam' [Optional, Strict, Description "Max number of notifications (min 100, default 100)"] "max_notifications" Int :> Post '[JSON] UserMetaInfo ) :<|> Named diff --git a/tools/stern/src/Stern/Intra.hs b/tools/stern/src/Stern/Intra.hs index ed283ad9e6f..b0e05f92885 100644 --- a/tools/stern/src/Stern/Intra.hs +++ b/tools/stern/src/Stern/Intra.hs @@ -778,9 +778,17 @@ getMarketoResult email = do ) -- 404 is acceptable when marketo doesn't know about this user, return an empty result case statusCode r of - 200 -> parseResponse (mkError status502 "bad-upstream") r + 200 -> do + let responseOrError = responseJsonEither r + case responseOrError of + Left e -> do + Log.err $ msg ("Error parsing marketo response: " ++ e) + throwE (mkError status502 "bad-upstream" (pack e)) + Right res -> pure res 404 -> pure noEmail - _ -> throwE (mkError status502 "bad-upstream" "") + otherStatus -> do + Log.err $ msg ("Unexpected status code from marketo: " ++ show otherStatus) + throwE (mkError status502 "bad-upstream" "") where noEmail = MarketoResult $ KeyMap.singleton "results" emptyArray @@ -860,7 +868,12 @@ getUserClients uid = do . expect2xx ) info $ msg ("Response" ++ show r) - parseResponse (mkError status502 "bad-upstream") r + let resultOrError :: Either String [Versioned 'V5 Client] = responseJsonEither r + case resultOrError of + Left e -> do + Log.err $ msg ("Error parsing client response: " ++ e) + pure [] + Right res -> pure $ fmap unVersioned res getUserProperties :: UserId -> Handler UserProperties getUserProperties uid = do @@ -903,13 +916,17 @@ getUserNotifications uid maxNotifs = do where fetchAll :: [QueuedNotification] -> Maybe NotificationId -> Int -> ExceptT Error App [QueuedNotification] fetchAll xs start remaining = do - userNotificationList <- fetchBatch start (min 100 remaining) - let batch = view queuedNotifications userNotificationList - remaining' = remaining - length batch - if (not . null) batch && view queuedHasMore userNotificationList && remaining' > 0 - then fetchAll (batch ++ xs) (Just . view queuedNotificationId $ last batch) remaining' - else pure (batch ++ xs) - fetchBatch :: Maybe NotificationId -> Int -> Handler QueuedNotificationList + -- size must be within 100-1000 + mUserNotificationList <- fetchBatch start (max 100 (min 1000 remaining)) + case mUserNotificationList of + Nothing -> pure xs + Just userNotificationList -> do + let batch = view queuedNotifications userNotificationList + remaining' = remaining - length batch + if (not . null) batch && view queuedHasMore userNotificationList && remaining' > 0 + then fetchAll (batch ++ xs) (Just . view queuedNotificationId $ last batch) remaining' + else pure (batch ++ xs) + fetchBatch :: Maybe NotificationId -> Int -> Handler (Maybe QueuedNotificationList) fetchBatch start batchSize = do baseReq <- view gundeck r <- @@ -927,9 +944,23 @@ getUserNotifications uid maxNotifs = do -- 404 is an acceptable response, in case, for some reason, -- "start" is not found we still return a QueuedNotificationList case statusCode r of - 200 -> parseResponse (mkError status502 "bad-upstream") r - 404 -> parseResponse (mkError status502 "bad-upstream") r - _ -> throwE (mkError status502 "bad-upstream" "") + 200 -> do + let responseOrError = responseJsonEither r + case responseOrError of + Left e -> do + Log.err $ msg ("Error parsing notification response: " ++ e) + pure Nothing + Right res -> pure $ Just res + 404 -> do + let resultOrError = responseJsonEither r + case resultOrError of + Left e -> do + Log.err $ msg ("Error parsing notification response: " ++ e) + pure Nothing + Right res -> pure $ Just res + otherStatus -> do + Log.err $ msg ("Unexpected status code from gundeck: " ++ show otherStatus) + pure Nothing getSsoDomainRedirect :: Text -> Handler (Maybe CustomBackend) getSsoDomainRedirect domain = do From e01888a9b93be18a7a9ab4d620171d2eee78e954 Mon Sep 17 00:00:00 2001 From: Paolo Capriotti Date: Fri, 21 Jun 2024 13:59:19 +0200 Subject: [PATCH 38/64] RabbitMQ TLS (#4094) * Generate rabbitmq certificates * Configure TLS for rabbitmq in dockerephemeral * Implement rabbit tls connection * Refactor rabbitmq connection opt * Implement insecureSkipVerifyTls * Access rabbitmq admin interface via TLS * Update nix packages * Configure rabbitmq TLS in helm_vars * Enable plain-text rabbitmq on the local test setup We can't disable it because it is needed by federation-v0. --- changelog.d/2-features/rabbit-tls | 1 + .../templates/configmap.yaml | 13 ++- .../templates/deployment.yaml | 9 ++ charts/background-worker/values.yaml | 6 ++ charts/brig/templates/configmap.yaml | 12 ++- charts/brig/templates/deployment.yaml | 9 ++ .../templates/tests/brig-integration.yaml | 5 + charts/brig/values.yaml | 5 + charts/galley/templates/configmap.yaml | 12 ++- charts/galley/templates/deployment.yaml | 9 ++ .../templates/tests/galley-integration.yaml | 5 + charts/galley/values.yaml | 5 + .../templates/integration-integration.yaml | 15 +++ deploy/dockerephemeral/docker-compose.yaml | 12 ++- deploy/dockerephemeral/init_vhosts.sh | 16 +-- .../rabbitmq-config/certificates/ca-key.pem | 28 +++++ .../rabbitmq-config/certificates/ca.pem | 19 ++++ .../rabbitmq-config/certificates/cert.pem | 20 ++++ .../rabbitmq-config/certificates/key.pem | 28 +++++ .../rabbitmq-config/rabbitmq.conf | 14 +++ .../src/developer/reference/config-options.md | 31 +++++- hack/bin/gen-certs.sh | 6 ++ hack/helm_vars/certs/values.yaml.gotmpl | 55 ++++++++++ hack/helm_vars/rabbitmq/values.yaml.gotmpl | 17 +++ hack/helm_vars/wire-server/values.yaml.gotmpl | 26 +++++ .../integration-dynamic-backends-vhosts.sh | 3 +- integration/test/Testlib/ResourcePool.hs | 3 +- libs/extended/default.nix | 12 +++ libs/extended/extended.cabal | 6 ++ libs/extended/src/Network/AMQP/Extended.hs | 102 ++++++++++++++++-- .../background-worker.integration.yaml | 9 +- .../src/Wire/BackendNotificationPusher.hs | 2 +- .../test/resources/rabbitmq-ca.pem | 1 + services/brig/brig.integration.yaml | 5 +- services/brig/test/resources/rabbitmq-ca.pem | 1 + services/galley/galley.integration.yaml | 5 +- .../galley/test/resources/rabbitmq-ca.pem | 1 + 37 files changed, 496 insertions(+), 32 deletions(-) create mode 100644 changelog.d/2-features/rabbit-tls create mode 100644 deploy/dockerephemeral/rabbitmq-config/certificates/ca-key.pem create mode 100644 deploy/dockerephemeral/rabbitmq-config/certificates/ca.pem create mode 100644 deploy/dockerephemeral/rabbitmq-config/certificates/cert.pem create mode 100644 deploy/dockerephemeral/rabbitmq-config/certificates/key.pem create mode 100644 deploy/dockerephemeral/rabbitmq-config/rabbitmq.conf create mode 120000 services/background-worker/test/resources/rabbitmq-ca.pem create mode 120000 services/brig/test/resources/rabbitmq-ca.pem create mode 120000 services/galley/test/resources/rabbitmq-ca.pem diff --git a/changelog.d/2-features/rabbit-tls b/changelog.d/2-features/rabbit-tls new file mode 100644 index 00000000000..21114d011dd --- /dev/null +++ b/changelog.d/2-features/rabbit-tls @@ -0,0 +1 @@ +Support connecting to RabbitMQ over TLS. See "Configure RabbitMQ" section in the documentation for details. diff --git a/charts/background-worker/templates/configmap.yaml b/charts/background-worker/templates/configmap.yaml index 1a03ad0d5e4..fea77ab59d5 100644 --- a/charts/background-worker/templates/configmap.yaml +++ b/charts/background-worker/templates/configmap.yaml @@ -21,8 +21,19 @@ data: host: federator port: 8080 + {{- with .rabbitmq }} rabbitmq: -{{toYaml .rabbitmq | indent 6 }} + host: {{ .host }} + port: {{ .port }} + vHost: {{ .vHost }} + adminPort: {{ .adminPort }} + enableTls: {{ .enableTls }} + insecureSkipVerifyTls: {{ .insecureSkipVerifyTls }} + {{- if .tlsCaSecretRef }} + caCert: /etc/wire/background-worker/rabbitmq-ca/{{ .tlsCaSecretRef.key }} + {{- end }} + {{- end }} + backendNotificationPusher: {{toYaml .backendNotificationPusher | indent 6 }} {{- end }} diff --git a/charts/background-worker/templates/deployment.yaml b/charts/background-worker/templates/deployment.yaml index 2f556f6fc5d..bbc0b6f71f4 100644 --- a/charts/background-worker/templates/deployment.yaml +++ b/charts/background-worker/templates/deployment.yaml @@ -36,6 +36,11 @@ spec: - name: "background-worker-secrets" secret: secretName: "background-worker" + {{- if .Values.config.rabbitmq.tlsCaSecretRef }} + - name: "rabbitmq-ca" + secret: + secretName: {{ .Values.config.rabbitmq.tlsCaSecretRef.name }} + {{- end }} containers: - name: background-worker image: "{{ .Values.image.repository }}:{{ .Values.image.tag }}" @@ -47,6 +52,10 @@ spec: volumeMounts: - name: "background-worker-config" mountPath: "/etc/wire/background-worker/conf" + {{- if .Values.config.rabbitmq.tlsCaSecretRef }} + - name: "rabbitmq-ca" + mountPath: "/etc/wire/background-worker/rabbitmq-ca/" + {{- end }} env: - name: RABBITMQ_USERNAME valueFrom: diff --git a/charts/background-worker/values.yaml b/charts/background-worker/values.yaml index a7a552a4536..e38cd9c8225 100644 --- a/charts/background-worker/values.yaml +++ b/charts/background-worker/values.yaml @@ -23,6 +23,12 @@ config: port: 5672 vHost: / adminPort: 15672 + enableTls: false + insecureSkipVerifyTls: false + # tlsCaSecretRef: + # name: + # key: + backendNotificationPusher: pushBackoffMinWait: 10000 # in microseconds, so 10ms pushBackoffMaxWait: 300000000 # microseconds, so 300s diff --git a/charts/brig/templates/configmap.yaml b/charts/brig/templates/configmap.yaml index 8e002aa35a7..bf7881db81c 100644 --- a/charts/brig/templates/configmap.yaml +++ b/charts/brig/templates/configmap.yaml @@ -80,8 +80,18 @@ data: federatorInternal: host: federator port: 8080 + + {{- with .rabbitmq }} rabbitmq: -{{ toYaml .rabbitmq | indent 6}} + host: {{ .host }} + port: {{ .port }} + vHost: {{ .vHost }} + enableTls: {{ .enableTls }} + insecureSkipVerifyTls: {{ .insecureSkipVerifyTls }} + {{- if .tlsCaSecretRef }} + caCert: /etc/wire/brig/rabbitmq-ca/{{ .tlsCaSecretRef.key }} + {{- end }} + {{- end }} {{- end }} {{- with .aws }} diff --git a/charts/brig/templates/deployment.yaml b/charts/brig/templates/deployment.yaml index dea3c0dacba..cff8bffd9bb 100644 --- a/charts/brig/templates/deployment.yaml +++ b/charts/brig/templates/deployment.yaml @@ -57,6 +57,11 @@ spec: secret: secretName: {{ include "additionalElasticsearchTlsSecretName" .Values.config }} {{- end }} + {{- if .Values.config.rabbitmq.tlsCaSecretRef }} + - name: "rabbitmq-ca" + secret: + secretName: {{ .Values.config.rabbitmq.tlsCaSecretRef.name }} + {{- end }} containers: - name: brig @@ -87,6 +92,10 @@ spec: - name: "additional-elasticsearch-ca" mountPath: "/etc/wire/brig/additional-elasticsearch-ca/" {{- end }} + {{- if .Values.config.rabbitmq.tlsCaSecretRef }} + - name: "rabbitmq-ca" + mountPath: "/etc/wire/brig/rabbitmq-ca/" + {{- end }} env: - name: LOG_LEVEL value: {{ .Values.config.logLevel }} diff --git a/charts/brig/templates/tests/brig-integration.yaml b/charts/brig/templates/tests/brig-integration.yaml index 62bea731895..2acf25d6fbc 100644 --- a/charts/brig/templates/tests/brig-integration.yaml +++ b/charts/brig/templates/tests/brig-integration.yaml @@ -54,6 +54,9 @@ spec: secret: secretName: {{ (include "tlsSecretRef" .Values.config | fromYaml).name }} {{- end}} + - name: "rabbitmq-ca" + secret: + secretName: {{ .Values.config.rabbitmq.tlsCaSecretRef.name }} containers: - name: integration image: "{{ .Values.image.repository }}-integration:{{ .Values.image.tag }}" @@ -119,6 +122,8 @@ spec: - name: "brig-cassandra" mountPath: "/etc/wire/brig/cassandra" {{- end }} + - name: "rabbitmq-ca" + mountPath: "/etc/wire/brig/rabbitmq-ca/" env: # these dummy values are necessary for Amazonka's "Discover" diff --git a/charts/brig/values.yaml b/charts/brig/values.yaml index e11aa931a5a..7dcedbce2dc 100644 --- a/charts/brig/values.yaml +++ b/charts/brig/values.yaml @@ -69,6 +69,11 @@ config: host: rabbitmq port: 5672 vHost: / + enableTls: false + insecureSkipVerifyTls: false + # tlsCaSecretRef: + # name: + # key: emailSMS: general: templateBranding: diff --git a/charts/galley/templates/configmap.yaml b/charts/galley/templates/configmap.yaml index 1043cc17416..ea0cd15354c 100644 --- a/charts/galley/templates/configmap.yaml +++ b/charts/galley/templates/configmap.yaml @@ -41,8 +41,18 @@ data: federator: host: federator port: 8080 + + {{- with .rabbitmq }} rabbitmq: -{{ toYaml .rabbitmq | indent 6}} + host: {{ .host }} + port: {{ .port }} + vHost: {{ .vHost }} + enableTls: {{ .enableTls }} + insecureSkipVerifyTls: {{ .insecureSkipVerifyTls }} + {{- if .tlsCaSecretRef }} + caCert: /etc/wire/galley/rabbitmq-ca/{{ .tlsCaSecretRef.key }} + {{- end }} + {{- end }} {{- end }} {{- if (.journal) }} diff --git a/charts/galley/templates/deployment.yaml b/charts/galley/templates/deployment.yaml index df9eee0c206..ebfb5582abd 100644 --- a/charts/galley/templates/deployment.yaml +++ b/charts/galley/templates/deployment.yaml @@ -41,6 +41,11 @@ spec: secret: secretName: {{ (include "tlsSecretRef" .Values.config | fromYaml).name }} {{- end }} + {{- if .Values.config.rabbitmq.tlsCaSecretRef }} + - name: "rabbitmq-ca" + secret: + secretName: {{ .Values.config.rabbitmq.tlsCaSecretRef.name }} + {{- end }} containers: - name: galley image: "{{ .Values.image.repository }}:{{ .Values.image.tag }}" @@ -58,6 +63,10 @@ spec: - name: "galley-cassandra" mountPath: "/etc/wire/galley/cassandra" {{- end }} + {{- if .Values.config.rabbitmq.tlsCaSecretRef }} + - name: "rabbitmq-ca" + mountPath: "/etc/wire/galley/rabbitmq-ca/" + {{- end }} env: {{- if hasKey .Values.secrets "awsKeyId" }} - name: AWS_ACCESS_KEY_ID diff --git a/charts/galley/templates/tests/galley-integration.yaml b/charts/galley/templates/tests/galley-integration.yaml index 1fdd9e206ac..879af2e5225 100644 --- a/charts/galley/templates/tests/galley-integration.yaml +++ b/charts/galley/templates/tests/galley-integration.yaml @@ -45,6 +45,9 @@ spec: secret: secretName: {{ (include "tlsSecretRef" .Values.config | fromYaml).name }} {{- end }} + - name: "rabbitmq-ca" + secret: + secretName: {{ .Values.config.rabbitmq.tlsCaSecretRef.name }} containers: - name: integration image: "{{ .Values.image.repository }}-integration:{{ .Values.image.tag }}" @@ -93,6 +96,8 @@ spec: - name: "galley-cassandra" mountPath: "/etc/wire/galley/cassandra" {{- end }} + - name: "rabbitmq-ca" + mountPath: "/etc/wire/galley/rabbitmq-ca/" env: # these dummy values are necessary for Amazonka's "Discover" - name: AWS_ACCESS_KEY_ID diff --git a/charts/galley/values.yaml b/charts/galley/values.yaml index 8239f4019e8..1d170d39883 100644 --- a/charts/galley/values.yaml +++ b/charts/galley/values.yaml @@ -35,6 +35,11 @@ config: host: rabbitmq port: 5672 vHost: / + enableTls: false + insecureSkipVerifyTls: false + # tlsCaSecretRef: + # name: + # key: settings: httpPoolSize: 128 maxTeamSize: 10000 diff --git a/charts/integration/templates/integration-integration.yaml b/charts/integration/templates/integration-integration.yaml index 324f6ebe609..56dbf2bf8e7 100644 --- a/charts/integration/templates/integration-integration.yaml +++ b/charts/integration/templates/integration-integration.yaml @@ -84,6 +84,10 @@ spec: secret: secretName: {{ .Values.config.redis.tlsCaSecretRef.name }} + - name: rabbitmq-ca + secret: + secretName: {{ .Values.config.rabbitmq.tlsCaSecretRef.name }} + {{- if eq (include "useCassandraTLS" .Values.config) "true" }} - name: integration-cassandra secret: @@ -105,6 +109,8 @@ spec: - name: "integration-cassandra" mountPath: "/certs/cassandra" {{- end }} + - name: rabbitmq-ca + mountPath: /certs/rabbitmq-ca env: - name: INTEGRATION_DYNAMIC_BACKENDS_POOLSIZE value: "{{ .Values.config.dynamicBackendsPoolsize }}" @@ -246,6 +252,15 @@ spec: - name: redis-ca mountPath: /etc/wire/gundeck/redis-ca + - name: rabbitmq-ca + mountPath: /etc/wire/brig/rabbitmq-ca + + - name: rabbitmq-ca + mountPath: /etc/wire/galley/rabbitmq-ca + + - name: rabbitmq-ca + mountPath: /etc/wire/background-worker/rabbitmq-ca + {{- if eq (include "useCassandraTLS" .Values.config) "true" }} - name: "integration-cassandra" mountPath: "/certs" diff --git a/deploy/dockerephemeral/docker-compose.yaml b/deploy/dockerephemeral/docker-compose.yaml index 7b669d8a0f8..58ff49b4c30 100644 --- a/deploy/dockerephemeral/docker-compose.yaml +++ b/deploy/dockerephemeral/docker-compose.yaml @@ -264,11 +264,14 @@ services: container_name: rabbitmq image: rabbitmq:3.11-management-alpine environment: - - RABBITMQ_DEFAULT_USER=${RABBITMQ_USERNAME} - - RABBITMQ_DEFAULT_PASS=${RABBITMQ_PASSWORD} + - RABBITMQ_USERNAME + - RABBITMQ_PASSWORD ports: - - '127.0.0.1:5672:5672' - - '127.0.0.1:15672:15672' + - '127.0.0.1:5671:5671' + - '127.0.0.1:15671:15671' + volumes: + - ./rabbitmq-config/rabbitmq.conf:/etc/rabbitmq/conf.d/20-wire.conf + - ./rabbitmq-config/certificates:/etc/rabbitmq/certificates networks: - demo_wire @@ -282,6 +285,7 @@ services: entrypoint: /scripts/init_vhosts.sh volumes: - ./:/scripts + - ./rabbitmq-config/certificates/ca.pem:/etc/rabbitmq-ca.pem networks: - demo_wire diff --git a/deploy/dockerephemeral/init_vhosts.sh b/deploy/dockerephemeral/init_vhosts.sh index 9323e6f5a43..688d635e0a5 100755 --- a/deploy/dockerephemeral/init_vhosts.sh +++ b/deploy/dockerephemeral/init_vhosts.sh @@ -4,13 +4,17 @@ exec_until_ready() { until $1; do echo 'service not ready yet'; sleep 1; done } +create_vhost() { + exec_until_ready "curl --cacert /etc/rabbitmq-ca.pem -u $RABBITMQ_USERNAME:$RABBITMQ_PASSWORD -X PUT https://rabbitmq:15671/api/vhosts/$1" +} + echo 'Creating RabbitMQ resources' -exec_until_ready "curl -u $RABBITMQ_USERNAME:$RABBITMQ_PASSWORD -X PUT http://rabbitmq:15672/api/vhosts/backendA" -exec_until_ready "curl -u $RABBITMQ_USERNAME:$RABBITMQ_PASSWORD -X PUT http://rabbitmq:15672/api/vhosts/backendB" -exec_until_ready "curl -u $RABBITMQ_USERNAME:$RABBITMQ_PASSWORD -X PUT http://rabbitmq:15672/api/vhosts/d1.example.com" -exec_until_ready "curl -u $RABBITMQ_USERNAME:$RABBITMQ_PASSWORD -X PUT http://rabbitmq:15672/api/vhosts/d2.example.com" -exec_until_ready "curl -u $RABBITMQ_USERNAME:$RABBITMQ_PASSWORD -X PUT http://rabbitmq:15672/api/vhosts/d3.example.com" -exec_until_ready "curl -u $RABBITMQ_USERNAME:$RABBITMQ_PASSWORD -X PUT http://rabbitmq:15672/api/vhosts/federation-v0" +create_vhost backendA +create_vhost backendB +create_vhost d1.example.com +create_vhost d2.example.com +create_vhost d3.example.com +create_vhost federation-v0 echo 'RabbitMQ resources created successfully!' diff --git a/deploy/dockerephemeral/rabbitmq-config/certificates/ca-key.pem b/deploy/dockerephemeral/rabbitmq-config/certificates/ca-key.pem new file mode 100644 index 00000000000..406f6d9ed97 --- /dev/null +++ b/deploy/dockerephemeral/rabbitmq-config/certificates/ca-key.pem @@ -0,0 +1,28 @@ +-----BEGIN PRIVATE KEY----- +MIIEvAIBADANBgkqhkiG9w0BAQEFAASCBKYwggSiAgEAAoIBAQC/vE2Cea18UZ1J +J0a3IkIoXl2JPSJp7y/bPXsN6sk44F5Dv9mt5hxVERyCQSMiuM6dXfzkRcMAZ7dx +5nQ7GpSEJksqe4h+WFHWDQjaoxrOYVg9UAa6q0rq5h+uHZEpBWwJWNlwRgzyf5zf +IZnjttVD2mu4Gp2xRqtNkEbAOgMJp7ijb76foKsGLFrxJNA3khNjsnDlwRuoffVS +LafF0CA7cW2FYxjwKM/IymCaRVUS18IftCtm3KCl5ou+1aD0/rMsLMKEY1HYCyGo +ZSOnvd5xhRPj6upk3MpWUUyULSkpkQtVPy+RZKUNXb3CGVNJz3UgvMwNXKpW9FdG +Suze9HxdAgMBAAECggEAEU8SKZA10tOaAQue/P4GaOyJQdAXYObV3tNAXkjux3Ks +hS3hnIBPLc1wpxWdnWR/n9c8nZg/+rO3l3xiy8nM1IKR0JD8Xnjh/RKKKmqvtdKL +NmXDZcCm775nPRRa5rrK6QEbXWEFiYgZr6Rckcu57vkzNkM42dMeYyR+Lpujazs6 +Um3Z7rPXevX/gVr9XHjxJ5bX9WYB7sJfZTHLqkO7VGwrXf7HGrtT1ES+iXqjGLpH +5Sg55V5XJfxsqhq+TQgEnorzp8+LEXms2HYTP3G47wP51IWbHa54BUBwkwhiNYV7 +os71j5mrZbUnJ/2KvQPMjiF7uHKlKYjxXiAoj9wRZQKBgQD4e4RuFVaLtF1+khNI +uEgmY4AfakeCB9D2Do1/fhLDTT6EdAxFeSx62VyY3wTG5Pi8DyrFIUNbIYbO8vRx +u8XpzCPxn9TnPnLZ9BRf1+GrCuyQWaFZOnnfAovk3KK4D3vWD9Yn38aTYpTd+3Hg +AEIzd7Bd4dozKtKW7+wI9uOm0wKBgQDFiUih6D0TYrS4T+cM5KhI+ErqTTiFpZ/L +BvA2hyRZTbP+erII9A+IqRNlwidGc1UF4xGu9Ei5QBVfFFbch6C1IRwIoog0hqsH +7s47VIcDuoASq52DHoUABbw9SrfsLjAZz5bLNPmvrEorwIImHNwDG/yOgpT8z7PV +z4/MhoWyDwKBgB+8FrPAgechx/cMTO4yqvRMLObWOf+/Y86pGSU5Qsgyq1NbRt3w +ld+ytwLHKOMGB0ZtYXb/wox3AbKYkOOdqa8sZULMuPI3pY90fs2m0ql3obLl35d3 +wmza9GbsTtPXFmfGagF5sPDN3FllbavAHLRaCupSl/2E8JRaW/jhHz4FAoGAfL4H +Ggd4mkdY7JO4ytGS3BG/7Vo6eVtwH1wQUb7h22tQYUHGMBU/wgNTdo03FCw84uzT ++/HUAvhPBq3ndHhJqlhwRZut+82XL/lETv9AC8C4pBGv9F9PigYVK3eF0iYQxhvr +lAOuMZvRcvOsvLi4z1XbFXus7kGTxU+/9V52C00CgYBY5SgRETt5kgbH/rm36SsE +4x58yK8uYF8MgtBCLxn7E0vnZ2cAMmmDC9wWCHtuq2QhqL/pB+fPI8ri4XNPMXJC +faAxJ0VNmz8fYTzliAWy3Sqp/kgeXdrX9KJkN24LP345LocDBcaML+thDFevmXBW +mahBgoa1ZWxnLJe5XweVkg== +-----END PRIVATE KEY----- diff --git a/deploy/dockerephemeral/rabbitmq-config/certificates/ca.pem b/deploy/dockerephemeral/rabbitmq-config/certificates/ca.pem new file mode 100644 index 00000000000..cb18742fab2 --- /dev/null +++ b/deploy/dockerephemeral/rabbitmq-config/certificates/ca.pem @@ -0,0 +1,19 @@ +-----BEGIN CERTIFICATE----- +MIIDJTCCAg2gAwIBAgIUaJxRWt/eEYHgz+Rs5QNWVHMfk5swDQYJKoZIhvcNAQEL +BQAwIjEgMB4GA1UEAwwXcmFiYml0bXEuY2EuZXhhbXBsZS5jb20wHhcNMjQwNjE3 +MTQwMjE0WhcNMzQwNjE1MTQwMjE0WjAiMSAwHgYDVQQDDBdyYWJiaXRtcS5jYS5l +eGFtcGxlLmNvbTCCASIwDQYJKoZIhvcNAQEBBQADggEPADCCAQoCggEBAL+8TYJ5 +rXxRnUknRrciQiheXYk9ImnvL9s9ew3qyTjgXkO/2a3mHFURHIJBIyK4zp1d/ORF +wwBnt3HmdDsalIQmSyp7iH5YUdYNCNqjGs5hWD1QBrqrSurmH64dkSkFbAlY2XBG +DPJ/nN8hmeO21UPaa7ganbFGq02QRsA6AwmnuKNvvp+gqwYsWvEk0DeSE2OycOXB +G6h99VItp8XQIDtxbYVjGPAoz8jKYJpFVRLXwh+0K2bcoKXmi77VoPT+sywswoRj +UdgLIahlI6e93nGFE+Pq6mTcylZRTJQtKSmRC1U/L5FkpQ1dvcIZU0nPdSC8zA1c +qlb0V0ZK7N70fF0CAwEAAaNTMFEwHQYDVR0OBBYEFN8gWZGKR0/K/e+qyGcN+8Ae +IokuMB8GA1UdIwQYMBaAFN8gWZGKR0/K/e+qyGcN+8AeIokuMA8GA1UdEwEB/wQF +MAMBAf8wDQYJKoZIhvcNAQELBQADggEBAKTpmSYDx+Fabe/idnMlC9+5KaQmD/dp +x1BW8HZT+ZK+NuadPUVyUx1xHOw+wh1u5G8docGkrCsA/hvgyIRSyycJRCaySt1y +zjml3s3T4wRktgx6Z5X3kfw612/tZ5NE4QyQuN9A7DC9Fh4Z520fMDel15D+t70z +nNjZdp5gxpJPUJCebJ7+OhSUhtgr6g4hXwNqDR7DLwXyhp90UFdjfx4kBYFE8Vnk +nA9ZwC7GhUioMV/yXOuekyiJBv9LtaSuc/Y29EbLufLAwZJD1lA7WN254nNmZgAE +hAhTqL6dgvIIhuKHQ6f4vqAWi4FsrRy6cvh7S80+ldcchMBDcIgh1BA= +-----END CERTIFICATE----- diff --git a/deploy/dockerephemeral/rabbitmq-config/certificates/cert.pem b/deploy/dockerephemeral/rabbitmq-config/certificates/cert.pem new file mode 100644 index 00000000000..6d5744d1f7d --- /dev/null +++ b/deploy/dockerephemeral/rabbitmq-config/certificates/cert.pem @@ -0,0 +1,20 @@ +-----BEGIN CERTIFICATE----- +MIIDPTCCAiWgAwIBAgIBADANBgkqhkiG9w0BAQsFADAiMSAwHgYDVQQDDBdyYWJi +aXRtcS5jYS5leGFtcGxlLmNvbTAeFw0yNDA2MTcxNDAyMTRaFw0yNDA3MTcxNDAy +MTRaMBQxEjAQBgNVBAMMCWxvY2FsaG9zdDCCASIwDQYJKoZIhvcNAQEBBQADggEP +ADCCAQoCggEBAJZ3b8mfnf8XuUJmFQ8xN9V8N1PiMe5X+WMqOKduZXqPeW9rECmC +B3opcDVMQ3iyRtc+fXYSJiCllMeCCwzIWQw+k1PcFZ6zXWsvtEFQRCN91vcShZm0 +v8YlNcYl3wxsnIcZ5/IAZTiyX2U/hTBkgOszJcfe8cBOZsI9QzRuLRzE3kkpA+U7 +/3ekPsIxk/g0NtbRA4BgSrcKl3iAI4CMJTJlsezQbF6LZqW7yIOyvaQzT0kyJ564 +0X7YCT5QozL09ZdbQY5b6pphNNfXqY1KEP/aje+UrzQm2R3e9BUGMM4o14pQOU7Q +cxWRjPSPL3nDKUxI3kI9etrluFLH9lQ1uT8CAwEAAaOBizCBiDAdBgNVHSUEFjAU +BggrBgEFBQcDAQYIKwYBBQUHAwIwJwYDVR0RAQH/BB0wG4IJbG9jYWxob3N0gghy +YWJiaXRtcYcEfwAAATAdBgNVHQ4EFgQUf53Mqv9QZmcO5uwUUNZcMQA05cAwHwYD +VR0jBBgwFoAU3yBZkYpHT8r976rIZw37wB4iiS4wDQYJKoZIhvcNAQELBQADggEB +ABXBCl+jy+EeDPLwFlHX/DTJrce3VQMAG+x5WxbuKr68zS8uwJFfqmb4dK01RiSe +QAaISp/vr4KRbbNc5f/TA5dOhc2qXf8dZ0rILWE0u1I+1y9DFuNnymIywbodo6ho +ln7bj2wNl1vZ1A6Tm9fH6MJhavCCM18AHZuz+ml9b8SSVnL3XfPUWuZjYnElSXWj +qTJUF+o/1QC3E+ILj5iiwaAgp8kJJezr5m90RC/DTchYS/CRtz79jYMY8IMdOpN6 +JC92KzpO0jKZ4qWkDi4ZgszPTNcUdnjUc4botJrfZhioA26skUiuacyqfpvnspno +y5DFD+Od2XpBCCwgeYk6IPM= +-----END CERTIFICATE----- diff --git a/deploy/dockerephemeral/rabbitmq-config/certificates/key.pem b/deploy/dockerephemeral/rabbitmq-config/certificates/key.pem new file mode 100644 index 00000000000..6471c8d1781 --- /dev/null +++ b/deploy/dockerephemeral/rabbitmq-config/certificates/key.pem @@ -0,0 +1,28 @@ +-----BEGIN PRIVATE KEY----- +MIIEvQIBADANBgkqhkiG9w0BAQEFAASCBKcwggSjAgEAAoIBAQCWd2/Jn53/F7lC +ZhUPMTfVfDdT4jHuV/ljKjinbmV6j3lvaxApggd6KXA1TEN4skbXPn12EiYgpZTH +ggsMyFkMPpNT3BWes11rL7RBUEQjfdb3EoWZtL/GJTXGJd8MbJyHGefyAGU4sl9l +P4UwZIDrMyXH3vHATmbCPUM0bi0cxN5JKQPlO/93pD7CMZP4NDbW0QOAYEq3Cpd4 +gCOAjCUyZbHs0Gxei2alu8iDsr2kM09JMieeuNF+2Ak+UKMy9PWXW0GOW+qaYTTX +16mNShD/2o3vlK80Jtkd3vQVBjDOKNeKUDlO0HMVkYz0jy95wylMSN5CPXra5bhS +x/ZUNbk/AgMBAAECggEAFSsQawktrSmlQpYh+FUwSbSEBCUaaTGvQCg8eDGrzSZK +K0agq3ZDnwgdZSIpi91o4fdEp0u+WXFyEO9WpqG5BWP4Th/0WrNZPS8k6Ntl+qhF +idTtPsaTBElP22SQkKrnCoq2evFbTDKsAQ6CqmA5Ut2LPyc6U5e0FTeRMNsfNaC1 +e+60J5yjxYWfZQdU5F+uiycWWiqabOafJfbN0gdLeuIICG+Z8AuWoUjLg2v55itw +X9T3AWZ2+/kdUY8j5FXFoK2MfuzW7Ys+Y1JeLMHrquy2hicSMbJE7vnxNsv1VMPc +IZzlgS+N/Lqre0S0NQAKqTGxe4PcUw+Mp5ZqXHtBwQKBgQDEViEeOAAtfvpK4pFv +drXmv2KacieEtUeEVfgbzMY4tL2q7RfFGxC4iiLklvwhQSGyfRamtut+t+eR4eFx +XKHaZxobwwfW5sMi6Ye/iyuL3YXvtWiaOz6XNImFTeWUPLnrX5qtMuVbx4UGiKa7 +kjg/214A8Zf/qoVJxzAJwp1E6QKBgQDEMOM+dnUlUc8FrllXmlsGYMxwWdQ+vvvw +BdKrm6Q61z3+C5189VwQQ1+ruIcmfVqCm1BKa0J76evgdqHo/pgiAaGEhItVt8cN +3IVnpQu9Fhphgd/iFYxyTOCW2d1Nze30H1oqwpgmZsw2vE/6WrU8e1j279+SUevS +2+rx7i1T5wKBgE6rhFGrdsbEHl5rMoNLOc/f2A6ytwsB6EoqeGQLRVHreiRHJEMi +eSy4jQqzRQu+IVZ3sN/UY8A+yFc3/zGBQIlWzqtZFocRqBcRJAeoKCa++K/4LJXA +L3A+6Ou1LsybGJQrlrrXrfd8ltzrXIPELy3HJH+UTqdvGEFbwu/mP0YhAoGBAINX +Pyp33yDmzbM97y3Idhuk/fhRCtgev0cGfuzHu4BwzF2gpQQctk9k601osYHA9bDu +DShk+hM+nNyeTvJOTsalVN4EZcsyxx2ufdjPEza471xLt/gA+Q8kDE6w94i4zg5a +VuC9eWJr+1bBZsFxrFcbNInMOF4aXcfB1l20V8ANAoGAXZcAv5zU5Cj4ktoe0uqi +7p9zR8mgW2oXU0orgdQ3Ce2Z2qy4yFU5AfHPmn1RuRFsQCxX8RpUqLDHOvpn6gyt +/u9GBqlCqYG4KAbGKGVjodEIXilbIVNEbCIi4kGcRO038fzZJawwhrXg3FuMd6EV +G92A1vtGnTZYkatPK4LRnBk= +-----END PRIVATE KEY----- diff --git a/deploy/dockerephemeral/rabbitmq-config/rabbitmq.conf b/deploy/dockerephemeral/rabbitmq-config/rabbitmq.conf new file mode 100644 index 00000000000..fe1756e9285 --- /dev/null +++ b/deploy/dockerephemeral/rabbitmq-config/rabbitmq.conf @@ -0,0 +1,14 @@ +default_user = $(RABBITMQ_USERNAME) +default_pass = $(RABBITMQ_PASSWORD) + +listeners.tcp.default = 5672 +listeners.ssl.default = 5671 +ssl_options.cacertfile = /etc/rabbitmq/certificates/ca.pem +ssl_options.certfile = /etc/rabbitmq/certificates/cert.pem +ssl_options.keyfile = /etc/rabbitmq/certificates/key.pem + +management.tcp.port = 15672 +management.ssl.port = 15671 +management.ssl.cacertfile = /etc/rabbitmq/certificates/ca.pem +management.ssl.certfile = /etc/rabbitmq/certificates/cert.pem +management.ssl.keyfile = /etc/rabbitmq/certificates/key.pem diff --git a/docs/src/developer/reference/config-options.md b/docs/src/developer/reference/config-options.md index a46ad32fe5a..1c90bdfcc57 100644 --- a/docs/src/developer/reference/config-options.md +++ b/docs/src/developer/reference/config-options.md @@ -1085,7 +1085,7 @@ gundeck: **WARNING:** Please do this only if you know what you're doing. -In case it is not possible to verify TLS certificate of the elasticsearch +In case it is not possible to verify TLS certificate of the redis server, it can be turned off without tuning off TLS like this: ```yaml @@ -1096,3 +1096,32 @@ gundeck: redisAdditionalWrite: insecureSkipVerifyTls: true ``` + +## Configure RabbitMQ + +RabbitMQ authentication must be configured on brig, galley and background-worker. For example: + +```yaml +rabbitmq: + host: localhost + port: 5672 + vHost: / + adminPort: 15672 # for background-worker +``` + +the `adminPort` setting is only needed by background-worker. + +In order to enable TLS when connecting to RabbitMQ, the following settings need to be added: + +```yaml +rabbitmq: + enableTls: true + caCert: test/resources/rabbitmq-ca.pem + insecureSkipVerifyTls: false +``` + +**WARNING:** Please do this only if you know what you're doing. + +In case it is not possible to verify the TLS certificate of the RabbitMQ +server, verification can be turned off by settings `insecureSkipVerifyTls` to +`true`. diff --git a/hack/bin/gen-certs.sh b/hack/bin/gen-certs.sh index 65d278fcaa8..a2a33a26253 100755 --- a/hack/bin/gen-certs.sh +++ b/hack/bin/gen-certs.sh @@ -78,3 +78,9 @@ for redis_node in $(seq 1 6); do "redis-node-${redis_node}-cert" \ "redis-node-${redis_node}-key" done + +# rabbitmq +RABBITMQ="$ROOT_DIR/deploy/dockerephemeral/rabbitmq-config/certificates" +gen_ca "$RABBITMQ" rabbitmq.ca.example.com +gen_cert "$RABBITMQ" "DNS:localhost, DNS:rabbitmq, IP:127.0.0.1" localhost +chmod a+r "$RABBITMQ/key.pem" diff --git a/hack/helm_vars/certs/values.yaml.gotmpl b/hack/helm_vars/certs/values.yaml.gotmpl index 875a4a17124..2d771907e65 100644 --- a/hack/helm_vars/certs/values.yaml.gotmpl +++ b/hack/helm_vars/certs/values.yaml.gotmpl @@ -15,6 +15,8 @@ resources: spec: ca: secretName: elasticsearch-ca + + # redis CA and certificate - apiVersion: cert-manager.io/v1 kind: Issuer metadata: @@ -66,3 +68,56 @@ resources: issuerRef: name: redis-issuer kind: Issuer + + # RabbitMQ CA and certificate + - apiVersion: cert-manager.io/v1 + kind: Issuer + metadata: + name: rabbitmq-ca-issuer + namespace: '{{ .Release.Namespace }}' + spec: + selfSigned: {} + - apiVersion: cert-manager.io/v1 + kind: Certificate + metadata: + name: rabbitmq-ca + namespace: '{{ .Release.Namespace }}' + spec: + secretName: rabbitmq-ca-certificate + isCA: true + duration: 2160h # 90d + renewBefore: 360h # 15d + commonName: rabbitmq.example.com + privateKey: + algorithm: RSA + encoding: PKCS1 + size: 2048 + issuerRef: + name: rabbitmq-ca-issuer + kind: Issuer + - apiVersion: cert-manager.io/v1 + kind: Issuer + metadata: + name: rabbitmq-issuer + namespace: '{{ .Release.Namespace }}' + spec: + ca: + secretName: rabbitmq-ca-certificate + - apiVersion: cert-manager.io/v1 + kind: Certificate + metadata: + name: rabbitmq + namespace: '{{ .Release.Namespace }}' + spec: + secretName: rabbitmq-certificate + isCA: false + duration: 2160h # 90d + renewBefore: 360h # 15d + commonName: rabbitmq + privateKey: + algorithm: RSA + encoding: PKCS1 + size: 2048 + issuerRef: + name: rabbitmq-issuer + kind: Issuer diff --git a/hack/helm_vars/rabbitmq/values.yaml.gotmpl b/hack/helm_vars/rabbitmq/values.yaml.gotmpl index a8a4a81dee2..710e9b0d338 100644 --- a/hack/helm_vars/rabbitmq/values.yaml.gotmpl +++ b/hack/helm_vars/rabbitmq/values.yaml.gotmpl @@ -4,3 +4,20 @@ rabbitmq: auth: username: {{ .Values.rabbitmqUsername }} password: {{ .Values.rabbitmqPassword }} + tls: + enabled: true + failIfNoPeerCert: false + existingSecret: rabbitmq-certificate + service: + extraPorts: + - name: http-stats-ssl + port: 15671 + protocol: TCP + targetPort: 15671 + extraConfiguration: |- + listeners.tcp = none + management.tcp.port = 15672 + management.ssl.port = 15671 + management.ssl.cacertfile = /opt/bitnami/rabbitmq/certs/ca_certificate.pem + management.ssl.certfile = /opt/bitnami/rabbitmq/certs/server_certificate.pem + management.ssl.keyfile = /opt/bitnami/rabbitmq/certs/server_key.pem diff --git a/hack/helm_vars/wire-server/values.yaml.gotmpl b/hack/helm_vars/wire-server/values.yaml.gotmpl index 66a7e300915..e57f8a4b1cc 100644 --- a/hack/helm_vars/wire-server/values.yaml.gotmpl +++ b/hack/helm_vars/wire-server/values.yaml.gotmpl @@ -75,6 +75,13 @@ brig: additionalTlsCaSecretRef: name: "elasticsearch-ephemeral-certificate" key: "ca.crt" + rabbitmq: + port: 5671 + enableTls: true + insecureSkipVerifyTls: false + tlsCaSecretRef: + name: rabbitmq-certificate + key: "ca.crt" authSettings: userTokenTimeout: 120 sessionTokenTimeout: 20 @@ -233,6 +240,13 @@ galley: name: "cassandra-jks-keystore" key: "ca.crt" {{- end }} + rabbitmq: + port: 5671 + enableTls: true + insecureSkipVerifyTls: false + tlsCaSecretRef: + name: rabbitmq-certificate + key: "ca.crt" enableFederation: true # keep in sync with brig.config.enableFederation, cargohold.config.enableFederation and tags.federator! settings: maxConvAndTeamSize: 16 @@ -471,6 +485,14 @@ background-worker: pushBackoffMinWait: 1000 # 1ms pushBackoffMaxWait: 500000 # 0.5s remotesRefreshInterval: 1000000 # 1s + rabbitmq: + port: 5671 + adminPort: 15671 + enableTls: true + insecureSkipVerifyTls: false + tlsCaSecretRef: + name: rabbitmq-certificate + key: "ca.crt" secrets: rabbitmq: username: {{ .Values.rabbitmqUsername }} @@ -497,6 +519,10 @@ integration: tlsCaSecretRef: name: "redis-certificate" key: "ca.crt" + rabbitmq: + tlsCaSecretRef: + name: "rabbitmq-certificate" + key: "ca.crt" {{- if .Values.uploadXml }} uploadXml: baseUrl: {{ .Values.uploadXml.baseUrl }} diff --git a/integration/scripts/integration-dynamic-backends-vhosts.sh b/integration/scripts/integration-dynamic-backends-vhosts.sh index f919f6b9121..5478a68b03a 100755 --- a/integration/scripts/integration-dynamic-backends-vhosts.sh +++ b/integration/scripts/integration-dynamic-backends-vhosts.sh @@ -7,7 +7,6 @@ DOMAIN=$2 echo 'Creating RabbitMQ resources' -curl -u "$RABBITMQ_USERNAME":"$RABBITMQ_PASSWORD" -X PUT "$ENDPOINT_URL/$DOMAIN" +curl --cacert /certs/rabbitmq-ca/ca.pem -u "$RABBITMQ_USERNAME:$RABBITMQ_PASSWORD" -X PUT "$ENDPOINT_URL/$DOMAIN" echo "RabbitMQ vhost created successfully for $DOMAIN" - diff --git a/integration/test/Testlib/ResourcePool.hs b/integration/test/Testlib/ResourcePool.hs index 560967c06d0..e2d843dc42f 100644 --- a/integration/test/Testlib/ResourcePool.hs +++ b/integration/test/Testlib/ResourcePool.hs @@ -84,7 +84,8 @@ deleteAllRabbitMQQueues rc resource = do { host = rc.host, port = 0, adminPort = fromIntegral rc.adminPort, - vHost = T.pack resource.berVHost + vHost = T.pack resource.berVHost, + tls = Nothing } client <- mkRabbitMqAdminClientEnv opts queues <- listQueuesByVHost client (T.pack resource.berVHost) diff --git a/libs/extended/default.nix b/libs/extended/default.nix index 66687c40075..b47de8057a2 100644 --- a/libs/extended/default.nix +++ b/libs/extended/default.nix @@ -9,6 +9,9 @@ , bytestring , cassandra-util , containers +, crypton-connection +, crypton-x509-store +, data-default , errors , exceptions , extra @@ -16,6 +19,7 @@ , hspec , hspec-discover , http-client +, http-client-tls , http-types , imports , lib @@ -34,6 +38,8 @@ , text , time , tinylog +, tls +, transformers , unliftio , wai }: @@ -48,10 +54,14 @@ mkDerivation { bytestring cassandra-util containers + crypton-connection + crypton-x509-store + data-default errors exceptions extra http-client + http-client-tls http-types imports metrics-wai @@ -67,6 +77,8 @@ mkDerivation { text time tinylog + tls + transformers unliftio wai ]; diff --git a/libs/extended/extended.cabal b/libs/extended/extended.cabal index 087fb75843a..03d180a004a 100644 --- a/libs/extended/extended.cabal +++ b/libs/extended/extended.cabal @@ -85,10 +85,14 @@ library , bytestring , cassandra-util , containers + , crypton-connection + , crypton-x509-store + , data-default , errors , exceptions , extra , http-client + , http-client-tls , http-types , imports , metrics-wai @@ -104,6 +108,8 @@ library , text , time , tinylog + , tls + , transformers , unliftio , wai diff --git a/libs/extended/src/Network/AMQP/Extended.hs b/libs/extended/src/Network/AMQP/Extended.hs index 502cdb95a77..43bdec456b9 100644 --- a/libs/extended/src/Network/AMQP/Extended.hs +++ b/libs/extended/src/Network/AMQP/Extended.hs @@ -1,19 +1,36 @@ {-# LANGUAGE RecordWildCards #-} -module Network.AMQP.Extended where +module Network.AMQP.Extended + ( RabbitMqHooks (..), + RabbitMqAdminOpts (..), + RabbitMqOpts (..), + openConnectionWithRetries, + mkRabbitMqAdminClientEnv, + mkRabbitMqChannelMVar, + demoteOpts, + ) +where import Control.Exception (throwIO) import Control.Monad.Catch import Control.Monad.Trans.Control +import Control.Monad.Trans.Maybe import Control.Retry import Data.Aeson +import Data.Aeson.Types +import Data.Default import Data.Proxy import Data.Text qualified as Text import Data.Text.Encoding qualified as Text +import Data.X509.CertificateStore qualified as X509 import Imports import Network.AMQP qualified as Q +import Network.Connection as Conn import Network.HTTP.Client qualified as HTTP +import Network.HTTP.Client.TLS qualified as HTTP import Network.RabbitMqAdmin +import Network.TLS +import Network.TLS.Extra.Cipher import Servant import Servant.Client import Servant.Client qualified as Servant @@ -33,22 +50,52 @@ data RabbitMqHooks m = RabbitMqHooks onChannelException :: SomeException -> m () } +data RabbitMqTlsOpts = RabbitMqTlsOpts + { caCert :: !(Maybe FilePath), + insecureSkipVerifyTls :: Bool + } + deriving (Show) + +parseTlsJson :: Object -> Parser (Maybe RabbitMqTlsOpts) +parseTlsJson v = do + enabled <- v .:? "enableTls" .!= False + if enabled + then + Just + <$> ( RabbitMqTlsOpts + <$> v .:? "caCert" + <*> v .:? "insecureSkipVerifyTls" .!= False + ) + else pure Nothing + data RabbitMqAdminOpts = RabbitMqAdminOpts { host :: !String, port :: !Int, vHost :: !Text, + tls :: Maybe RabbitMqTlsOpts, adminPort :: !Int } - deriving (Show, Generic) + deriving (Show) -instance FromJSON RabbitMqAdminOpts +instance FromJSON RabbitMqAdminOpts where + parseJSON = withObject "RabbitMqAdminOpts" $ \v -> + RabbitMqAdminOpts + <$> v .: "host" + <*> v .: "port" + <*> v .: "vHost" + <*> parseTlsJson v + <*> v .: "adminPort" mkRabbitMqAdminClientEnv :: RabbitMqAdminOpts -> IO (AdminAPI (AsClientT IO)) mkRabbitMqAdminClientEnv opts = do (username, password) <- readCredsFromEnv - manager <- HTTP.newManager HTTP.defaultManagerSettings + mTlsSettings <- traverse (mkTLSSettings opts.host) opts.tls + let (protocol, managerSettings) = case mTlsSettings of + Nothing -> (Servant.Http, HTTP.defaultManagerSettings) + Just tlsSettings -> (Servant.Https, HTTP.mkManagerSettings tlsSettings Nothing) + manager <- HTTP.newManager managerSettings let basicAuthData = Servant.BasicAuthData (Text.encodeUtf8 username) (Text.encodeUtf8 password) - clientEnv = Servant.mkClientEnv manager (Servant.BaseUrl Servant.Http opts.host opts.adminPort "") + clientEnv = Servant.mkClientEnv manager (Servant.BaseUrl protocol opts.host opts.adminPort "") pure . fromServant $ hoistClient (Proxy @(ToServant AdminAPI AsApi)) @@ -60,11 +107,18 @@ mkRabbitMqAdminClientEnv opts = do data RabbitMqOpts = RabbitMqOpts { host :: !String, port :: !Int, - vHost :: !Text + vHost :: !Text, + tls :: !(Maybe RabbitMqTlsOpts) } - deriving (Show, Generic) + deriving (Show) -instance FromJSON RabbitMqOpts +instance FromJSON RabbitMqOpts where + parseJSON = withObject "RabbitMqAdminOpts" $ \v -> + RabbitMqOpts + <$> v .: "host" + <*> v .: "port" + <*> v .: "vHost" + <*> parseTlsJson v demoteOpts :: RabbitMqAdminOpts -> RabbitMqOpts demoteOpts RabbitMqAdminOpts {..} = RabbitMqOpts {..} @@ -123,7 +177,15 @@ openConnectionWithRetries l RabbitMqOpts {..} hooks = do ) ( const $ do Log.info l $ Log.msg (Log.val "Trying to connect to RabbitMQ") - liftIO $ Q.openConnection' host (fromIntegral port) vHost username password + mTlsSettings <- traverse (liftIO . (mkTLSSettings host)) tls + liftIO $ + Q.openConnection'' $ + Q.defaultConnectionOpts + { Q.coServers = [(host, fromIntegral port)], + Q.coVHost = vHost, + Q.coAuth = [Q.plain username password], + Q.coTLSSettings = fmap Q.TLSCustom mTlsSettings + } ) bracket getConn (liftIO . Q.closeConnection) $ \conn -> do liftBaseWith $ \runInIO -> @@ -156,6 +218,28 @@ openConnectionWithRetries l RabbitMqOpts {..} hooks = do logException l "RabbitMQ channel closed" e openChan conn +mkTLSSettings :: HostName -> RabbitMqTlsOpts -> IO TLSSettings +mkTLSSettings host opts = do + setCAStore <- runMaybeT $ do + path <- maybe mzero pure opts.caCert + store <- MaybeT $ X509.readCertificateStore path + pure $ \shared -> shared {sharedCAStore = store} + let setHooks = + if opts.insecureSkipVerifyTls + then \h -> h {onServerCertificate = \_ _ _ _ -> pure []} + else id + pure $ + TLSSettings + (defaultParamsClient host "rabbitmq") + { clientShared = fromMaybe id setCAStore def, + clientHooks = setHooks def, + clientSupported = + def + { supportedVersions = [TLS13, TLS12], + supportedCiphers = ciphersuite_strong + } + } + logException :: (MonadIO m) => Logger -> String -> SomeException -> m () logException l m (SomeException e) = do Log.err l $ diff --git a/services/background-worker/background-worker.integration.yaml b/services/background-worker/background-worker.integration.yaml index 32ff94e37ef..c23798e63ed 100644 --- a/services/background-worker/background-worker.integration.yaml +++ b/services/background-worker/background-worker.integration.yaml @@ -10,11 +10,14 @@ federatorInternal: rabbitmq: host: 127.0.0.1 - port: 5672 + port: 5671 vHost: / - adminPort: 15672 + adminPort: 15671 + enableTls: true + caCert: test/resources/rabbitmq-ca.pem + insecureSkipVerifyTls: false backendNotificationPusher: pushBackoffMinWait: 1000 # 1ms pushBackoffMaxWait: 1000000 # 1s - remotesRefreshInterval: 10000 # 10ms \ No newline at end of file + remotesRefreshInterval: 10000 # 10ms diff --git a/services/background-worker/src/Wire/BackendNotificationPusher.hs b/services/background-worker/src/Wire/BackendNotificationPusher.hs index 913bf246f70..f7cfe209ad6 100644 --- a/services/background-worker/src/Wire/BackendNotificationPusher.hs +++ b/services/background-worker/src/Wire/BackendNotificationPusher.hs @@ -268,7 +268,7 @@ getRemoteDomains = do let policy = limitRetriesByCumulativeDelay 60_000_000 $ fullJitterBackoff 10000 logErrr willRetry (SomeException e) rs = Log.err $ - Log.msg (Log.val "Exception occurred while refreshig domains") + Log.msg (Log.val "Exception occurred while refreshing domains") . Log.field "error" (displayException e) . Log.field "willRetry" willRetry . Log.field "retryCount" rs.rsIterNumber diff --git a/services/background-worker/test/resources/rabbitmq-ca.pem b/services/background-worker/test/resources/rabbitmq-ca.pem new file mode 120000 index 00000000000..ca91c2c31bd --- /dev/null +++ b/services/background-worker/test/resources/rabbitmq-ca.pem @@ -0,0 +1 @@ +../../../../deploy/dockerephemeral/rabbitmq-config/certificates/ca.pem \ No newline at end of file diff --git a/services/brig/brig.integration.yaml b/services/brig/brig.integration.yaml index 1723ec9f1e5..b3837d1c66c 100644 --- a/services/brig/brig.integration.yaml +++ b/services/brig/brig.integration.yaml @@ -21,8 +21,11 @@ elasticsearch: rabbitmq: host: 127.0.0.1 - port: 5672 + port: 5671 vHost: / + enableTls: true + caCert: test/resources/rabbitmq-ca.pem + insecureSkipVerifyTls: false cargohold: host: 127.0.0.1 diff --git a/services/brig/test/resources/rabbitmq-ca.pem b/services/brig/test/resources/rabbitmq-ca.pem new file mode 120000 index 00000000000..ca91c2c31bd --- /dev/null +++ b/services/brig/test/resources/rabbitmq-ca.pem @@ -0,0 +1 @@ +../../../../deploy/dockerephemeral/rabbitmq-config/certificates/ca.pem \ No newline at end of file diff --git a/services/galley/galley.integration.yaml b/services/galley/galley.integration.yaml index acf9326915f..465d807cec3 100644 --- a/services/galley/galley.integration.yaml +++ b/services/galley/galley.integration.yaml @@ -27,8 +27,11 @@ federator: rabbitmq: host: 127.0.0.1 - port: 5672 + port: 5671 vHost: / + enableTls: true + caCert: test/resources/rabbitmq-ca.pem + insecureSkipVerifyTls: false settings: httpPoolSize: 128 diff --git a/services/galley/test/resources/rabbitmq-ca.pem b/services/galley/test/resources/rabbitmq-ca.pem new file mode 120000 index 00000000000..ca91c2c31bd --- /dev/null +++ b/services/galley/test/resources/rabbitmq-ca.pem @@ -0,0 +1 @@ +../../../../deploy/dockerephemeral/rabbitmq-config/certificates/ca.pem \ No newline at end of file From 48d0d8e491c33c5a4addf992c8015c98ffaef1aa Mon Sep 17 00:00:00 2001 From: Stefan Matting Date: Fri, 21 Jun 2024 14:34:40 +0200 Subject: [PATCH 39/64] coturn: Add IP configuration options (#4083) --- changelog.d/2-features/coturn-params | 1 + .../coturn/templates/configmap-coturn-conf-template.yaml | 9 ++++++--- charts/coturn/templates/statefulset.yaml | 6 +++++- charts/coturn/values.yaml | 8 +++++--- 4 files changed, 17 insertions(+), 7 deletions(-) create mode 100644 changelog.d/2-features/coturn-params diff --git a/changelog.d/2-features/coturn-params b/changelog.d/2-features/coturn-params new file mode 100644 index 00000000000..ceab29645df --- /dev/null +++ b/changelog.d/2-features/coturn-params @@ -0,0 +1 @@ +Introduce more configuration options to the `coturn` helm chart diff --git a/charts/coturn/templates/configmap-coturn-conf-template.yaml b/charts/coturn/templates/configmap-coturn-conf-template.yaml index 73bea8326a9..f829900ad1c 100644 --- a/charts/coturn/templates/configmap-coturn-conf-template.yaml +++ b/charts/coturn/templates/configmap-coturn-conf-template.yaml @@ -31,14 +31,17 @@ data: ## turn, stun. listening-ip={{ default "__COTURN_EXT_IP__" .Values.coturnTurnListenIP }} listening-port={{ .Values.coturnTurnListenPort }} - relay-ip=__COTURN_EXT_IP__ + relay-ip={{ default "__COTURN_EXT_IP__" .Values.coturnTurnRelayIP }} + {{- if .Values.coturnTurnExternalIP }} + external-ip={{ default "__COTURN_EXT_IP__" .Values.coturnTurnExternalIP }} + {{- end }} realm=dummy.io no-stun-backward-compatibility secure-stun no-rfc5780 ## prometheus metrics - prometheus-ip=__COTURN_POD_IP__ + prometheus-ip={{ default "__COTURN_POD_IP__" .Values.coturnPrometheusIP }} prometheus-port={{ .Values.coturnMetricsListenPort }} ## logs @@ -89,7 +92,7 @@ data: {{- if .Values.federate.enabled }} ### federation setup - federation-listening-ip=__COTURN_EXT_IP__ + federation-listening-ip={{ default "__COTURN_EXT_IP__" .Values.coturnFederationListeningIP }} federation-listening-port={{ .Values.federate.port }} federation-no-dtls={{ not .Values.federate.dtls.enabled }} {{- if .Values.federate.dtls.enabled }} diff --git a/charts/coturn/templates/statefulset.yaml b/charts/coturn/templates/statefulset.yaml index e8f75fa0762..e33c8be7ae2 100644 --- a/charts/coturn/templates/statefulset.yaml +++ b/charts/coturn/templates/statefulset.yaml @@ -100,6 +100,10 @@ spec: valueFrom: fieldRef: fieldPath: metadata.name + - name: HOST_IP + valueFrom: + fieldRef: + fieldPath: status.hostIP volumeMounts: - name: external-ip mountPath: /external-ip @@ -134,7 +138,7 @@ spec: - | set -e EXTERNAL_IP=$(cat /external-ip/ip) - sed -Ee "s;__COTURN_EXT_IP__;$EXTERNAL_IP;g" -e "s;__COTURN_POD_IP__;$POD_IP;g" /coturn-template/coturn.conf.template > /coturn-config/turnserver.conf + sed -Ee "s;__COTURN_EXT_IP__;$EXTERNAL_IP;g" -e "s;__COTURN_POD_IP__;$POD_IP;g" -e "s;__COTURN_HOST_IP__;$HOST_IP;g" /coturn-template/coturn.conf.template > /coturn-config/turnserver.conf sed -Ee 's/^/static-auth-secret=/' /secrets/zrest_secret.txt >> /coturn-config/turnserver.conf exec /usr/bin/turnserver -c /coturn-config/turnserver.conf {{- if .Values.coturnGracefulTermination }} diff --git a/charts/coturn/values.yaml b/charts/coturn/values.yaml index fbcc5de5b5b..fc6fe3b2917 100644 --- a/charts/coturn/values.yaml +++ b/charts/coturn/values.yaml @@ -26,9 +26,11 @@ coturnTurnListenPort: 3478 coturnMetricsListenPort: 9641 coturnTurnTlsListenPort: 5349 -# If you need to specify which IP Coturn should bind to. -# This will typically be the IP of the kubenode. -# coturnTurnListenIP: "182.168.22.133" +# coturnTurnListenIP: "1.2.3.4" # can also be __COTURN_EXT_IP__, __COTURN_POD_IP__,__COTURN_HOST_IP__ +coturnTurnExternalIP: null +# coturnTurnRelayIP: +# coturnPrometheusIP: +# coturnFederationListeningIP: tls: enabled: false From b9a9fbc3f8ec80d5e7731378db5ed828626157d4 Mon Sep 17 00:00:00 2001 From: Mango The Fourth <40720523+MangoIV@users.noreply.github.com> Date: Mon, 24 Jun 2024 10:13:41 +0200 Subject: [PATCH 40/64] [feat] clean up the haskell pins and update http2 and warp (#4096) --- .../src/HTTP2/Client/Manager/Internal.hs | 14 +++-- .../test/Test/HTTP2/Client/ManagerSpec.hs | 14 ++++- .../src/Wire/API/Federation/Client.hs | 2 +- nix/haskell-pins.nix | 62 ++++++++++++++++--- nix/manual-overrides.nix | 16 +---- 5 files changed, 77 insertions(+), 31 deletions(-) diff --git a/libs/http2-manager/src/HTTP2/Client/Manager/Internal.hs b/libs/http2-manager/src/HTTP2/Client/Manager/Internal.hs index 4861a150a4a..5ec47c2fff0 100644 --- a/libs/http2-manager/src/HTTP2/Client/Manager/Internal.hs +++ b/libs/http2-manager/src/HTTP2/Client/Manager/Internal.hs @@ -15,6 +15,7 @@ import Control.Monad import Control.Monad.IO.Class import Data.ByteString import qualified Data.ByteString as BS +import qualified Data.ByteString.Char8 as C8 import Data.IORef import Data.Map import qualified Data.Map as Map @@ -291,9 +292,9 @@ startPersistentHTTP2Connection :: startPersistentHTTP2Connection ctx (tlsEnabled, hostname, port) cl removeTrailingDot tcpConnectTimeout sendReqMVar = do liveReqs <- newIORef mempty let clientConfig = - HTTP2.ClientConfig + HTTP2.defaultClientConfig { HTTP2.scheme = if tlsEnabled then "https" else "http", - HTTP2.authority = hostname, + HTTP2.authority = C8.unpack hostname, HTTP2.cacheLimit = cl } -- Sends error to requests which show up too late, i.e. after the @@ -333,7 +334,7 @@ startPersistentHTTP2Connection ctx (tlsEnabled, hostname, port) cl removeTrailin bracket connectTCPWithTimeout NS.close $ \sock -> do bracket (mkTransport sock transportConfig) cleanupTransport $ \transport -> bracket (allocHTTP2Config transport) HTTP2.freeSimpleConfig $ \http2Cfg -> do - let runAction = HTTP2.run clientConfig http2Cfg $ \sendReq -> do + let runAction = HTTP2.run clientConfig http2Cfg $ \sendReq _aux -> do handleRequests liveReqs sendReq -- Any request threads still hanging about after 'runAction' finishes -- are canceled with 'ConnectionAlreadyClosed'. @@ -451,6 +452,9 @@ allocHTTP2Config (SecureTransport ssl) = do error "openssl: SSL.read returned more bytes than asked for, this is probably a bug" | otherwise -> readData (acc <> chunk) (n - chunkLen) + let s = fromMaybe (error "http2-manager: SSL without socket") $ SSL.sslSocket ssl + mysa <- NS.getSocketName s + peersa <- NS.getPeerName s pure HTTP2.Config @@ -459,5 +463,7 @@ allocHTTP2Config (SecureTransport ssl) = do HTTP2.confSendAll = SSL.write ssl, HTTP2.confReadN = readData mempty, HTTP2.confPositionReadMaker = HTTP2.defaultPositionReadMaker, - HTTP2.confTimeoutManager = timmgr + HTTP2.confTimeoutManager = timmgr, + HTTP2.confMySockAddr = mysa, + HTTP2.confPeerSockAddr = peersa } diff --git a/libs/http2-manager/test/Test/HTTP2/Client/ManagerSpec.hs b/libs/http2-manager/test/Test/HTTP2/Client/ManagerSpec.hs index 04593bf39ab..f3498187306 100644 --- a/libs/http2-manager/test/Test/HTTP2/Client/ManagerSpec.hs +++ b/libs/http2-manager/test/Test/HTTP2/Client/ManagerSpec.hs @@ -23,7 +23,7 @@ import qualified Data.ByteString.Lazy.Char8 as LBS import Data.IORef import Data.Map (Map) import qualified Data.Map as Map -import Data.Maybe (isJust) +import Data.Maybe (fromMaybe, isJust) import Data.Streaming.Network (bindPortTCP, bindRandomPortTCP) import Data.Unique import Foreign.Marshal.Alloc (mallocBytes) @@ -33,8 +33,10 @@ import HTTP2.Client.Manager.Internal import Network.HTTP.Types import qualified Network.HTTP2.Client as Client import qualified Network.HTTP2.Client as HTTP2 +import Network.HTTP2.Server (defaultServerConfig) import qualified Network.HTTP2.Server as Server import Network.Socket +import qualified Network.Socket as NS import qualified OpenSSL.Session as SSL import System.Random (randomRIO) import qualified System.TimeManager @@ -293,6 +295,10 @@ allocServerConfig (Right ssl) = do error "openssl: SSL.read returned more bytes than asked for, this is probably a bug" | otherwise -> readData (prevChunk <> chunk) (n - chunkLen) + + let s = fromMaybe (error "http2-manager: SSL without socket") $ SSL.sslSocket ssl + mysa <- NS.getSocketName s + peersa <- NS.getPeerName s pure Server.Config { Server.confWriteBuffer = buf, @@ -300,7 +306,9 @@ allocServerConfig (Right ssl) = do Server.confSendAll = SSL.write ssl, Server.confReadN = readData mempty, Server.confPositionReadMaker = Server.defaultPositionReadMaker, - Server.confTimeoutManager = timmgr + Server.confTimeoutManager = timmgr, + Server.confMySockAddr = mysa, + Server.confPeerSockAddr = peersa } testServerOnSocket :: Maybe SSL.SSLContext -> Socket -> IORef Int -> IORef (Map Unique (Async ())) -> IO () @@ -322,7 +330,7 @@ testServerOnSocket mCtx listenSock connsCounter conns = do cleanup cfg = do Server.freeSimpleConfig cfg `finally` (shutdownSSL `finally` close sock) thread <- async $ bracket (allocServerConfig serverCfgParam) cleanup $ \cfg -> do - Server.run cfg testServer `finally` modifyIORef conns (Map.delete connKey) + Server.run defaultServerConfig cfg testServer `finally` modifyIORef conns (Map.delete connKey) modifyIORef conns $ Map.insert connKey thread testServer :: Server.Request -> Server.Aux -> (Server.Response -> [Server.PushPromise] -> IO ()) -> IO () diff --git a/libs/wire-api-federation/src/Wire/API/Federation/Client.hs b/libs/wire-api-federation/src/Wire/API/Federation/Client.hs index 2f6fcde3051..98f653e6083 100644 --- a/libs/wire-api-federation/src/Wire/API/Federation/Client.hs +++ b/libs/wire-api-federation/src/Wire/API/Federation/Client.hs @@ -120,7 +120,7 @@ instance VersionedMonad Version (FederatorClient c) where liftCodensity :: Codensity IO a -> FederatorClient c a liftCodensity = FederatorClient . lift . lift . lift -headersFromTable :: HTTP2.HeaderTable -> [HTTP.Header] +headersFromTable :: HTTP2.TokenHeaderTable -> [HTTP.Header] headersFromTable (headerList, _) = flip map headerList $ first HTTP2.tokenKey -- This opens a new http2 connection. Using a http2-manager leads to this problem https://wearezeta.atlassian.net/browse/WPB-4787 diff --git a/nix/haskell-pins.nix b/nix/haskell-pins.nix index 9b6b99d8195..3cc68c3effc 100644 --- a/nix/haskell-pins.nix +++ b/nix/haskell-pins.nix @@ -258,7 +258,20 @@ let hash = "sha256-E35PVxi/4iJFfWts3td52KKZKQt4dj9KFP3SvWG77Cc="; }; }; + + # open PR https://github.com/yesodweb/wai/pull/958 for sending connection: close when closing connection + warp = { + packages.warp = "warp"; + src = pkgs.fetchFromGitHub { + owner = "yesodweb"; + repo = "wai"; + rev = "8b20c9db265a202a2c7ba2a9ec8786a1ee59957b"; + hash = "sha256-fKUSiRl38FKY1gFSmbksktoqoLfQrDxRRWEh4k+RRW4="; + }; + }; + }; + hackagePins = { # Major re-write upstream, we should get rid of this dependency rather than # adapt to upstream, this will go away when completing servantification. @@ -267,16 +280,46 @@ let sha256 = "sha256-DSMckKIeVE/buSMg8Mq+mUm1bYPYB7veA11Ns7vTBbc="; }; + # start pinned dependencies for http2 + + # this contains an important fix to the initialization of the window size + # and should be switched to upstream as soon as we can http2 = { - version = "4.1.4"; - sha256 = "sha256-r4Bu0vourKMkBO1cPeJVszSbAqHopmkv9EeTHcaTfuo="; + version = "5.2.5"; + sha256 = "sha256-FCd4lPydwWqm2lrhgYtPW+BuXGqmmA8KFrB87SYEowY="; }; - # warp is not compatible with - warp = { - version = "3.3.30"; - sha256 = "sha256-VrK27a2wFtezh9qabcXGe2tw9EwBmI8mKwmpCtXq9rc="; + http-semantics = { + version = "0.1.2"; + sha256 = "sha256-S4rGBCIKVPpLPumLcVzrPONrbWm8VBizqxI3dXNIfr0="; }; + + network-run = { + version = "0.3.0"; + sha256 = "sha256-FP2GZKwacC+TLLwEIVgKBtnKplYPf5xOIjDfvlbQV0o="; + }; + time-manager = { + version = "0.1.0"; + sha256 = "sha256-WRe9LZrOIPJVBFk0vMN2IMoxgP0a0psQCiCiOFWJc74="; + }; + auto-update = { + version = "0.2.0"; + sha256 = "sha256-d/0IDjaaCLz8tlx88z8Ew8ol9PrSRPVWaUwTbim70yE="; + }; + + network-control = { + version = "0.1.0"; + sha256 = "sha256-D6pKb6+0Pr08FnObGbXBVMv04ys3N731p7U+GYH1oEg="; + }; + # end pinned dependencies for http2 + + # pinned for warp + warp-tls = { + version = "3.4.5"; + sha256 = "sha256-3cDi/+n7wHfcWT/iFWAsGdLYXtKYXmvzolDt+ACJnaM="; + }; + # end pinned for warp + # PR: https://github.com/wireapp/wire-server/pull/4027 HsOpenSSL = { version = "0.11.7.7"; @@ -311,11 +354,12 @@ let gitPins; # AttrSet hackagePackages = lib.attrsets.mapAttrs - (pkg: { version, sha256 }: + (pkg: args: hself.callHackageDirect { - ver = version; - inherit pkg sha256; + ver = args.version; + sha256 = args.sha256 or ""; + inherit pkg; } { } ) diff --git a/nix/manual-overrides.nix b/nix/manual-overrides.nix index 86a55d8754f..d2d6a1baef8 100644 --- a/nix/manual-overrides.nix +++ b/nix/manual-overrides.nix @@ -70,20 +70,8 @@ hself: hsuper: { tls = hsuper.tls_2_0_5; tls-session-manager = hsuper.tls-session-manager_0_0_5; - # for warp (and its transitive deps) - # we have a PR open https://github.com/yesodweb/wai/pull/958 - # unfortunately, because of breakage in http2, our fork has moved beyond what - # we can use in wire itself, hence the patch - # the version of warp is pinned in ./haskell-pins.nix - warp = hlib.addTestToolDepends - (hlib.appendPatches hsuper.warp [ - (fetchpatch { - url = "https://github.com/yesodweb/wai/commit/ef993a357822d9bc2a2040afcb656b31c378491c.patch"; - stripLen = 1; - sha256 = "sha256-rv/ujqyBmpsChQg2uS3/HUgQZCA3SzBiF8kUnZJN0xs="; - }) - ]) [ curl ]; - # end for warp + # warp requires curl in its testsuite + warp = hlib.addTestToolDepends hsuper.warp [ curl ]; # ----------------- # flags and patches From 87b8f96891ffc17f1cec5bf190f031f83eae7144 Mon Sep 17 00:00:00 2001 From: Mango The Fourth <40720523+MangoIV@users.noreply.github.com> Date: Mon, 24 Jun 2024 15:20:00 +0200 Subject: [PATCH 41/64] [WPB-9685] don't answer with "204 - legalhold already disabled" when in pending state (#4104) * [chore] add test that confirms behaviour of LH from the issue * [fix] don't react with 204, legalhold not enabled when status is pending Co-authored-by: Akshay Mankar --------- Co-authored-by: Akshay Mankar --- changelog.d/3-bug-fixes/WPB-9685 | 1 + integration/test/Test/LegalHold.hs | 22 +++++++++++++++++++-- services/galley/src/Galley/API/LegalHold.hs | 15 +++++++++++--- 3 files changed, 33 insertions(+), 5 deletions(-) create mode 100644 changelog.d/3-bug-fixes/WPB-9685 diff --git a/changelog.d/3-bug-fixes/WPB-9685 b/changelog.d/3-bug-fixes/WPB-9685 new file mode 100644 index 00000000000..ba18992bbd5 --- /dev/null +++ b/changelog.d/3-bug-fixes/WPB-9685 @@ -0,0 +1 @@ +Disabling legalhold before user's approval doesn't result in an error diff --git a/integration/test/Test/LegalHold.hs b/integration/test/Test/LegalHold.hs index 86373c28cb0..22195f3afdb 100644 --- a/integration/test/Test/LegalHold.hs +++ b/integration/test/Test/LegalHold.hs @@ -873,8 +873,8 @@ testLHCannotCreateGroupWithUsersInConflict = do postConversation bob defProteus {qualifiedUsers = [debora, alice], newUsersRole = "wire_member", team = Just tidAlice} >>= assertLabel 403 "missing-legalhold-consent" -testNoConsentCannotBeInvited :: (HasCallStack) => App () -testNoConsentCannotBeInvited = do +testLHNoConsentCannotBeInvited :: (HasCallStack) => App () +testLHNoConsentCannotBeInvited = do -- team that is legalhold whitelisted (legalholder, tidLH, userLHNotActivated : _) <- createTeam OwnDomain 2 legalholdWhitelistTeam tidLH legalholder >>= assertStatus 200 @@ -904,3 +904,21 @@ testNoConsentCannotBeInvited = do resp.json %. "status" `shouldMatch` "enabled" addMembers userLHNotActivated cid (def {users = [peer3]}) >>= assertLabel 403 "not-connected" + +testLHDisableBeforeApproval :: (HasCallStack) => App () +testLHDisableBeforeApproval = do + (alice, tid, [bob]) <- createTeam OwnDomain 2 + legalholdWhitelistTeam tid alice >>= assertStatus 200 + + withMockServer def lhMockApp \lhDomAndPort _chan -> do + postLegalHoldSettings tid alice (mkLegalHoldSettings lhDomAndPort) >>= assertStatus 201 + + -- alice requests a legalhold device for bob and sets his status to "pending" + requestLegalHoldDevice tid alice bob >>= assertSuccess + let getBob'sStatus = (getUser bob bob >>= getJSON 200) %. "legalhold_status" & asString + getBob'sStatus `shouldMatch` "pending" + + -- alice disables legalhold. the status for bob should now not be pending anymore + disableLegalHold tid alice bob defPassword + >>= assertStatus 200 + getBob'sStatus `shouldMatch` "disabled" diff --git a/services/galley/src/Galley/API/LegalHold.hs b/services/galley/src/Galley/API/LegalHold.hs index 3ea7e42c928..75eceeec319 100644 --- a/services/galley/src/Galley/API/LegalHold.hs +++ b/services/galley/src/Galley/API/LegalHold.hs @@ -581,9 +581,18 @@ disableForUser lzusr tid uid (Public.DisableLegalHoldForUserRequest mPassword) = userLHStatus <- maybe defUserLegalHoldStatus (view legalHoldStatus) <$> getTeamMember tid (tUnqualified luid) - if not $ userLHEnabled userLHStatus - then pure DisableLegalHoldWasNotEnabled - else disableLH (tUnqualified lzusr) luid userLHStatus $> DisableLegalHoldSuccess + + let doDisable = disableLH (tUnqualified lzusr) luid userLHStatus $> DisableLegalHoldSuccess + case userLHStatus of + -- no state change necessary + UserLegalHoldDisabled -> pure DisableLegalHoldWasNotEnabled + UserLegalHoldNoConsent -> + -- no state change allowed + -- we cannot go to disabled because that would subsume consent + pure DisableLegalHoldWasNotEnabled + -- LH is enabled or pending, we can disable (change state) without issue + UserLegalHoldEnabled -> doDisable + UserLegalHoldPending -> doDisable where disableLH :: UserId -> Local UserId -> UserLegalHoldStatus -> Sem r () disableLH zusr luid userLHStatus = do From d3f64ea13bbe34639197abe52bb509a2e8a0b743 Mon Sep 17 00:00:00 2001 From: Paolo Capriotti Date: Mon, 24 Jun 2024 15:51:09 +0200 Subject: [PATCH 42/64] Only resend proposals once after external commit (#4103) * Only resend proposals once after external commit * Add CHANGELOG entry * Log when duplicate proposals are found * Regenerate nix packages --- .../filter-duplicates-when-resending-props | 1 + services/galley/default.nix | 2 + services/galley/galley.cabal | 1 + .../Galley/API/MLS/Commit/ExternalCommit.hs | 10 ++--- services/galley/src/Galley/API/MLS/Util.hs | 37 ++++++++++++------- 5 files changed, 33 insertions(+), 18 deletions(-) create mode 100644 changelog.d/3-bug-fixes/filter-duplicates-when-resending-props diff --git a/changelog.d/3-bug-fixes/filter-duplicates-when-resending-props b/changelog.d/3-bug-fixes/filter-duplicates-when-resending-props new file mode 100644 index 00000000000..80b1f8a703a --- /dev/null +++ b/changelog.d/3-bug-fixes/filter-duplicates-when-resending-props @@ -0,0 +1 @@ +Only resend proposals once after external commit diff --git a/services/galley/default.nix b/services/galley/default.nix index fbc2aef7564..b414e5b0551 100644 --- a/services/galley/default.nix +++ b/services/galley/default.nix @@ -44,6 +44,7 @@ , galley-types , gitignoreSource , gundeck-types +, hex , HsOpenSSL , http-api-data , http-client @@ -164,6 +165,7 @@ mkDerivation { extra galley-types gundeck-types + hex HsOpenSSL http-client http-client-openssl diff --git a/services/galley/galley.cabal b/services/galley/galley.cabal index c5505dbd551..47474894165 100644 --- a/services/galley/galley.cabal +++ b/services/galley/galley.cabal @@ -312,6 +312,7 @@ library , extra >=1.3 , galley-types >=0.65.0 , gundeck-types >=1.35.2 + , hex , HsOpenSSL >=0.11 , http-client >=0.7 , http-client-openssl >=0.2 diff --git a/services/galley/src/Galley/API/MLS/Commit/ExternalCommit.hs b/services/galley/src/Galley/API/MLS/Commit/ExternalCommit.hs index 74cb9bcaa7e..7a3a815b950 100644 --- a/services/galley/src/Galley/API/MLS/Commit/ExternalCommit.hs +++ b/services/galley/src/Galley/API/MLS/Commit/ExternalCommit.hs @@ -168,15 +168,15 @@ processExternalCommit senderIdentity lConvOrSub ciphersuite epoch action updateP lConvOrSub' <- for lConvOrSub incrementEpoch -- fetch backend remove proposals of the previous epoch - indicesInRemoveProposals <- - -- skip remove proposals of already removed by the external commit - (\\ toList action.remove) - <$> getPendingBackendRemoveProposals groupId epoch + indices0 <- getPendingBackendRemoveProposals groupId epoch + + -- skip proposals for clients already removed by the external commit + let indices = maybe id Set.delete action.remove indices0 -- requeue backend remove proposals for the current epoch createAndSendRemoveProposals lConvOrSub' - indicesInRemoveProposals + indices (cidQualifiedUser senderIdentity) (tUnqualified lConvOrSub').members diff --git a/services/galley/src/Galley/API/MLS/Util.hs b/services/galley/src/Galley/API/MLS/Util.hs index 65e6e9f09b2..4b5b93ce437 100644 --- a/services/galley/src/Galley/API/MLS/Util.hs +++ b/services/galley/src/Galley/API/MLS/Util.hs @@ -18,8 +18,10 @@ module Galley.API.MLS.Util where import Control.Comonad +import Data.Hex import Data.Id import Data.Qualified +import Data.Set qualified as Set import Data.Text qualified as T import Galley.Data.Conversation.Types hiding (Conversation) import Galley.Data.Conversation.Types qualified as Data @@ -77,21 +79,30 @@ getPendingBackendRemoveProposals :: ) => GroupId -> Epoch -> - Sem r [LeafIndex] + Sem r (Set LeafIndex) getPendingBackendRemoveProposals gid epoch = do proposals <- getAllPendingProposals gid epoch - catMaybes - <$> for - proposals - ( \case - (Just ProposalOriginBackend, proposal) -> case value proposal of - RemoveProposal i -> pure (Just i) - _ -> pure Nothing - (Just ProposalOriginClient, _) -> pure Nothing - (Nothing, _) -> do - TinyLog.warn $ Log.msg ("found pending proposal without origin, ignoring" :: ByteString) - pure Nothing - ) + indexList <- + catMaybes + <$> for + proposals + ( \case + (Just ProposalOriginBackend, proposal) -> case proposal.value of + RemoveProposal i -> pure (Just i) + _ -> pure Nothing + (Just ProposalOriginClient, _) -> pure Nothing + (Nothing, _) -> do + TinyLog.warn $ Log.msg ("found pending proposal without origin, ignoring" :: ByteString) + pure Nothing + ) + + let indexSet = Set.fromList indexList + when (length indexList /= length indexSet) $ do + TinyLog.warn $ + Log.msg ("found duplicate proposals" :: ByteString) + . Log.field "groupId" ("0x" <> hex (unGroupId gid)) + . Log.field "epoch" (epochNumber epoch) + pure indexSet withCommitLock :: forall r a. From 5c37a0b990bae2dfb1c216699ba08d2388ede488 Mon Sep 17 00:00:00 2001 From: Paolo Capriotti Date: Mon, 24 Jun 2024 16:31:53 +0200 Subject: [PATCH 43/64] Allow nil rabbitmq CA in integration charts (#4106) --- charts/brig/templates/tests/brig-integration.yaml | 4 ++++ charts/galley/templates/tests/galley-integration.yaml | 4 ++++ 2 files changed, 8 insertions(+) diff --git a/charts/brig/templates/tests/brig-integration.yaml b/charts/brig/templates/tests/brig-integration.yaml index 2acf25d6fbc..15996698ba8 100644 --- a/charts/brig/templates/tests/brig-integration.yaml +++ b/charts/brig/templates/tests/brig-integration.yaml @@ -54,9 +54,11 @@ spec: secret: secretName: {{ (include "tlsSecretRef" .Values.config | fromYaml).name }} {{- end}} + {{- if .Values.config.rabbitmq.tlsCaSecretRef }} - name: "rabbitmq-ca" secret: secretName: {{ .Values.config.rabbitmq.tlsCaSecretRef.name }} + {{- end }} containers: - name: integration image: "{{ .Values.image.repository }}-integration:{{ .Values.image.tag }}" @@ -122,8 +124,10 @@ spec: - name: "brig-cassandra" mountPath: "/etc/wire/brig/cassandra" {{- end }} + {{- if .Values.config.rabbitmq.tlsCaSecretRef }} - name: "rabbitmq-ca" mountPath: "/etc/wire/brig/rabbitmq-ca/" + {{- end }} env: # these dummy values are necessary for Amazonka's "Discover" diff --git a/charts/galley/templates/tests/galley-integration.yaml b/charts/galley/templates/tests/galley-integration.yaml index 879af2e5225..b7f71d353e6 100644 --- a/charts/galley/templates/tests/galley-integration.yaml +++ b/charts/galley/templates/tests/galley-integration.yaml @@ -45,9 +45,11 @@ spec: secret: secretName: {{ (include "tlsSecretRef" .Values.config | fromYaml).name }} {{- end }} + {{- if .Values.config.rabbitmq.tlsCaSecretRef }} - name: "rabbitmq-ca" secret: secretName: {{ .Values.config.rabbitmq.tlsCaSecretRef.name }} + {{- end }} containers: - name: integration image: "{{ .Values.image.repository }}-integration:{{ .Values.image.tag }}" @@ -96,8 +98,10 @@ spec: - name: "galley-cassandra" mountPath: "/etc/wire/galley/cassandra" {{- end }} + {{- if .Values.config.rabbitmq.tlsCaSecretRef }} - name: "rabbitmq-ca" mountPath: "/etc/wire/galley/rabbitmq-ca/" + {{- end }} env: # these dummy values are necessary for Amazonka's "Discover" - name: AWS_ACCESS_KEY_ID From 4374eda3efdf1f40d880e57b2f213322acd40e59 Mon Sep 17 00:00:00 2001 From: Matthias Fischmann Date: Mon, 24 Jun 2024 16:45:13 +0200 Subject: [PATCH 44/64] Make error messages in scim user create more helpful. (#4105) --- services/spar/src/Spar/Scim/User.hs | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) diff --git a/services/spar/src/Spar/Scim/User.hs b/services/spar/src/Spar/Scim/User.hs index 9be802c389e..69b9e53f04c 100644 --- a/services/spar/src/Spar/Scim/User.hs +++ b/services/spar/src/Spar/Scim/User.hs @@ -498,10 +498,10 @@ createValidScimUser tokeninfo@ScimTokenInfo {stiTeam} vsu@(ST.ValidScimUser veid -- If this is the case we can safely create the user again. -- Otherwise we return a conflict error. lift (BrigAccess.getStatusMaybe buid) >>= \case - Just Active -> throwError externalIdTakenError - Just Suspended -> throwError externalIdTakenError - Just Ephemeral -> throwError externalIdTakenError - Just PendingInvitation -> throwError externalIdTakenError + Just Active -> throwError (externalIdTakenError ("user with status Active exists: " <> Text.pack (show (veid, buid)))) + Just Suspended -> throwError (externalIdTakenError ("user with status Suspended exists" <> Text.pack (show (veid, buid)))) + Just Ephemeral -> throwError (externalIdTakenError ("user with status Ephemeral exists" <> Text.pack (show (veid, buid)))) + Just PendingInvitation -> throwError (externalIdTakenError ("user with status PendingInvitation exists" <> Text.pack (show (veid, buid)))) Just Deleted -> pure () Nothing -> pure () Just (buid, ScimUserCreating) -> @@ -568,18 +568,18 @@ createValidScimUser tokeninfo@ScimTokenInfo {stiTeam} vsu@(ST.ValidScimUser veid lift $ ScimExternalIdStore.insertStatus stiTeam veid buid ScimUserCreated pure storedUser where - incompleteUserCreationCleanUp :: UserId -> Scim.ScimError -> Scim.ScimHandler (Sem r) () + incompleteUserCreationCleanUp :: UserId -> (Text -> Scim.ScimError) -> Scim.ScimHandler (Sem r) () incompleteUserCreationCleanUp buid e = do -- something went wrong while storing the user in brig -- we can try clean up now, but if brig is down, we can't do much -- maybe retrying the user creation in brig is also an option? -- after clean up we rethrow the error so the handler returns the correct failure lift $ Logger.warn $ Log.msg @Text "An earlier attempt of creating a user with this external ID has failed and left some inconsistent data. Attempting to clean up." - withExceptT (const e) $ deleteScimUser tokeninfo buid + withExceptT (e . ("could not delete scim user: " <>) . Text.pack . show) $ deleteScimUser tokeninfo buid lift $ Logger.info $ Log.msg @Text "Clean up successful." - externalIdTakenError :: Scim.ScimError - externalIdTakenError = Scim.conflict {Scim.detail = Just "ExternalId is already taken"} + externalIdTakenError :: Text -> Scim.ScimError + externalIdTakenError msg = Scim.conflict {Scim.detail = Just ("ExternalId is already taken: " <> msg)} -- | Store scim timestamps, saml credentials, scim externalId locally in spar. Table -- `spar.scim_external` gets an entry iff there is no `UserRef`: if there is, we don't do a From c798b58878db160a51ebfc67abdef1535d893cbc Mon Sep 17 00:00:00 2001 From: Paolo Capriotti Date: Tue, 25 Jun 2024 17:11:18 +0200 Subject: [PATCH 45/64] Add subconversation test (#4102) * Add client information to websocket * Add subconversation proposal resend test * Add assertion --- integration/test/MLS/Util.hs | 4 +- integration/test/Test/MLS/SubConversation.hs | 48 ++++++++++++++++++++ integration/test/Testlib/Cannon.hs | 16 ++++++- 3 files changed, 64 insertions(+), 4 deletions(-) diff --git a/integration/test/MLS/Util.hs b/integration/test/MLS/Util.hs index 246520ca2f2..e8417123bad 100644 --- a/integration/test/MLS/Util.hs +++ b/integration/test/MLS/Util.hs @@ -575,7 +575,7 @@ consumeMessageWithPredicate p cid mmp ws = do consumeMessage :: (HasCallStack) => ClientIdentity -> Maybe MessagePackage -> WebSocket -> App Value consumeMessage = consumeMessageWithPredicate isNewMLSMessageNotif --- | like 'consumeMessage' but but will not consume a message where the sender is the backend +-- | like 'consumeMessage' but will not consume a message where the sender is the backend consumeMessageNoExternal :: (HasCallStack) => ClientIdentity -> Maybe MessagePackage -> WebSocket -> App Value consumeMessageNoExternal cid = consumeMessageWithPredicate isNewMLSMessageNotifButNoProposal cid where @@ -592,7 +592,7 @@ consumeMessageNoExternal cid = consumeMessageWithPredicate isNewMLSMessageNotifB pure $ sender /= Just backendSender else pure False -mlsCliConsume :: ClientIdentity -> ByteString -> App ByteString +mlsCliConsume :: (HasCallStack) => ClientIdentity -> ByteString -> App ByteString mlsCliConsume cid msgData = mlscli cid diff --git a/integration/test/Test/MLS/SubConversation.hs b/integration/test/Test/MLS/SubConversation.hs index c6228461bd0..11dfdc4e7da 100644 --- a/integration/test/Test/MLS/SubConversation.hs +++ b/integration/test/Test/MLS/SubConversation.hs @@ -239,3 +239,51 @@ testCreatorRemovesUserFromParent = do assertBool "alice and charlie should have access to the conversation" (resp.status == 200) mems <- resp.jsonBody %. "members" & asList mems `shouldMatchSet` ((renameField "id" "user_id" <=< make) `traverse` [alice1, charlie1, charlie2]) + +testResendingProposals :: (HasCallStack) => App () +testResendingProposals = do + [alice, bob, charlie] <- createAndConnectUsers [OwnDomain, OwnDomain, OtherDomain] + [alice1, alice2, bob1, bob2, bob3, charlie1] <- + traverse + (createMLSClient def) + [alice, alice, bob, bob, bob, charlie] + traverse_ uploadNewKeyPackage [alice2, bob1, bob2, bob3, charlie1] + + (_, conv) <- createNewGroup alice1 + void $ createAddCommit alice1 [alice, bob, charlie] >>= sendAndConsumeCommitBundle + + createSubConv alice1 "conference" + + void $ createExternalCommit alice2 Nothing >>= sendAndConsumeCommitBundle + void $ createExternalCommit bob1 Nothing >>= sendAndConsumeCommitBundle + void $ createExternalCommit bob2 Nothing >>= sendAndConsumeCommitBundle + void $ createExternalCommit bob3 Nothing >>= sendAndConsumeCommitBundle + + leaveCurrentConv bob1 + leaveCurrentConv bob2 + leaveCurrentConv bob3 + + mls <- getMLSState + withWebSockets (charlie1 : toList mls.members) \wss -> do + void $ createExternalCommit charlie1 Nothing >>= sendAndConsumeCommitBundle + + -- consume proposals after backend resends them + for_ wss \ws -> do + replicateM 3 do + msg <- consumeMessage (fromJust ws.client) Nothing ws + msg %. "message.content.sender.External" `shouldMatchInt` 0 + + void $ createPendingProposalCommit alice1 >>= sendAndConsumeCommitBundle + + sub <- getSubConversation alice1 conv "conference" >>= getJSON 200 + let members = + map + ( \cid -> + object + [ "client_id" .= cid.client, + "user_id" .= cid.user, + "domain" .= cid.domain + ] + ) + [alice1, alice2, charlie1] + sub %. "members" `shouldMatchSet` members diff --git a/integration/test/Testlib/Cannon.hs b/integration/test/Testlib/Cannon.hs index 9d0bbe22bd9..7b69cf60cad 100644 --- a/integration/test/Testlib/Cannon.hs +++ b/integration/test/Testlib/Cannon.hs @@ -61,6 +61,7 @@ import Data.Function import Data.Maybe import Data.Traversable import Data.Word +import GHC.Records import GHC.Stack import qualified Network.HTTP.Client as HTTP import qualified Network.HTTP.Client as Http @@ -78,11 +79,22 @@ import UnliftIO (withRunInIO) import Prelude data WebSocket = WebSocket - { wsChan :: TChan Value, + { wsConnect :: WSConnect, + wsChan :: TChan Value, wsCloseLatch :: MVar (), wsAppThread :: Async () } +instance HasField "client" WebSocket (Maybe ClientIdentity) where + getField ws = do + c <- ws.wsConnect.client + pure + ClientIdentity + { domain = ws.wsConnect.domain, + user = ws.wsConnect.user, + client = c + } + -- Specifies how a Websocket at cannon should be opened data WSConnect = WSConnect { user :: String, @@ -123,7 +135,7 @@ connect wsConnect = do nchan <- liftIO newTChanIO latch <- liftIO newEmptyMVar wsapp <- run wsConnect (clientApp nchan latch) - pure $ WebSocket nchan latch wsapp + pure $ WebSocket wsConnect nchan latch wsapp clientApp :: (HasCallStack) => TChan Value -> MVar () -> WS.ClientApp () clientApp wsChan latch conn = do From cdd6e0dbdac7560c4f168c42ec8bcdfe1bcc5807 Mon Sep 17 00:00:00 2001 From: Akshay Mankar Date: Thu, 27 Jun 2024 10:10:00 +0200 Subject: [PATCH 46/64] catchErrors middleware: Don't create responses for ThreadKilled errors (#4112) Also don't log anything. This happens when warp decides to reap a worker thread, it could happen because the client has already closed the connection. Creating responses and logging seems unnecessary. Co-authored-by: Paolo Capriotti --- .../5-internal/reduce-thread-killed-log-noise | 1 + .../src/Network/Wai/Utilities/Server.hs | 20 ++++++++++++++----- 2 files changed, 16 insertions(+), 5 deletions(-) create mode 100644 changelog.d/5-internal/reduce-thread-killed-log-noise diff --git a/changelog.d/5-internal/reduce-thread-killed-log-noise b/changelog.d/5-internal/reduce-thread-killed-log-noise new file mode 100644 index 00000000000..177ca9f4d37 --- /dev/null +++ b/changelog.d/5-internal/reduce-thread-killed-log-noise @@ -0,0 +1 @@ +Do not log anything when warp kills a worker thread. \ No newline at end of file diff --git a/libs/wai-utilities/src/Network/Wai/Utilities/Server.hs b/libs/wai-utilities/src/Network/Wai/Utilities/Server.hs index 1a8ae5a68b9..04a1f17c873 100644 --- a/libs/wai-utilities/src/Network/Wai/Utilities/Server.hs +++ b/libs/wai-utilities/src/Network/Wai/Utilities/Server.hs @@ -42,7 +42,6 @@ module Network.Wai.Utilities.Server logError, logError', logErrorMsg, - runHandlers, restrict, flushRequestBody, @@ -53,7 +52,7 @@ module Network.Wai.Utilities.Server where import Control.Error.Util ((?:)) -import Control.Exception (throw) +import Control.Exception (AsyncException (..), throwIO) import Control.Monad.Catch hiding (onError, onException) import Data.Aeson (decode, encode) import Data.ByteString (toStrict) @@ -238,12 +237,23 @@ catchErrorsWithRequestId getRequestId l app req k = -- | Standard handlers for turning exceptions into appropriate -- 'Error' responses. -errorHandlers :: (Applicative m) => [Handler m (Either Wai.Error JSONResponse)] +errorHandlers :: [Handler IO (Either Wai.Error JSONResponse)] errorHandlers = -- a Wai.Error can be converted to a JSONResponse, but doing so here would -- prevent us from logging the error cleanly later [ Handler $ \(x :: JSONResponse) -> pure (Right x), Handler $ \(x :: Wai.Error) -> pure (Left x), + -- warp throws 'ThreadKilled' when the client is gone or when it thinks it's + -- time to reap the worker thread. Here, there is no point trying to respond + -- nicely and there is no point logging this as it happens regularly when a + -- client just closes a long running connection without consuming the whole + -- body. + Handler $ \(x :: AsyncException) -> + case x of + ThreadKilled -> throwIO x + _ -> + pure . Left $ + Wai.mkError status500 "server-error" ("Server Error. " <> LT.pack (displayException x)), Handler $ \(_ :: InvalidRequest) -> pure . Left $ Wai.mkError status400 "client-error" "Invalid Request", @@ -456,8 +466,8 @@ logErrorMsgWithRequest :: Maybe ByteString -> Wai.Error -> Msg -> Msg logErrorMsgWithRequest mr e = field "request" (fromMaybe "N/A" mr) . logErrorMsg e -runHandlers :: SomeException -> [Handler m a] -> m a -runHandlers e [] = throw e +runHandlers :: SomeException -> [Handler IO a] -> IO a +runHandlers e [] = throwIO e runHandlers e (Handler h : hs) = maybe (runHandlers e hs) h (fromException e) restrict :: Int -> Int -> Predicate r P.Error Int -> Predicate r P.Error Int From 57ef0691045504c288b2095a6c41e07d0536f615 Mon Sep 17 00:00:00 2001 From: Matthias Fischmann Date: Fri, 28 Jun 2024 09:37:11 +0200 Subject: [PATCH 47/64] what do you think CI? --- libs/wire-api/src/Wire/API/Password.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/libs/wire-api/src/Wire/API/Password.hs b/libs/wire-api/src/Wire/API/Password.hs index b1e9e8f531a..3ad386e9b96 100644 --- a/libs/wire-api/src/Wire/API/Password.hs +++ b/libs/wire-api/src/Wire/API/Password.hs @@ -104,8 +104,8 @@ defaultParams = defaultOptions :: Argon2idOptions defaultOptions = Argon2.Options - { iterations = 5, - memory = 2 ^ (17 :: Int), + { iterations = 1, + memory = 32, parallelism = 4, variant = Argon2.Argon2id, version = Argon2.Version13 From 99e6f00131e7a803eb2290628c756cd21c6ea471 Mon Sep 17 00:00:00 2001 From: Matthias Fischmann Date: Fri, 28 Jun 2024 09:38:51 +0200 Subject: [PATCH 48/64] Revert "what do you think CI?" This reverts commit 57ef0691045504c288b2095a6c41e07d0536f615. --- libs/wire-api/src/Wire/API/Password.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/libs/wire-api/src/Wire/API/Password.hs b/libs/wire-api/src/Wire/API/Password.hs index 3ad386e9b96..b1e9e8f531a 100644 --- a/libs/wire-api/src/Wire/API/Password.hs +++ b/libs/wire-api/src/Wire/API/Password.hs @@ -104,8 +104,8 @@ defaultParams = defaultOptions :: Argon2idOptions defaultOptions = Argon2.Options - { iterations = 1, - memory = 32, + { iterations = 5, + memory = 2 ^ (17 :: Int), parallelism = 4, variant = Argon2.Argon2id, version = Argon2.Version13 From 71747480bdf2f7a12f0e0807d388612af7f02f39 Mon Sep 17 00:00:00 2001 From: Matthias Fischmann Date: Fri, 28 Jun 2024 09:41:21 +0200 Subject: [PATCH 49/64] Haddocks --- libs/wire-api/src/Wire/API/Password.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/libs/wire-api/src/Wire/API/Password.hs b/libs/wire-api/src/Wire/API/Password.hs index b1e9e8f531a..2c8c7d8215e 100644 --- a/libs/wire-api/src/Wire/API/Password.hs +++ b/libs/wire-api/src/Wire/API/Password.hs @@ -129,7 +129,7 @@ genPassword = liftIO . fmap (plainTextPassword8Unsafe . Text.decodeUtf8 . B64.encode) $ randBytes 12 --- | Stretch a plaintext password so that it can be safely stored. +-- | Salt & hash a plaintext password so that it can be safely stored. mkSafePassword :: (MonadIO m) => PlainTextPassword' t -> m Password mkSafePassword = fmap Password . hashPasswordScrypt . Text.encodeUtf8 . fromPlainTextPassword From cc59adce672f623636bb058382cfdaefd75dcf6d Mon Sep 17 00:00:00 2001 From: Matthias Fischmann Date: Fri, 28 Jun 2024 09:47:47 +0200 Subject: [PATCH 50/64] Roll back from argon2id to scrypt. (deferred to separate PR) --- libs/wire-api/src/Wire/API/Password.hs | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/libs/wire-api/src/Wire/API/Password.hs b/libs/wire-api/src/Wire/API/Password.hs index 2c8c7d8215e..7f4d1481d61 100644 --- a/libs/wire-api/src/Wire/API/Password.hs +++ b/libs/wire-api/src/Wire/API/Password.hs @@ -22,8 +22,8 @@ module Wire.API.Password ( Password, PasswordStatus (..), genPassword, - mkSafePassword, - mkSafePasswordArgon2id, + mkSafePasswordScrypt, + -- mkSafePasswordArgon2id, verifyPassword, verifyPasswordWithStatus, unsafeMkPassword, @@ -130,8 +130,8 @@ genPassword = randBytes 12 -- | Salt & hash a plaintext password so that it can be safely stored. -mkSafePassword :: (MonadIO m) => PlainTextPassword' t -> m Password -mkSafePassword = fmap Password . hashPasswordScrypt . Text.encodeUtf8 . fromPlainTextPassword +mkSafePasswordScrypt :: (MonadIO m) => PlainTextPassword' t -> m Password +mkSafePasswordScrypt = fmap Password . hashPasswordScrypt . Text.encodeUtf8 . fromPlainTextPassword mkSafePasswordArgon2id :: (MonadIO m) => PlainTextPassword' t -> m Password mkSafePasswordArgon2id = fmap Password . hashPasswordArgon2id . Text.encodeUtf8 . fromPlainTextPassword From 3e4a446294e4fb390196aacb7037960ec8f0e60f Mon Sep 17 00:00:00 2001 From: Matthias Fischmann Date: Fri, 28 Jun 2024 09:57:35 +0200 Subject: [PATCH 51/64] Revert accidental commits git revert --no-commit cc59adce672f623636bb058382cfdaefd75dcf6d git revert --no-commit 71747480bdf2f7a12f0e0807d388612af7f02f39 git revert --no-commit 99e6f00131e7a803eb2290628c756cd21c6ea471 git revert --no-commit 57ef0691045504c288b2095a6c41e07d0536f615 --- libs/wire-api/src/Wire/API/Password.hs | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/libs/wire-api/src/Wire/API/Password.hs b/libs/wire-api/src/Wire/API/Password.hs index 7f4d1481d61..b1e9e8f531a 100644 --- a/libs/wire-api/src/Wire/API/Password.hs +++ b/libs/wire-api/src/Wire/API/Password.hs @@ -22,8 +22,8 @@ module Wire.API.Password ( Password, PasswordStatus (..), genPassword, - mkSafePasswordScrypt, - -- mkSafePasswordArgon2id, + mkSafePassword, + mkSafePasswordArgon2id, verifyPassword, verifyPasswordWithStatus, unsafeMkPassword, @@ -129,9 +129,9 @@ genPassword = liftIO . fmap (plainTextPassword8Unsafe . Text.decodeUtf8 . B64.encode) $ randBytes 12 --- | Salt & hash a plaintext password so that it can be safely stored. -mkSafePasswordScrypt :: (MonadIO m) => PlainTextPassword' t -> m Password -mkSafePasswordScrypt = fmap Password . hashPasswordScrypt . Text.encodeUtf8 . fromPlainTextPassword +-- | Stretch a plaintext password so that it can be safely stored. +mkSafePassword :: (MonadIO m) => PlainTextPassword' t -> m Password +mkSafePassword = fmap Password . hashPasswordScrypt . Text.encodeUtf8 . fromPlainTextPassword mkSafePasswordArgon2id :: (MonadIO m) => PlainTextPassword' t -> m Password mkSafePasswordArgon2id = fmap Password . hashPasswordArgon2id . Text.encodeUtf8 . fromPlainTextPassword From 60567210ebb8a5c4c406c7884900ca3997e927d5 Mon Sep 17 00:00:00 2001 From: Leif Battermann Date: Mon, 1 Jul 2024 10:59:25 +0200 Subject: [PATCH 52/64] Move password reset code to AuthenticationSubsystem (#4086) This introduces a new Subsystem: AuthenticationSubsystem along with a few store effects. The new subsystem is not tested with MiniBackend, instead there is a stack of interpreters which are a composition of interpreters that MiniBackend uses. This allows us to mock the UserSubsystem as a whole and not worry about its internals. As a result of this MiniBackend now lives in the tests and not the wire-subsystem library and the intepreters it uses no longer directly depend on `State MiniBackend` but rather on a subset of this state, which can be lifted to `State MiniBackend`. We decided PasswordStore is a separate store even if the password is stored in the user table because most of the time it is accessed independently and it seems simpler that AuthenticationSubsystem is the only thing that cares about it. Drive by fix: Ensure that brig logs request IDs in every place where polysemy logging effect is used. Co-authored-by: Matthias Fischmann Co-authored-by: Akshay Mankar --- changelog.d/3-bug-fixes/WPB-8890 | 1 + changelog.d/5-internal/WPB-8890-subsystems | 1 + .../wire-api/src/Wire/API}/Allowlists.hs | 2 +- libs/wire-api/src/Wire/API/Password.hs | 77 ++--- libs/wire-api/src/Wire/API/User/Auth.hs | 26 ++ libs/wire-api/src/Wire/API/User/Password.hs | 15 +- .../test/unit/Test/Wire/API/Password.hs | 8 + libs/wire-api/wire-api.cabal | 1 + libs/wire-subsystems/default.nix | 3 + .../src/Wire/AuthenticationSubsystem.hs | 25 +- .../src/Wire/AuthenticationSubsystem/Error.hs | 45 +++ .../AuthenticationSubsystem/Interpreter.hs | 217 +++++++++++++ libs/wire-subsystems/src/Wire/HashPassword.hs | 18 ++ .../src/Wire/PasswordResetCodeStore.hs | 34 +- .../Wire/PasswordResetCodeStore}/Cassandra.hs | 20 +- .../wire-subsystems/src/Wire/PasswordStore.hs | 14 + .../src/Wire/PasswordStore/Cassandra.hs | 36 +++ libs/wire-subsystems/src/Wire/SessionStore.hs | 25 ++ .../src/Wire/SessionStore/Cassandra.hs | 40 ++- libs/wire-subsystems/src/Wire/StoredUser.hs | 6 + libs/wire-subsystems/src/Wire/UserKeyStore.hs | 118 +++++++ .../src/Wire/UserKeyStore/Cassandra.hs | 92 ++++++ libs/wire-subsystems/src/Wire/UserStore.hs | 4 + .../src/Wire/UserStore/Cassandra.hs | 18 ++ .../wire-subsystems/src/Wire/UserSubsystem.hs | 2 + .../src/Wire/UserSubsystem/Error.hs | 32 ++ .../src/Wire/UserSubsystem/Interpreter.hs | 21 +- .../InterpreterSpec.hs | 290 ++++++++++++++++++ .../{src => test/unit}/Wire/MiniBackend.hs | 221 ++++++------- .../test/unit/Wire/MockInterpreters.hs | 16 + .../test/unit/Wire/MockInterpreters/Error.hs | 15 + .../Wire/MockInterpreters/GalleyAPIAccess.hs | 19 ++ .../Wire/MockInterpreters/HashPassword.hs | 28 ++ .../test/unit/Wire/MockInterpreters/Now.hs | 22 ++ .../PasswordResetCodeStore.hs | 28 ++ .../Wire/MockInterpreters/PasswordStore.hs | 14 + .../Wire/MockInterpreters/SessionStore.hs | 17 + .../unit/Wire/MockInterpreters/UserEvents.hs | 20 ++ .../Wire/MockInterpreters/UserKeyStore.hs | 31 ++ .../unit/Wire/MockInterpreters/UserStore.hs | 78 +++++ .../Wire/MockInterpreters/UserSubsystem.hs | 16 + .../Wire/UserSubsystem/InterpreterSpec.hs | 55 +++- libs/wire-subsystems/wire-subsystems.cabal | 30 +- services/brig/brig.cabal | 9 +- services/brig/default.nix | 1 + services/brig/src/Brig/API/Auth.hs | 18 +- services/brig/src/Brig/API/Connection.hs | 3 + .../brig/src/Brig/API/Connection/Remote.hs | 2 + services/brig/src/Brig/API/Connection/Util.hs | 9 +- services/brig/src/Brig/API/Federation.hs | 3 +- services/brig/src/Brig/API/Handler.hs | 2 +- services/brig/src/Brig/API/Internal.hs | 36 ++- services/brig/src/Brig/API/OAuth.hs | 4 +- services/brig/src/Brig/API/Public.hs | 62 ++-- services/brig/src/Brig/API/Types.hs | 2 +- services/brig/src/Brig/API/User.hs | 166 +++------- services/brig/src/Brig/AWS/SesNotification.hs | 2 +- services/brig/src/Brig/App.hs | 25 +- .../brig/src/Brig/CanonicalInterpreter.hs | 44 ++- services/brig/src/Brig/Data/Activation.hs | 15 +- services/brig/src/Brig/Data/Client.hs | 1 - services/brig/src/Brig/Data/LoginCode.hs | 1 - services/brig/src/Brig/Data/User.hs | 55 +--- services/brig/src/Brig/Data/UserKey.hs | 146 --------- .../brig/src/Brig/Effects/BlacklistStore.hs | 2 +- .../Brig/Effects/BlacklistStore/Cassandra.hs | 2 +- .../Effects/PasswordResetStore/CodeStore.hs | 99 ------ services/brig/src/Brig/Email.hs | 34 +- .../brig/src/Brig/InternalEvent/Process.hs | 2 + services/brig/src/Brig/Options.hs | 6 +- services/brig/src/Brig/Phone.hs | 22 +- services/brig/src/Brig/Provider/API.hs | 4 +- services/brig/src/Brig/Provider/DB.hs | 2 +- services/brig/src/Brig/Run.hs | 6 +- services/brig/src/Brig/Team/API.hs | 14 +- services/brig/src/Brig/User/Auth.hs | 55 ++-- services/brig/src/Brig/User/Auth/Cookie.hs | 30 +- .../brig/src/Brig/User/Auth/DB/Instances.hs | 53 ---- .../brig/test/integration/API/Internal.hs | 10 +- .../brig/test/integration/API/User/Auth.hs | 13 +- .../integration/API/User/PasswordReset.hs | 34 +- .../brig/test/integration/API/User/Util.hs | 10 +- services/galley/src/Galley/API/Update.hs | 4 +- tools/db/inconsistencies/default.nix | 2 + .../db/inconsistencies/inconsistencies.cabal | 1 + .../inconsistencies/src/DanglingUserKeys.hs | 4 +- .../db/inconsistencies/src/EmailLessUsers.hs | 2 +- 87 files changed, 1904 insertions(+), 914 deletions(-) create mode 100644 changelog.d/3-bug-fixes/WPB-8890 create mode 100644 changelog.d/5-internal/WPB-8890-subsystems rename {services/brig/src/Brig => libs/wire-api/src/Wire/API}/Allowlists.hs (98%) rename services/brig/src/Brig/Effects/PasswordResetStore.hs => libs/wire-subsystems/src/Wire/AuthenticationSubsystem.hs (64%) create mode 100644 libs/wire-subsystems/src/Wire/AuthenticationSubsystem/Error.hs create mode 100644 libs/wire-subsystems/src/Wire/AuthenticationSubsystem/Interpreter.hs create mode 100644 libs/wire-subsystems/src/Wire/HashPassword.hs rename services/brig/src/Brig/Effects/CodeStore.hs => libs/wire-subsystems/src/Wire/PasswordResetCodeStore.hs (59%) rename {services/brig/src/Brig/Effects/CodeStore => libs/wire-subsystems/src/Wire/PasswordResetCodeStore}/Cassandra.hs (85%) create mode 100644 libs/wire-subsystems/src/Wire/PasswordStore.hs create mode 100644 libs/wire-subsystems/src/Wire/PasswordStore/Cassandra.hs create mode 100644 libs/wire-subsystems/src/Wire/SessionStore.hs rename services/brig/src/Brig/User/Auth/DB/Cookie.hs => libs/wire-subsystems/src/Wire/SessionStore/Cassandra.hs (71%) create mode 100644 libs/wire-subsystems/src/Wire/UserKeyStore.hs create mode 100644 libs/wire-subsystems/src/Wire/UserKeyStore/Cassandra.hs create mode 100644 libs/wire-subsystems/src/Wire/UserSubsystem/Error.hs create mode 100644 libs/wire-subsystems/test/unit/Wire/AuthenticationSubsystem/InterpreterSpec.hs rename libs/wire-subsystems/{src => test/unit}/Wire/MiniBackend.hs (69%) create mode 100644 libs/wire-subsystems/test/unit/Wire/MockInterpreters.hs create mode 100644 libs/wire-subsystems/test/unit/Wire/MockInterpreters/Error.hs create mode 100644 libs/wire-subsystems/test/unit/Wire/MockInterpreters/GalleyAPIAccess.hs create mode 100644 libs/wire-subsystems/test/unit/Wire/MockInterpreters/HashPassword.hs create mode 100644 libs/wire-subsystems/test/unit/Wire/MockInterpreters/Now.hs create mode 100644 libs/wire-subsystems/test/unit/Wire/MockInterpreters/PasswordResetCodeStore.hs create mode 100644 libs/wire-subsystems/test/unit/Wire/MockInterpreters/PasswordStore.hs create mode 100644 libs/wire-subsystems/test/unit/Wire/MockInterpreters/SessionStore.hs create mode 100644 libs/wire-subsystems/test/unit/Wire/MockInterpreters/UserEvents.hs create mode 100644 libs/wire-subsystems/test/unit/Wire/MockInterpreters/UserKeyStore.hs create mode 100644 libs/wire-subsystems/test/unit/Wire/MockInterpreters/UserStore.hs create mode 100644 libs/wire-subsystems/test/unit/Wire/MockInterpreters/UserSubsystem.hs delete mode 100644 services/brig/src/Brig/Data/UserKey.hs delete mode 100644 services/brig/src/Brig/Effects/PasswordResetStore/CodeStore.hs delete mode 100644 services/brig/src/Brig/User/Auth/DB/Instances.hs diff --git a/changelog.d/3-bug-fixes/WPB-8890 b/changelog.d/3-bug-fixes/WPB-8890 new file mode 100644 index 00000000000..f462e51abe5 --- /dev/null +++ b/changelog.d/3-bug-fixes/WPB-8890 @@ -0,0 +1 @@ +Log request ids in brig. diff --git a/changelog.d/5-internal/WPB-8890-subsystems b/changelog.d/5-internal/WPB-8890-subsystems new file mode 100644 index 00000000000..7e5a1a62024 --- /dev/null +++ b/changelog.d/5-internal/WPB-8890-subsystems @@ -0,0 +1 @@ +Introduce authentication subsystem with password reset. diff --git a/services/brig/src/Brig/Allowlists.hs b/libs/wire-api/src/Wire/API/Allowlists.hs similarity index 98% rename from services/brig/src/Brig/Allowlists.hs rename to libs/wire-api/src/Wire/API/Allowlists.hs index af2e0c7be10..c624d4c6bbd 100644 --- a/services/brig/src/Brig/Allowlists.hs +++ b/libs/wire-api/src/Wire/API/Allowlists.hs @@ -18,7 +18,7 @@ -- | > docs/reference/user/activation.md {#RefActivationAllowlist} -- -- Email/phone whitelist. -module Brig.Allowlists +module Wire.API.Allowlists ( AllowlistEmailDomains (..), AllowlistPhonePrefixes (..), verify, diff --git a/libs/wire-api/src/Wire/API/Password.hs b/libs/wire-api/src/Wire/API/Password.hs index b1e9e8f531a..6090f9ae6c7 100644 --- a/libs/wire-api/src/Wire/API/Password.hs +++ b/libs/wire-api/src/Wire/API/Password.hs @@ -22,11 +22,13 @@ module Wire.API.Password ( Password, PasswordStatus (..), genPassword, - mkSafePassword, + mkSafePasswordScrypt, mkSafePasswordArgon2id, verifyPassword, verifyPasswordWithStatus, unsafeMkPassword, + hashPasswordArgon2idWithSalt, + hashPasswordArgon2idWithOptions, ) where @@ -90,8 +92,8 @@ data ScryptParameters = ScryptParameters } deriving (Eq, Show) -defaultParams :: ScryptParameters -defaultParams = +defaultScryptParams :: ScryptParameters +defaultScryptParams = ScryptParameters { saltLength = 32, rounds = 14, @@ -129,9 +131,8 @@ genPassword = liftIO . fmap (plainTextPassword8Unsafe . Text.decodeUtf8 . B64.encode) $ randBytes 12 --- | Stretch a plaintext password so that it can be safely stored. -mkSafePassword :: (MonadIO m) => PlainTextPassword' t -> m Password -mkSafePassword = fmap Password . hashPasswordScrypt . Text.encodeUtf8 . fromPlainTextPassword +mkSafePasswordScrypt :: (MonadIO m) => PlainTextPassword' t -> m Password +mkSafePasswordScrypt = fmap Password . hashPasswordScrypt . Text.encodeUtf8 . fromPlainTextPassword mkSafePasswordArgon2id :: (MonadIO m) => PlainTextPassword' t -> m Password mkSafePasswordArgon2id = fmap Password . hashPasswordArgon2id . Text.encodeUtf8 . fromPlainTextPassword @@ -147,44 +148,50 @@ verifyPasswordWithStatus plain opaque = expected = fromPassword opaque in checkPassword actual expected -hashPasswordArgon2id :: (MonadIO m) => ByteString -> m Text -hashPasswordArgon2id pwd = do - salt <- newSalt $ fromIntegral defaultParams.saltLength - let key = hashPasswordWithOptions defaultOptions pwd salt - opts = - Text.intercalate - "," - [ "m=" <> showT defaultOptions.memory, - "t=" <> showT defaultOptions.iterations, - "p=" <> showT defaultOptions.parallelism - ] - pure $ - "$argon2" - <> Text.intercalate - "$" - [ variantToCode defaultOptions.variant, - "v=" <> versionToNum defaultOptions.version, - opts, - encodeWithoutPadding salt, - encodeWithoutPadding key - ] - where - encodeWithoutPadding = Text.dropWhileEnd (== '=') . Text.decodeUtf8 . B64.encode - hashPasswordScrypt :: (MonadIO m) => ByteString -> m Text hashPasswordScrypt password = do - salt <- newSalt $ fromIntegral defaultParams.saltLength - let key = hashPasswordWithParams defaultParams password salt + salt <- newSalt $ fromIntegral defaultScryptParams.saltLength + let key = hashPasswordWithParams defaultScryptParams password salt pure $ Text.intercalate "|" - [ showT defaultParams.rounds, - showT defaultParams.blockSize, - showT defaultParams.parallelism, + [ showT defaultScryptParams.rounds, + showT defaultScryptParams.blockSize, + showT defaultScryptParams.parallelism, Text.decodeUtf8 . B64.encode $ salt, Text.decodeUtf8 . B64.encode $ key ] +hashPasswordArgon2id :: (MonadIO m) => ByteString -> m Text +hashPasswordArgon2id pwd = do + salt <- newSalt 32 + pure $ hashPasswordArgon2idWithSalt salt pwd + +hashPasswordArgon2idWithSalt :: ByteString -> ByteString -> Text +hashPasswordArgon2idWithSalt = hashPasswordArgon2idWithOptions defaultOptions + +hashPasswordArgon2idWithOptions :: Argon2idOptions -> ByteString -> ByteString -> Text +hashPasswordArgon2idWithOptions opts salt pwd = do + let key = hashPasswordWithOptions opts pwd salt + optsStr = + Text.intercalate + "," + [ "m=" <> showT opts.memory, + "t=" <> showT opts.iterations, + "p=" <> showT opts.parallelism + ] + in "$argon2" + <> Text.intercalate + "$" + [ variantToCode opts.variant, + "v=" <> versionToNum opts.version, + optsStr, + encodeWithoutPadding salt, + encodeWithoutPadding key + ] + where + encodeWithoutPadding = Text.dropWhileEnd (== '=') . Text.decodeUtf8 . B64.encode + checkPassword :: Text -> Text -> (Bool, PasswordStatus) checkPassword actual expected = case parseArgon2idPasswordHashOptions expected of diff --git a/libs/wire-api/src/Wire/API/User/Auth.hs b/libs/wire-api/src/Wire/API/User/Auth.hs index 3206b173747..ad49c8be0b8 100644 --- a/libs/wire-api/src/Wire/API/User/Auth.hs +++ b/libs/wire-api/src/Wire/API/User/Auth.hs @@ -38,6 +38,7 @@ module Wire.API.User.Auth Cookie (..), CookieLabel (..), RemoveCookies (..), + toUnitCookie, -- * Token AccessToken (..), @@ -59,6 +60,7 @@ module Wire.API.User.Auth ) where +import Cassandra import Control.Applicative import Control.Lens ((?~), (^.)) import Control.Lens.TH @@ -140,6 +142,8 @@ newtype LoginCode = LoginCode deriving newtype (Arbitrary) deriving (FromJSON, ToJSON, S.ToSchema) via Schema LoginCode +deriving instance Cql LoginCode + instance ToSchema LoginCode where schema = LoginCode <$> fromLoginCode .= text "LoginCode" @@ -281,11 +285,20 @@ newtype CookieLabel = CookieLabel ToSchema ) +deriving instance Cql CookieLabel + newtype CookieId = CookieId {cookieIdNum :: Word32} deriving stock (Eq, Show, Generic) deriving newtype (ToSchema, FromJSON, ToJSON, Arbitrary) +instance Cql CookieId where + ctype = Cassandra.Tagged BigIntColumn + toCql = CqlBigInt . fromIntegral . cookieIdNum + + fromCql (CqlBigInt i) = pure (CookieId (fromIntegral i)) + fromCql _ = Left "fromCql: invalid cookie id" + data CookieType = -- | A session cookie. These are mainly intended for clients -- that are web browsers. For other clients, session cookies @@ -301,12 +314,25 @@ data CookieType deriving (Arbitrary) via (GenericUniform CookieType) deriving (FromJSON, ToJSON, S.ToSchema) via Schema CookieType +instance Cql CookieType where + ctype = Cassandra.Tagged IntColumn + + toCql SessionCookie = CqlInt 0 + toCql PersistentCookie = CqlInt 1 + + fromCql (CqlInt 0) = pure SessionCookie + fromCql (CqlInt 1) = pure PersistentCookie + fromCql _ = Left "fromCql: invalid cookie type" + instance ToSchema CookieType where schema = enum @Text "CookieType" $ element "session" SessionCookie <> element "persistent" PersistentCookie +toUnitCookie :: Cookie a -> Cookie () +toUnitCookie c = c {cookieValue = ()} + -------------------------------------------------------------------------------- -- Login diff --git a/libs/wire-api/src/Wire/API/User/Password.hs b/libs/wire-api/src/Wire/API/User/Password.hs index a4c3f92c2ae..e9d1eb7ae28 100644 --- a/libs/wire-api/src/Wire/API/User/Password.hs +++ b/libs/wire-api/src/Wire/API/User/Password.hs @@ -24,6 +24,7 @@ module Wire.API.User.Password CompletePasswordReset (..), PasswordResetIdentity (..), PasswordResetKey (..), + mkPasswordResetKey, PasswordResetCode (..), -- * deprecated @@ -33,9 +34,13 @@ where import Cassandra qualified as C import Control.Lens ((?~)) +import Crypto.Hash import Data.Aeson qualified as A import Data.Aeson.Types (Parser) +import Data.ByteArray qualified as ByteArray +import Data.ByteString qualified as BS import Data.ByteString.Conversion +import Data.Id import Data.Misc (PlainTextPassword8) import Data.OpenApi qualified as S import Data.OpenApi.ParamSchema @@ -172,9 +177,17 @@ data PasswordResetIdentity -- | Opaque identifier per user (SHA256 of the user ID). newtype PasswordResetKey = PasswordResetKey {fromPasswordResetKey :: AsciiBase64Url} - deriving stock (Eq, Show) + deriving stock (Eq, Show, Ord) deriving newtype (ToSchema, FromByteString, ToByteString, A.FromJSON, A.ToJSON, Arbitrary) +mkPasswordResetKey :: UserId -> PasswordResetKey +mkPasswordResetKey userId = + PasswordResetKey + . encodeBase64Url + . BS.pack + . ByteArray.unpack + $ hashWith SHA256 (toByteString' userId) + instance ToParamSchema PasswordResetKey where toParamSchema _ = toParamSchema (Proxy @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 43f5e5c7728..e55bf2ff6cf 100644 --- a/libs/wire-api/test/unit/Test/Wire/API/Password.hs +++ b/libs/wire-api/test/unit/Test/Wire/API/Password.hs @@ -32,6 +32,14 @@ tests = testCase "verify old scrypt password still works" testHashingOldScrypt ] +testHashPasswordScrypt :: IO () +testHashPasswordScrypt = do + pwd <- genPassword + hashed <- mkSafePasswordScrypt pwd + let (correct, status) = verifyPasswordWithStatus pwd hashed + assertBool "Password could not be verified" correct + assertEqual "Password could not be verified" status PasswordStatusOk + testHashPasswordArgon2id :: IO () testHashPasswordArgon2id = do pwd <- genPassword diff --git a/libs/wire-api/wire-api.cabal b/libs/wire-api/wire-api.cabal index 4cb54116bdb..69e4c6ead1a 100644 --- a/libs/wire-api/wire-api.cabal +++ b/libs/wire-api/wire-api.cabal @@ -68,6 +68,7 @@ library -- cabal-fmt: expand src exposed-modules: + Wire.API.Allowlists Wire.API.ApplyMods Wire.API.Asset Wire.API.Bot diff --git a/libs/wire-subsystems/default.nix b/libs/wire-subsystems/default.nix index 0d37cbf39e9..c6c2c5a6f8b 100644 --- a/libs/wire-subsystems/default.nix +++ b/libs/wire-subsystems/default.nix @@ -16,6 +16,7 @@ , cassandra-util , containers , cql +, crypton , currency-codes , data-default , data-timeout @@ -130,6 +131,7 @@ mkDerivation { bilge bytestring containers + crypton data-default errors extended @@ -148,6 +150,7 @@ mkDerivation { string-conversions text time + tinylog transformers types-common wire-api diff --git a/services/brig/src/Brig/Effects/PasswordResetStore.hs b/libs/wire-subsystems/src/Wire/AuthenticationSubsystem.hs similarity index 64% rename from services/brig/src/Brig/Effects/PasswordResetStore.hs rename to libs/wire-subsystems/src/Wire/AuthenticationSubsystem.hs index aab8274893e..57cae3087d9 100644 --- a/services/brig/src/Brig/Effects/PasswordResetStore.hs +++ b/libs/wire-subsystems/src/Wire/AuthenticationSubsystem.hs @@ -16,25 +16,20 @@ -- with this program. If not, see . {-# LANGUAGE TemplateHaskell #-} -module Brig.Effects.PasswordResetStore where +module Wire.AuthenticationSubsystem where -import Brig.Types.User (PasswordResetPair) import Data.Id +import Data.Misc import Imports import Polysemy -import Wire.API.User.Identity +import Wire.API.User import Wire.API.User.Password +import Wire.UserKeyStore -data PasswordResetStore m a where - CreatePasswordResetCode :: - UserId -> - Either Email Phone -> - PasswordResetStore m PasswordResetPair - LookupPasswordResetCode :: - UserId -> - PasswordResetStore m (Maybe PasswordResetCode) - VerifyPasswordResetCode :: - PasswordResetPair -> - PasswordResetStore m (Maybe UserId) +data AuthenticationSubsystem m a where + CreatePasswordResetCode :: UserKey -> AuthenticationSubsystem m (UserId, PasswordResetPair) + ResetPassword :: PasswordResetIdentity -> PasswordResetCode -> PlainTextPassword8 -> AuthenticationSubsystem m () + -- For testing + InternalLookupPasswordResetCode :: UserKey -> AuthenticationSubsystem m (Maybe PasswordResetPair) -makeSem ''PasswordResetStore +makeSem ''AuthenticationSubsystem diff --git a/libs/wire-subsystems/src/Wire/AuthenticationSubsystem/Error.hs b/libs/wire-subsystems/src/Wire/AuthenticationSubsystem/Error.hs new file mode 100644 index 00000000000..739cd8c25f8 --- /dev/null +++ b/libs/wire-subsystems/src/Wire/AuthenticationSubsystem/Error.hs @@ -0,0 +1,45 @@ +-- This file is part of the Wire Server implementation. +-- +-- Copyright (C) 2024 Wire Swiss GmbH +-- +-- This program is free software: you can redistribute it and/or modify it under +-- the terms of the GNU Affero General Public License as published by the Free +-- Software Foundation, either version 3 of the License, or (at your option) any +-- later version. +-- +-- This program is distributed in the hope that it will be useful, but WITHOUT +-- ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS +-- FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for more +-- details. +-- +-- You should have received a copy of the GNU Affero General Public License along +-- with this program. If not, see . +module Wire.AuthenticationSubsystem.Error + ( AuthenticationSubsystemError (..), + authenticationSubsystemErrorToWai, + ) +where + +import Imports +import Network.Wai.Utilities.Error qualified as Wai +import Wire.API.Error +import Wire.API.Error.Brig qualified as E + +data AuthenticationSubsystemError + = AuthenticationSubsystemInvalidPasswordResetKey + | AuthenticationSubsystemPasswordResetInProgress + | AuthenticationSubsystemResetPasswordMustDiffer + | AuthenticationSubsystemInvalidPasswordResetCode + | AuthenticationSubsystemAllowListError + deriving (Eq, Show) + +instance Exception AuthenticationSubsystemError + +authenticationSubsystemErrorToWai :: AuthenticationSubsystemError -> Wai.Error +authenticationSubsystemErrorToWai = + dynErrorToWai . \case + AuthenticationSubsystemInvalidPasswordResetKey -> dynError @(MapError E.InvalidPasswordResetKey) + AuthenticationSubsystemPasswordResetInProgress -> dynError @(MapError E.PasswordResetInProgress) + AuthenticationSubsystemInvalidPasswordResetCode -> dynError @(MapError E.InvalidPasswordResetCode) + AuthenticationSubsystemResetPasswordMustDiffer -> dynError @(MapError E.ResetPasswordMustDiffer) + AuthenticationSubsystemAllowListError -> dynError @(MapError E.AllowlistError) diff --git a/libs/wire-subsystems/src/Wire/AuthenticationSubsystem/Interpreter.hs b/libs/wire-subsystems/src/Wire/AuthenticationSubsystem/Interpreter.hs new file mode 100644 index 00000000000..f2a344e13a6 --- /dev/null +++ b/libs/wire-subsystems/src/Wire/AuthenticationSubsystem/Interpreter.hs @@ -0,0 +1,217 @@ +-- This file is part of the Wire Server implementation. +-- +-- Copyright (C) 2022 Wire Swiss GmbH +-- +-- This program is free software: you can redistribute it and/or modify it under +-- the terms of the GNU Affero General Public License as published by the Free +-- Software Foundation, either version 3 of the License, or (at your option) any +-- later version. +-- +-- This program is distributed in the hope that it will be useful, but WITHOUT +-- ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS +-- FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for more +-- details. +-- +-- You should have received a copy of the GNU Affero General Public License along +-- with this program. If not, see . + +module Wire.AuthenticationSubsystem.Interpreter + ( interpretAuthenticationSubsystem, + passwordResetCodeTtl, + module Wire.AuthenticationSubsystem.Error, + ) +where + +import Data.ByteString.Conversion +import Data.Id +import Data.Misc +import Data.Qualified +import Data.Time +import Imports hiding (lookup) +import Polysemy +import Polysemy.Error +import Polysemy.Input +import Polysemy.TinyLog (TinyLog) +import Polysemy.TinyLog qualified as Log +import System.Logger +import Wire.API.Allowlists (AllowlistEmailDomains, AllowlistPhonePrefixes) +import Wire.API.Allowlists qualified as AllowLists +import Wire.API.Password +import Wire.API.User +import Wire.API.User.Password +import Wire.AuthenticationSubsystem +import Wire.AuthenticationSubsystem.Error +import Wire.HashPassword +import Wire.PasswordResetCodeStore +import Wire.PasswordStore +import Wire.Sem.Now +import Wire.Sem.Now qualified as Now +import Wire.SessionStore +import Wire.UserKeyStore +import Wire.UserSubsystem (UserSubsystem, getLocalUserAccountByUserKey) + +interpretAuthenticationSubsystem :: + forall r. + ( Member PasswordResetCodeStore r, + Member Now r, + Member (Error AuthenticationSubsystemError) r, + Member TinyLog r, + Member HashPassword r, + Member SessionStore r, + Member (Input (Local ())) r, + Member (Input (Maybe AllowlistEmailDomains)) r, + Member (Input (Maybe AllowlistPhonePrefixes)) r, + Member UserSubsystem r, + Member PasswordStore r + ) => + InterpreterFor AuthenticationSubsystem r +interpretAuthenticationSubsystem = interpret $ \case + CreatePasswordResetCode userKey -> createPasswordResetCodeImpl userKey + ResetPassword ident resetCode newPassword -> resetPasswordImpl ident resetCode newPassword + InternalLookupPasswordResetCode userKey -> internalLookupPasswordResetCodeImpl userKey + +maxAttempts :: Int32 +maxAttempts = 3 + +passwordResetCodeTtl :: NominalDiffTime +passwordResetCodeTtl = 3600 -- 60 minutes + +createPasswordResetCodeImpl :: + ( Member PasswordResetCodeStore r, + Member Now r, + Member (Input (Local ())) r, + Member (Input (Maybe AllowlistEmailDomains)) r, + Member (Input (Maybe AllowlistPhonePrefixes)) r, + Member (Error AuthenticationSubsystemError) r, + Member TinyLog r, + Member UserSubsystem r + ) => + UserKey -> + Sem r (UserId, PasswordResetPair) +createPasswordResetCodeImpl target = do + allowListOk <- (\e p -> AllowLists.verify e p (toEither target)) <$> input <*> input + unless allowListOk $ throw AuthenticationSubsystemAllowListError + user <- lookupActiveUserIdByUserKey target >>= maybe (throw AuthenticationSubsystemInvalidPasswordResetKey) pure + Log.debug $ field "user" (toByteString user) . field "action" (val "User.beginPasswordReset") + + mExistingCode <- lookupPasswordResetCode user + when (isJust mExistingCode) $ + throw AuthenticationSubsystemPasswordResetInProgress + + let key = mkPasswordResetKey user + now <- Now.get + code <- foldKey (const generateEmailCode) (const generatePhoneCode) target + codeInsert + key + (PRQueryData code user (Identity maxAttempts) (Identity (passwordResetCodeTtl `addUTCTime` now))) + (round passwordResetCodeTtl) + pure (user, (key, code)) + +lookupActiveUserIdByUserKey :: (Member UserSubsystem r, Member (Input (Local ())) r) => UserKey -> Sem r (Maybe UserId) +lookupActiveUserIdByUserKey target = do + localUnit <- input + let ltarget = qualifyAs localUnit target + mUser <- getLocalUserAccountByUserKey ltarget + case mUser of + Just user -> do + pure $ + if user.accountStatus == Active + then Just $ userId user.accountUser + else Nothing + Nothing -> pure Nothing + +internalLookupPasswordResetCodeImpl :: + ( Member PasswordResetCodeStore r, + Member Now r, + Member (Input (Local ())) r, + Member UserSubsystem r + ) => + UserKey -> + Sem r (Maybe PasswordResetPair) +internalLookupPasswordResetCodeImpl key = do + mUser <- lookupActiveUserIdByUserKey key + case mUser of + Just user -> do + mCode <- lookupPasswordResetCode user + let k = mkPasswordResetKey user + pure $ (k,) <$> mCode + Nothing -> pure Nothing + +lookupPasswordResetCode :: + ( Member PasswordResetCodeStore r, + Member Now r + ) => + UserId -> + Sem r (Maybe PasswordResetCode) +lookupPasswordResetCode u = do + let key = mkPasswordResetKey u + now <- Now.get + validate now =<< codeSelect key + where + validate now (Just (PRQueryData c _ _ (Just t))) | t > now = pure $ Just c + validate _ _ = pure Nothing + +resetPasswordImpl :: + forall r. + ( Member PasswordResetCodeStore r, + Member Now r, + Member (Input (Local ())) r, + Member (Error AuthenticationSubsystemError) r, + Member TinyLog r, + Member UserSubsystem r, + Member HashPassword r, + Member SessionStore r, + Member PasswordStore r + ) => + PasswordResetIdentity -> + PasswordResetCode -> + PlainTextPassword8 -> + Sem r () +resetPasswordImpl ident code pw = do + key <- passwordResetKeyFromIdentity + + muid :: Maybe UserId <- verify (key, code) + case muid of + Nothing -> throw AuthenticationSubsystemInvalidPasswordResetCode + Just uid -> do + Log.debug $ field "user" (toByteString uid) . field "action" (val "User.completePasswordReset") + checkNewIsDifferent uid pw + hashedPw <- hashPassword pw + upsertHashedPassword uid hashedPw + codeDelete key + deleteAllCookies uid + where + passwordResetKeyFromIdentity :: Sem r PasswordResetKey + passwordResetKeyFromIdentity = case ident of + PasswordResetIdentityKey k -> pure k + PasswordResetEmailIdentity e -> do + mUserId <- lookupActiveUserIdByUserKey (userEmailKey e) + let mResetKey = mkPasswordResetKey <$> mUserId + maybe (throw AuthenticationSubsystemInvalidPasswordResetKey) pure mResetKey + PasswordResetPhoneIdentity p -> do + mUserId <- lookupActiveUserIdByUserKey (userPhoneKey p) + let mResetKey = mkPasswordResetKey <$> mUserId + maybe (throw AuthenticationSubsystemInvalidPasswordResetKey) pure mResetKey + + checkNewIsDifferent :: UserId -> PlainTextPassword' t -> Sem r () + checkNewIsDifferent uid newPassword = do + mCurrentPassword <- lookupHashedPassword uid + case mCurrentPassword of + Just currentPassword + | (verifyPassword newPassword currentPassword) -> throw AuthenticationSubsystemResetPasswordMustDiffer + _ -> pure () + + verify :: PasswordResetPair -> Sem r (Maybe UserId) + verify (k, c) = do + now <- Now.get + passwordResetData <- codeSelect k + case passwordResetData of + Just (PRQueryData codeInDB u _ (Just t)) | c == codeInDB && t >= now -> pure (Just u) + Just (PRQueryData codeInDB u (Just n) (Just t)) | n > 1 && t > now -> do + -- If we only update retries, there is a chance that this races with + -- the PasswordResetCodeTtl and we have a situation where only retries is non-null for + -- a given key. To avoid this, we insert the whole row again. + codeInsert k (PRQueryData codeInDB u (Identity (n - 1)) (Identity t)) (round passwordResetCodeTtl) + pure Nothing + Just PRQueryData {} -> codeDelete k $> Nothing + Nothing -> pure Nothing diff --git a/libs/wire-subsystems/src/Wire/HashPassword.hs b/libs/wire-subsystems/src/Wire/HashPassword.hs new file mode 100644 index 00000000000..54c65c3ee74 --- /dev/null +++ b/libs/wire-subsystems/src/Wire/HashPassword.hs @@ -0,0 +1,18 @@ +{-# LANGUAGE TemplateHaskell #-} + +module Wire.HashPassword where + +import Data.Misc +import Imports +import Polysemy +import Wire.API.Password (Password) +import Wire.API.Password qualified as Password + +data HashPassword m a where + HashPassword :: PlainTextPassword8 -> HashPassword m Password + +makeSem ''HashPassword + +runHashPassword :: (Member (Embed IO) r) => InterpreterFor HashPassword r +runHashPassword = interpret $ \case + HashPassword pw -> liftIO $ Password.mkSafePasswordScrypt pw diff --git a/services/brig/src/Brig/Effects/CodeStore.hs b/libs/wire-subsystems/src/Wire/PasswordResetCodeStore.hs similarity index 59% rename from services/brig/src/Brig/Effects/CodeStore.hs rename to libs/wire-subsystems/src/Wire/PasswordResetCodeStore.hs index 96f3e7c63be..dbf5502fc4a 100644 --- a/services/brig/src/Brig/Effects/CodeStore.hs +++ b/libs/wire-subsystems/src/Wire/PasswordResetCodeStore.hs @@ -16,7 +16,7 @@ -- with this program. If not, see . {-# LANGUAGE TemplateHaskell #-} -module Brig.Effects.CodeStore where +module Wire.PasswordResetCodeStore where import Data.Id import Data.Time.Clock @@ -33,18 +33,20 @@ data PRQueryData f = PRQueryData prqdTimeout :: f UTCTime } -data CodeStore m a where - MkPasswordResetKey :: UserId -> CodeStore m PasswordResetKey - GenerateEmailCode :: CodeStore m PasswordResetCode - GeneratePhoneCode :: CodeStore m PasswordResetCode - CodeSelect :: - PasswordResetKey -> - CodeStore m (Maybe (PRQueryData Maybe)) - CodeInsert :: - PasswordResetKey -> - PRQueryData Identity -> - Int32 -> - CodeStore m () - CodeDelete :: PasswordResetKey -> CodeStore m () - -makeSem ''CodeStore +deriving instance Show (PRQueryData Identity) + +deriving instance Eq (PRQueryData Maybe) + +deriving instance Show (PRQueryData Maybe) + +mapPRQueryData :: (forall a. (f1 a -> f2 a)) -> PRQueryData f1 -> PRQueryData f2 +mapPRQueryData f prqd = prqd {prqdRetries = f prqd.prqdRetries, prqdTimeout = f prqd.prqdTimeout} + +data PasswordResetCodeStore m a where + GenerateEmailCode :: PasswordResetCodeStore m PasswordResetCode + GeneratePhoneCode :: PasswordResetCodeStore m PasswordResetCode + CodeSelect :: PasswordResetKey -> PasswordResetCodeStore m (Maybe (PRQueryData Maybe)) + CodeInsert :: PasswordResetKey -> PRQueryData Identity -> Int32 -> PasswordResetCodeStore m () + CodeDelete :: PasswordResetKey -> PasswordResetCodeStore m () + +makeSem ''PasswordResetCodeStore diff --git a/services/brig/src/Brig/Effects/CodeStore/Cassandra.hs b/libs/wire-subsystems/src/Wire/PasswordResetCodeStore/Cassandra.hs similarity index 85% rename from services/brig/src/Brig/Effects/CodeStore/Cassandra.hs rename to libs/wire-subsystems/src/Wire/PasswordResetCodeStore/Cassandra.hs index f802b432014..74bdd0ca1f7 100644 --- a/services/brig/src/Brig/Effects/CodeStore/Cassandra.hs +++ b/libs/wire-subsystems/src/Wire/PasswordResetCodeStore/Cassandra.hs @@ -16,37 +16,34 @@ -- with this program. If not, see . {-# LANGUAGE RecordWildCards #-} -module Brig.Effects.CodeStore.Cassandra - ( codeStoreToCassandra, +module Wire.PasswordResetCodeStore.Cassandra + ( passwordResetCodeStoreToCassandra, interpretClientToIO, ) where -import Brig.Effects.CodeStore import Cassandra -import Data.ByteString.Conversion (toByteString') import Data.Id import Data.Text (pack) import Data.Text.Ascii import Data.Time.Clock import Imports import OpenSSL.BN (randIntegerZeroToNMinusOne) -import OpenSSL.EVP.Digest (digestBS, getDigestByName) import OpenSSL.Random (randBytes) import Polysemy import Text.Printf import Wire.API.User.Password +import Wire.PasswordResetCodeStore -codeStoreToCassandra :: +passwordResetCodeStoreToCassandra :: forall m r a. (MonadClient m, Member (Embed m) r) => - Sem (CodeStore ': r) a -> + Sem (PasswordResetCodeStore ': r) a -> Sem r a -codeStoreToCassandra = +passwordResetCodeStoreToCassandra = interpret $ embed @m . \case - MkPasswordResetKey uid -> mkPwdResetKey uid GenerateEmailCode -> genEmailCode GeneratePhoneCode -> genPhoneCode CodeSelect prk -> @@ -82,11 +79,6 @@ genPhoneCode = PasswordResetCode . unsafeFromText . pack . printf "%06d" <$> liftIO (randIntegerZeroToNMinusOne 1000000) -mkPwdResetKey :: (MonadIO m) => UserId -> m PasswordResetKey -mkPwdResetKey u = do - d <- liftIO $ getDigestByName "SHA256" >>= maybe (error "SHA256 not found") pure - pure . PasswordResetKey . encodeBase64Url . digestBS d $ toByteString' u - interpretClientToIO :: (Member (Final IO) r) => ClientState -> diff --git a/libs/wire-subsystems/src/Wire/PasswordStore.hs b/libs/wire-subsystems/src/Wire/PasswordStore.hs new file mode 100644 index 00000000000..48a358aa827 --- /dev/null +++ b/libs/wire-subsystems/src/Wire/PasswordStore.hs @@ -0,0 +1,14 @@ +{-# LANGUAGE TemplateHaskell #-} + +module Wire.PasswordStore where + +import Data.Id +import Imports +import Polysemy +import Wire.API.Password + +data PasswordStore m a where + UpsertHashedPassword :: UserId -> Password -> PasswordStore m () + LookupHashedPassword :: UserId -> PasswordStore m (Maybe Password) + +makeSem ''PasswordStore diff --git a/libs/wire-subsystems/src/Wire/PasswordStore/Cassandra.hs b/libs/wire-subsystems/src/Wire/PasswordStore/Cassandra.hs new file mode 100644 index 00000000000..933faeb298d --- /dev/null +++ b/libs/wire-subsystems/src/Wire/PasswordStore/Cassandra.hs @@ -0,0 +1,36 @@ +{-# OPTIONS_GHC -fno-warn-orphans #-} + +module Wire.PasswordStore.Cassandra (interpretPasswordStore) where + +import Cassandra +import Data.Id +import Imports +import Polysemy +import Polysemy.Embed +import Wire.API.Password (Password) +import Wire.PasswordStore + +interpretPasswordStore :: (Member (Embed IO) r) => ClientState -> InterpreterFor PasswordStore r +interpretPasswordStore casClient = + interpret $ + runEmbedded (runClient casClient) . \case + UpsertHashedPassword uid password -> embed $ updatePasswordImpl uid password + LookupHashedPassword uid -> embed $ lookupPasswordImpl uid + +lookupPasswordImpl :: (MonadClient m) => UserId -> m (Maybe Password) +lookupPasswordImpl u = + (runIdentity =<<) + <$> retry x1 (query1 passwordSelect (params LocalQuorum (Identity u))) + +updatePasswordImpl :: (MonadClient m) => UserId -> Password -> m () +updatePasswordImpl u p = do + retry x5 $ write userPasswordUpdate (params LocalQuorum (p, u)) + +------------------------------------------------------------------------ +-- Queries + +passwordSelect :: PrepQuery R (Identity UserId) (Identity (Maybe Password)) +passwordSelect = "SELECT password FROM user WHERE id = ?" + +userPasswordUpdate :: PrepQuery W (Password, UserId) () +userPasswordUpdate = {- `IF EXISTS`, but that requires benchmarking -} "UPDATE user SET password = ? WHERE id = ?" diff --git a/libs/wire-subsystems/src/Wire/SessionStore.hs b/libs/wire-subsystems/src/Wire/SessionStore.hs new file mode 100644 index 00000000000..35c4c8355c7 --- /dev/null +++ b/libs/wire-subsystems/src/Wire/SessionStore.hs @@ -0,0 +1,25 @@ +{-# LANGUAGE TemplateHaskell #-} +{-# OPTIONS_GHC -Wno-ambiguous-fields #-} + +module Wire.SessionStore where + +import Cassandra +import Data.Id +import Data.Time.Clock +import Imports +import Polysemy +import Test.QuickCheck +import Wire.API.User.Auth + +newtype TTL = TTL {ttlSeconds :: Int32} + deriving (Show, Eq) + deriving newtype (Cql, Arbitrary) + +data SessionStore m a where + InsertCookie :: UserId -> Cookie () -> Maybe TTL -> SessionStore m () + LookupCookie :: UserId -> UTCTime -> CookieId -> SessionStore m (Maybe (Cookie ())) + ListCookies :: UserId -> SessionStore m [Cookie ()] + DeleteAllCookies :: UserId -> SessionStore m () + DeleteCookies :: UserId -> [Cookie ()] -> SessionStore m () + +makeSem ''SessionStore diff --git a/services/brig/src/Brig/User/Auth/DB/Cookie.hs b/libs/wire-subsystems/src/Wire/SessionStore/Cassandra.hs similarity index 71% rename from services/brig/src/Brig/User/Auth/DB/Cookie.hs rename to libs/wire-subsystems/src/Wire/SessionStore/Cassandra.hs index b4198bc0e98..109b3660055 100644 --- a/services/brig/src/Brig/User/Auth/DB/Cookie.hs +++ b/libs/wire-subsystems/src/Wire/SessionStore/Cassandra.hs @@ -1,5 +1,3 @@ -{-# LANGUAGE GeneralizedNewtypeDeriving #-} - -- This file is part of the Wire Server implementation. -- -- Copyright (C) 2022 Wire Swiss GmbH @@ -16,21 +14,29 @@ -- -- You should have received a copy of the GNU Affero General Public License along -- with this program. If not, see . +module Wire.SessionStore.Cassandra (interpretSessionStoreCassandra) where -module Brig.User.Auth.DB.Cookie where - -import Brig.User.Auth.DB.Instances () import Cassandra import Data.Id import Data.Time.Clock import Imports +import Polysemy +import Polysemy.Embed import Wire.API.User.Auth +import Wire.SessionStore -newtype TTL = TTL {ttlSeconds :: Int32} - deriving (Cql) +interpretSessionStoreCassandra :: (Member (Embed IO) r) => ClientState -> InterpreterFor SessionStore r +interpretSessionStoreCassandra casClient = + interpret $ + runEmbedded (runClient casClient) . \case + InsertCookie uid cookie ttl -> embed $ insertCookieImpl uid cookie ttl + LookupCookie uid utc cid -> embed $ lookupCookieImpl uid utc cid + ListCookies uid -> embed $ listCookiesImpl uid + DeleteAllCookies uid -> embed $ deleteAllCookiesImpl uid + DeleteCookies uid cc -> embed $ deleteCookiesImpl uid cc -insertCookie :: (MonadClient m) => UserId -> Cookie a -> Maybe TTL -> m () -insertCookie u ck ttl = +insertCookieImpl :: (MonadClient m) => UserId -> Cookie () -> Maybe TTL -> m () +insertCookieImpl u ck ttl = let i = cookieId ck x = cookieExpires ck c = cookieCreated ck @@ -45,8 +51,8 @@ insertCookie u ck ttl = "INSERT INTO user_cookies (user, expires, id, type, created, label, succ_id) \ \VALUES (?, ?, ?, ?, ?, ?, ?) USING TTL ?" -lookupCookie :: (MonadClient m) => UserId -> UTCTime -> CookieId -> m (Maybe (Cookie ())) -lookupCookie u t c = +lookupCookieImpl :: (MonadClient m) => UserId -> UTCTime -> CookieId -> m (Maybe (Cookie ())) +lookupCookieImpl u t c = fmap mkCookie <$> retry x1 (query1 cql (params LocalQuorum (u, t, c))) where mkCookie (typ, created, label, csucc) = @@ -65,8 +71,8 @@ lookupCookie u t c = \FROM user_cookies \ \WHERE user = ? AND expires = ? AND id = ?" -listCookies :: (MonadClient m) => UserId -> m [Cookie ()] -listCookies u = +listCookiesImpl :: (MonadClient m) => UserId -> m [Cookie ()] +listCookiesImpl u = map toCookie <$> retry x1 (query cql (params LocalQuorum (Identity u))) where cql :: PrepQuery R (Identity UserId) (CookieId, UTCTime, UTCTime, CookieType, Maybe CookieLabel, Maybe CookieId) @@ -87,8 +93,8 @@ listCookies u = cookieValue = () } -deleteCookies :: (MonadClient m) => UserId -> [Cookie a] -> m () -deleteCookies u cs = retry x5 . batch $ do +deleteCookiesImpl :: (MonadClient m) => UserId -> [Cookie ()] -> m () +deleteCookiesImpl u cs = retry x5 . batch $ do setType BatchUnLogged setConsistency LocalQuorum for_ cs $ \c -> addPrepQuery cql (u, cookieExpires c, cookieId c) @@ -96,8 +102,8 @@ deleteCookies u cs = retry x5 . batch $ do cql :: PrepQuery W (UserId, UTCTime, CookieId) () cql = "DELETE FROM user_cookies WHERE user = ? AND expires = ? AND id = ?" -deleteAllCookies :: (MonadClient m) => UserId -> m () -deleteAllCookies u = retry x5 (write cql (params LocalQuorum (Identity u))) +deleteAllCookiesImpl :: (MonadClient m) => UserId -> m () +deleteAllCookiesImpl u = retry x5 (write cql (params LocalQuorum (Identity u))) where cql :: PrepQuery W (Identity UserId) () cql = "DELETE FROM user_cookies WHERE user = ?" diff --git a/libs/wire-subsystems/src/Wire/StoredUser.hs b/libs/wire-subsystems/src/Wire/StoredUser.hs index 5986ef8a864..62dd77bfcf1 100644 --- a/libs/wire-subsystems/src/Wire/StoredUser.hs +++ b/libs/wire-subsystems/src/Wire/StoredUser.hs @@ -94,6 +94,12 @@ mkUserFromStored domain defaultLocale storedUser = Just ps -> if S.null ps then defSupportedProtocols else ps } +mkAccountFromStored :: Domain -> Locale -> StoredUser -> UserAccount +mkAccountFromStored domain defaultLocale storedUser = + UserAccount + (mkUserFromStored domain defaultLocale storedUser) + (fromMaybe Active storedUser.status) + toLocale :: Locale -> (Maybe Language, Maybe Country) -> Locale toLocale _ (Just l, c) = Locale l c toLocale l _ = l diff --git a/libs/wire-subsystems/src/Wire/UserKeyStore.hs b/libs/wire-subsystems/src/Wire/UserKeyStore.hs new file mode 100644 index 00000000000..4bcc6807a5c --- /dev/null +++ b/libs/wire-subsystems/src/Wire/UserKeyStore.hs @@ -0,0 +1,118 @@ +{-# LANGUAGE TemplateHaskell #-} + +module Wire.UserKeyStore where + +import Data.Id +import Data.Text qualified as Text +import Imports +import Polysemy +import Test.QuickCheck +import Wire.API.User +import Wire.Arbitrary + +data PhoneKey = PhoneKey + { -- | canonical form of 'phoneKeyOrig', without whitespace. + phoneKeyUniq :: !Text, + -- | phone number with whitespace. + phoneKeyOrig :: !Phone + } + deriving (Ord) + +instance Show PhoneKey where + showsPrec _ = shows . phoneKeyUniq + +instance Eq PhoneKey where + (PhoneKey k _) == (PhoneKey k' _) = k == k' + +instance Arbitrary PhoneKey where + arbitrary = mkPhoneKey <$> arbitrary + +-- | An 'EmailKey' is an 'Email' in a form that serves as a unique lookup key. +data EmailKey = EmailKey + { emailKeyUniq :: !Text, + emailKeyOrig :: !Email + } + deriving (Ord) + +instance Show EmailKey where + showsPrec _ = shows . emailKeyUniq + +instance Eq EmailKey where + (EmailKey k _) == (EmailKey k' _) = k == k' + +instance Arbitrary EmailKey where + arbitrary = mkEmailKey <$> arbitrary + +-- | A natural identifier (i.e. unique key) of a user. +data UserKey + = UserEmailKey !EmailKey + | UserPhoneKey !PhoneKey + deriving stock (Eq, Show, Ord, Generic) + deriving (Arbitrary) via (GenericUniform UserKey) + +userEmailKey :: Email -> UserKey +userEmailKey = UserEmailKey . mkEmailKey + +userPhoneKey :: Phone -> UserKey +userPhoneKey = UserPhoneKey . mkPhoneKey + +-- | Turn an 'Email' into an 'EmailKey'. +-- +-- The following transformations are performed: +-- +-- * Both local and domain parts are forced to lowercase to make +-- e-mail addresses fully case-insensitive. +-- * "+" suffixes on the local part are stripped unless the domain +-- part is contained in a trusted whitelist. +mkEmailKey :: Email -> EmailKey +mkEmailKey orig@(Email localPart domain) = + let uniq = Text.toLower localPart' <> "@" <> Text.toLower domain + in EmailKey uniq orig + where + localPart' + | domain `notElem` trusted = Text.takeWhile (/= '+') localPart + | otherwise = localPart + trusted = ["wearezeta.com", "wire.com", "simulator.amazonses.com"] + +mkPhoneKey :: Phone -> PhoneKey +mkPhoneKey orig = + let uniq = Text.filter (not . isSpace) (fromPhone orig) + in PhoneKey uniq orig + +-- | Get the normalised text of a 'UserKey'. +keyText :: UserKey -> Text +keyText (UserEmailKey k) = emailKeyUniq k +keyText (UserPhoneKey k) = phoneKeyUniq k + +-- | Get the original text of a 'UserKey', i.e. the original phone number +-- or email address. +keyTextOriginal :: UserKey -> Text +keyTextOriginal (UserEmailKey k) = fromEmail (emailKeyOrig k) +keyTextOriginal (UserPhoneKey k) = fromPhone (phoneKeyOrig k) + +foldKey :: (Email -> a) -> (Phone -> a) -> UserKey -> a +foldKey f g k = case k of + UserEmailKey ek -> f (emailKeyOrig ek) + UserPhoneKey pk -> g (phoneKeyOrig pk) + +forEmailKey :: (Applicative f) => UserKey -> (Email -> f a) -> f (Maybe a) +forEmailKey k f = foldKey (fmap Just . f) (const (pure Nothing)) k + +forPhoneKey :: (Applicative f) => UserKey -> (Phone -> f a) -> f (Maybe a) +forPhoneKey k f = foldKey (const (pure Nothing)) (fmap Just . f) k + +fromEither :: Either Email Phone -> UserKey +fromEither = either userEmailKey userPhoneKey + +toEither :: UserKey -> Either Email Phone +toEither = foldKey Left Right + +data UserKeyStore m a where + LookupKey :: UserKey -> UserKeyStore m (Maybe UserId) + InsertKey :: UserId -> UserKey -> UserKeyStore m () + DeleteKey :: UserKey -> UserKeyStore m () + DeleteKeyForUser :: UserId -> UserKey -> UserKeyStore m () + KeyAvailable :: UserKey -> Maybe UserId -> UserKeyStore m Bool + ClaimKey :: UserKey -> UserId -> UserKeyStore m Bool + +makeSem ''UserKeyStore diff --git a/libs/wire-subsystems/src/Wire/UserKeyStore/Cassandra.hs b/libs/wire-subsystems/src/Wire/UserKeyStore/Cassandra.hs new file mode 100644 index 00000000000..06a84340df5 --- /dev/null +++ b/libs/wire-subsystems/src/Wire/UserKeyStore/Cassandra.hs @@ -0,0 +1,92 @@ +module Wire.UserKeyStore.Cassandra (interpretUserKeyStoreCassandra) where + +import Cassandra +import Data.Id +import Imports +import Polysemy +import Polysemy.Embed +import Wire.UserKeyStore +import Wire.UserStore + +interpretUserKeyStoreCassandra :: (Member (Embed IO) r, Member UserStore r) => ClientState -> InterpreterFor UserKeyStore r +interpretUserKeyStoreCassandra casClient = + interpret $ + runEmbedded (runClient casClient) . \case + LookupKey key -> embed $ lookupKeyImpl key + InsertKey uid key -> embed $ insertKeyImpl uid key + DeleteKey key -> embed $ deleteKeyImpl key + DeleteKeyForUser uid key -> embed $ deleteKeyForUserImpl uid key + ClaimKey key uid -> claimKeyImpl casClient key uid + KeyAvailable key uid -> keyAvailableImpl casClient key uid + +-- | Claim a 'UserKey' for a user. +claimKeyImpl :: + (Member (Embed IO) r, Member UserStore r) => + ClientState -> + -- | The key to claim. + UserKey -> + -- | The user claiming the key. + UserId -> + Sem r Bool +claimKeyImpl client k u = do + free <- keyAvailableImpl client k (Just u) + when free (runClient client $ insertKeyImpl u k) + pure free + +-- | Check whether a 'UserKey' is available. +-- A key is available if it is not already activated for another user or +-- if the other user and the user looking to claim the key are the same. +keyAvailableImpl :: + (Member (Embed IO) r, Member UserStore r) => + ClientState -> + -- | The key to check. + UserKey -> + -- | The user looking to claim the key, if any. + Maybe UserId -> + Sem r Bool +keyAvailableImpl client k u = do + o <- runClient client $ lookupKeyImpl k + case (o, u) of + (Nothing, _) -> pure True + (Just x, Just y) | x == y -> pure True + (Just x, _) -> not <$> isActivated x + +lookupKeyImpl :: (MonadClient m) => UserKey -> m (Maybe UserId) +lookupKeyImpl k = + fmap runIdentity + <$> retry x1 (query1 keySelect (params LocalQuorum (Identity $ keyText k))) + +insertKeyImpl :: UserId -> UserKey -> Client () +insertKeyImpl u k = do + retry x5 $ write keyInsert (params LocalQuorum (keyText k, u)) + +deleteKeyImpl :: (MonadClient m) => UserKey -> m () +deleteKeyImpl k = do + retry x5 $ write keyDelete (params LocalQuorum (Identity $ keyText k)) + +-- | Delete `UserKey` for `UserId` +-- +-- This function ensures that keys of other users aren't accidentally deleted. +-- E.g. the email address or phone number of a partially deleted user could +-- already belong to a new user. To not interrupt deletion flows (that may be +-- executed several times due to cassandra not supporting transactions) +-- `deleteKeyImplForUser` does not fail for missing keys or keys that belong to +-- another user: It always returns `()` as result. +deleteKeyForUserImpl :: (MonadClient m) => UserId -> UserKey -> m () +deleteKeyForUserImpl uid k = do + mbKeyUid <- lookupKeyImpl k + case mbKeyUid of + Just keyUid | keyUid == uid -> deleteKeyImpl k + _ -> pure () + +-------------------------------------------------------------------------------- +-- Queries + +keyInsert :: PrepQuery W (Text, UserId) () +keyInsert = "INSERT INTO user_keys (key, user) VALUES (?, ?)" + +keySelect :: PrepQuery R (Identity Text) (Identity UserId) +keySelect = "SELECT user FROM user_keys WHERE key = ?" + +keyDelete :: PrepQuery W (Identity Text) () +keyDelete = "DELETE FROM user_keys WHERE key = ?" diff --git a/libs/wire-subsystems/src/Wire/UserStore.hs b/libs/wire-subsystems/src/Wire/UserStore.hs index 231c24df6d0..9fc5581f047 100644 --- a/libs/wire-subsystems/src/Wire/UserStore.hs +++ b/libs/wire-subsystems/src/Wire/UserStore.hs @@ -57,6 +57,10 @@ data UserStore m a where -- matters for the interpretation, this operation may give you stale locks, -- but is faster and more resilient. GlimpseHandle :: Handle -> UserStore m (Maybe UserId) + LookupStatus :: UserId -> UserStore m (Maybe AccountStatus) + -- | Whether the account has been activated by verifying + -- an email address or phone number. + IsActivated :: UserId -> UserStore m Bool makeSem ''UserStore diff --git a/libs/wire-subsystems/src/Wire/UserStore/Cassandra.hs b/libs/wire-subsystems/src/Wire/UserStore/Cassandra.hs index f530c90b197..bff332252f1 100644 --- a/libs/wire-subsystems/src/Wire/UserStore/Cassandra.hs +++ b/libs/wire-subsystems/src/Wire/UserStore/Cassandra.hs @@ -23,6 +23,8 @@ interpretUserStoreCassandra casClient = DeleteUser user -> embed $ deleteUserImpl user LookupHandle hdl -> embed $ lookupHandleImpl LocalQuorum hdl GlimpseHandle hdl -> embed $ lookupHandleImpl One hdl + LookupStatus uid -> embed $ lookupStatusImpl uid + IsActivated uid -> embed $ isActivatedImpl uid getUserImpl :: (Member (Embed Client) r) => UserId -> Sem r (Maybe StoredUser) getUserImpl uid = embed $ do @@ -105,6 +107,16 @@ deleteUserImpl user = do (Deleted, Name "default", defaultAccentId, noPict, [], userId user) ) +lookupStatusImpl :: UserId -> Client (Maybe AccountStatus) +lookupStatusImpl u = + (runIdentity =<<) + <$> retry x1 (query1 statusSelect (params LocalQuorum (Identity u))) + +isActivatedImpl :: UserId -> Client Bool +isActivatedImpl uid = + (== Just (Identity True)) + <$> retry x1 (query1 activatedSelect (params LocalQuorum (Identity uid))) + -------------------------------------------------------------------------------- -- Queries @@ -150,3 +162,9 @@ updateUserToTombstone = "UPDATE user SET status = ?, name = ?,\ \ accent_id = ?, picture = ?, assets = ?, handle = null, country = null,\ \ language = null, email = null, phone = null, sso_id = null WHERE id = ?" + +statusSelect :: PrepQuery R (Identity UserId) (Identity (Maybe AccountStatus)) +statusSelect = "SELECT status FROM user WHERE id = ?" + +activatedSelect :: PrepQuery R (Identity UserId) (Identity Bool) +activatedSelect = "SELECT activated FROM user WHERE id = ?" diff --git a/libs/wire-subsystems/src/Wire/UserSubsystem.hs b/libs/wire-subsystems/src/Wire/UserSubsystem.hs index c7bc75edc7d..9b41d1b25dd 100644 --- a/libs/wire-subsystems/src/Wire/UserSubsystem.hs +++ b/libs/wire-subsystems/src/Wire/UserSubsystem.hs @@ -14,6 +14,7 @@ import Wire.API.Error.Brig qualified as E import Wire.API.Federation.Error import Wire.API.User import Wire.Arbitrary +import Wire.UserKeyStore -- | All errors that are thrown by the user subsystem are subsumed under this sum type. data UserSubsystemError @@ -97,6 +98,7 @@ data UserSubsystem m a where CheckHandles :: [Handle] -> Word -> UserSubsystem m [Handle] -- | parses a handle, this may fail so it's effectful UpdateHandle :: Local UserId -> Maybe ConnId -> UpdateOriginType -> Text {- use Handle here? -} -> UserSubsystem m () + GetLocalUserAccountByUserKey :: Local UserKey -> UserSubsystem m (Maybe UserAccount) -- | the return type of 'CheckHandle' data CheckHandleResp diff --git a/libs/wire-subsystems/src/Wire/UserSubsystem/Error.hs b/libs/wire-subsystems/src/Wire/UserSubsystem/Error.hs new file mode 100644 index 00000000000..1ade57b4b9c --- /dev/null +++ b/libs/wire-subsystems/src/Wire/UserSubsystem/Error.hs @@ -0,0 +1,32 @@ +module Wire.UserSubsystem.Error where + +import Imports +import Network.Wai.Utilities qualified as Wai +import Wire.API.Error +import Wire.API.Error.Brig qualified as E + +-- | All errors that are thrown by the user subsystem are subsumed under this sum type. +data UserSubsystemError + = -- | user is managed by scim or e2ei is enabled + -- FUTUREWORK(mangoiv): the name should probably resemble that + UserSubsystemDisplayNameManagedByScim + | UserSubsystemHandleManagedByScim + | UserSubsystemLocaleManagedByScim + | UserSubsystemNoIdentity + | UserSubsystemHandleExists + | UserSubsystemInvalidHandle + | UserSubsystemProfileNotFound + deriving (Eq, Show) + +userSubsystemErrorToWai :: UserSubsystemError -> Wai.Error +userSubsystemErrorToWai = + dynErrorToWai . \case + UserSubsystemProfileNotFound -> dynError @(MapError E.UserNotFound) + UserSubsystemDisplayNameManagedByScim -> dynError @(MapError E.NameManagedByScim) + UserSubsystemLocaleManagedByScim -> dynError @(MapError E.LocaleManagedByScim) + UserSubsystemNoIdentity -> dynError @(MapError E.NoIdentity) + UserSubsystemHandleExists -> dynError @(MapError E.HandleExists) + UserSubsystemInvalidHandle -> dynError @(MapError E.InvalidHandle) + UserSubsystemHandleManagedByScim -> dynError @(MapError E.HandleManagedByScim) + +instance Exception UserSubsystemError diff --git a/libs/wire-subsystems/src/Wire/UserSubsystem/Interpreter.hs b/libs/wire-subsystems/src/Wire/UserSubsystem/Interpreter.hs index 27255fcc1ae..3d6d35463d9 100644 --- a/libs/wire-subsystems/src/Wire/UserSubsystem/Interpreter.hs +++ b/libs/wire-subsystems/src/Wire/UserSubsystem/Interpreter.hs @@ -1,6 +1,4 @@ -{-# LANGUAGE PartialTypeSignatures #-} {-# LANGUAGE RecordWildCards #-} -{-# OPTIONS_GHC -Wno-partial-type-signatures #-} module Wire.UserSubsystem.Interpreter ( runUserSubsystem, @@ -38,7 +36,8 @@ import Wire.Sem.Now (Now) import Wire.Sem.Now qualified as Now import Wire.StoredUser import Wire.UserEvents -import Wire.UserStore as US +import Wire.UserKeyStore +import Wire.UserStore as UserStore import Wire.UserSubsystem import Wire.UserSubsystem.HandleBlacklist @@ -54,6 +53,7 @@ instance Arbitrary UserSubsystemConfig where runUserSubsystem :: ( Member GalleyAPIAccess r, Member UserStore r, + Member UserKeyStore r, Member (Concurrency 'Unsafe) r, -- FUTUREWORK: subsystems should implement concurrency inside interpreters, not depend on this dangerous effect. Member (Error FederationError) r, Member (Error UserSubsystemError) r, @@ -72,6 +72,7 @@ runUserSubsystem cfg = runInputConst cfg . interpretUserSubsystem . raiseUnder interpretUserSubsystem :: ( Member GalleyAPIAccess r, Member UserStore r, + Member UserKeyStore r, Member (Concurrency 'Unsafe) r, Member (Error FederationError) r, Member (Error UserSubsystemError) r, @@ -94,6 +95,7 @@ interpretUserSubsystem = interpret \case CheckHandle uhandle -> checkHandleImpl uhandle CheckHandles hdls cnt -> checkHandlesImpl hdls cnt UpdateHandle uid mconn mb uhandle -> updateHandleImpl uid mconn mb uhandle + GetLocalUserAccountByUserKey userKey -> getLocalUserAccountByUserKeyImpl userKey -- | Obtain user profiles for a list of users as they can be seen by -- a given user 'self'. If 'self' is an unknown 'UserId', return '[]'. @@ -389,8 +391,15 @@ mkProfileUpdateHandleEvent :: UserId -> Handle -> UserEvent mkProfileUpdateHandleEvent uid handle = UserUpdated $ (emptyUserUpdatedData uid) {eupHandle = Just handle} +getLocalUserAccountByUserKeyImpl :: (Member UserStore r, Member UserKeyStore r, Member (Input UserSubsystemConfig) r) => Local UserKey -> Sem r (Maybe UserAccount) +getLocalUserAccountByUserKeyImpl target = runMaybeT $ do + config <- lift input + uid <- MaybeT $ lookupKey (tUnqualified target) + user <- MaybeT $ getUser uid + pure $ mkAccountFromStored (tDomain target) config.defaultLocale user + -------------------------------------------------------------------------------- --- Check Handle +-- Update Handle updateHandleImpl :: ( Member (Error UserSubsystemError) r, @@ -412,7 +421,7 @@ updateHandleImpl (tUnqualified -> uid) mconn updateOrigin uhandle = do when (isNothing user.identity) $ throw UserSubsystemNoIdentity mapError (\StoredUserUpdateHandleExists -> UserSubsystemHandleExists) $ - US.updateUserHandle uid (MkStoredUserHandleUpdate user.handle newHandle) + UserStore.updateUserHandle uid (MkStoredUserHandleUpdate user.handle newHandle) generateUserEvent uid mconn (mkProfileUpdateHandleEvent uid newHandle) checkHandleImpl :: (Member (Error UserSubsystemError) r, Member UserStore r) => Text -> Sem r CheckHandleResp @@ -439,7 +448,7 @@ hasE2EId user = -- | checks for handles @check@ to be available and returns -- at maximum @num@ of them -checkHandlesImpl :: (_) => [Handle] -> Word -> Sem r [Handle] +checkHandlesImpl :: (Member UserStore r) => [Handle] -> Word -> Sem r [Handle] checkHandlesImpl check num = reverse <$> collectFree [] check num where collectFree free _ 0 = pure free diff --git a/libs/wire-subsystems/test/unit/Wire/AuthenticationSubsystem/InterpreterSpec.hs b/libs/wire-subsystems/test/unit/Wire/AuthenticationSubsystem/InterpreterSpec.hs new file mode 100644 index 00000000000..e66b231cefe --- /dev/null +++ b/libs/wire-subsystems/test/unit/Wire/AuthenticationSubsystem/InterpreterSpec.hs @@ -0,0 +1,290 @@ +{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} + +module Wire.AuthenticationSubsystem.InterpreterSpec (spec) where + +import Data.Domain +import Data.Id +import Data.Misc (PlainTextPassword8) +import Data.Qualified +import Data.Time +import Imports +import Polysemy +import Polysemy.Error +import Polysemy.Input +import Polysemy.State +import Polysemy.TinyLog +import Test.Hspec +import Test.Hspec.QuickCheck +import Test.QuickCheck +import Wire.API.Allowlists (AllowlistEmailDomains (AllowlistEmailDomains), AllowlistPhonePrefixes) +import Wire.API.Password +import Wire.API.User +import Wire.API.User qualified as User +import Wire.API.User.Auth +import Wire.API.User.Password +import Wire.AuthenticationSubsystem +import Wire.AuthenticationSubsystem.Interpreter +import Wire.HashPassword +import Wire.MockInterpreters +import Wire.PasswordResetCodeStore +import Wire.PasswordStore +import Wire.Sem.Logger.TinyLog +import Wire.Sem.Now +import Wire.SessionStore +import Wire.UserKeyStore +import Wire.UserSubsystem + +type AllEffects = + [ Error AuthenticationSubsystemError, + HashPassword, + Now, + State UTCTime, + Input (Local ()), + Input (Maybe AllowlistEmailDomains), + Input (Maybe AllowlistPhonePrefixes), + SessionStore, + State (Map UserId [Cookie ()]), + PasswordStore, + State (Map UserId Password), + PasswordResetCodeStore, + State (Map PasswordResetKey (PRQueryData Identity)), + TinyLog, + UserSubsystem + ] + +interpretDependencies :: Domain -> [UserAccount] -> Map UserId Password -> Maybe [Text] -> Sem AllEffects a -> Either AuthenticationSubsystemError a +interpretDependencies localDomain preexistingUsers preexistingPasswords mAllowedEmailDomains = + run + . userSubsystemTestInterpreter preexistingUsers + . discardTinyLogs + . evalState mempty + . inMemoryPasswordResetCodeStore + . evalState preexistingPasswords + . inMemoryPasswordStoreInterpreter + . evalState mempty + . inMemorySessionStoreInterpreter + . runInputConst Nothing + . runInputConst (AllowlistEmailDomains <$> mAllowedEmailDomains) + . runInputConst (toLocalUnsafe localDomain ()) + . evalState defaultTime + . interpretNowAsState + . staticHashPasswordInterpreter + . runError + +defaultTime :: UTCTime +defaultTime = UTCTime (ModifiedJulianDay 0) 0 + +spec :: Spec +spec = describe "AuthenticationSubsystem.Interpreter" do + describe "password reset" do + prop "password reset should work with the email being used as password reset key" $ + \email userNoEmail (cookiesWithTTL :: [(Cookie (), Maybe TTL)]) mPreviousPassword newPassword -> + let user = userNoEmail {userIdentity = Just $ EmailIdentity email} + uid = User.userId user + localDomain = userNoEmail.userQualifiedId.qDomain + Right (newPasswordHash, cookiesAfterReset) = + interpretDependencies localDomain [UserAccount user Active] mempty Nothing + . interpretAuthenticationSubsystem + $ do + forM_ mPreviousPassword (hashPassword >=> upsertHashedPassword uid) + mapM_ (uncurry (insertCookie uid)) cookiesWithTTL + + (_, (_, code)) <- createPasswordResetCode (userEmailKey email) + resetPassword (PasswordResetEmailIdentity email) code newPassword + + (,) <$> lookupHashedPassword uid <*> listCookies uid + in mPreviousPassword /= Just newPassword ==> + (fmap (verifyPassword newPassword) newPasswordHash === Just True) + .&&. (cookiesAfterReset === []) + + prop "password reset should work with the returned password reset key" $ + \email userNoEmail (cookiesWithTTL :: [(Cookie (), Maybe TTL)]) mPreviousPassword newPassword -> + let user = userNoEmail {userIdentity = Just $ EmailIdentity email} + uid = User.userId user + localDomain = userNoEmail.userQualifiedId.qDomain + Right (newPasswordHash, cookiesAfterReset) = + interpretDependencies localDomain [UserAccount user Active] mempty Nothing + . interpretAuthenticationSubsystem + $ do + forM_ mPreviousPassword (hashPassword >=> upsertHashedPassword uid) + mapM_ (uncurry (insertCookie uid)) cookiesWithTTL + + (_, (passwordResetKey, code)) <- createPasswordResetCode (userEmailKey email) + resetPassword (PasswordResetIdentityKey passwordResetKey) code newPassword + + (,) <$> lookupHashedPassword uid <*> listCookies uid + in mPreviousPassword /= Just newPassword ==> + (fmap (verifyPassword newPassword) newPasswordHash === Just True) + .&&. (cookiesAfterReset === []) + + prop "reset code is not generated when email is not in allow list" $ + \email localDomain -> + let createPasswordResetCodeResult = + interpretDependencies localDomain [] mempty (Just ["example.com"]) + . interpretAuthenticationSubsystem + $ createPasswordResetCode (userEmailKey email) + in emailDomain email /= "exmaple.com" ==> + createPasswordResetCodeResult === Left AuthenticationSubsystemAllowListError + + prop "reset code is generated when email is in allow list" $ + \email userNoEmail -> + let user = userNoEmail {userIdentity = Just $ EmailIdentity email} + localDomain = userNoEmail.userQualifiedId.qDomain + createPasswordResetCodeResult = + interpretDependencies localDomain [UserAccount user Active] mempty (Just [emailDomain email]) + . interpretAuthenticationSubsystem + $ createPasswordResetCode (userEmailKey email) + in counterexample ("expected Right, got: " <> show createPasswordResetCodeResult) $ + isRight createPasswordResetCodeResult + + prop "reset code is not generated for when user's status is not Active" $ + \email userNoEmail status -> + let user = userNoEmail {userIdentity = Just $ EmailIdentity email} + localDomain = userNoEmail.userQualifiedId.qDomain + createPasswordResetCodeResult = + interpretDependencies localDomain [UserAccount user status] mempty Nothing + . interpretAuthenticationSubsystem + $ createPasswordResetCode (userEmailKey email) + in status /= Active ==> + createPasswordResetCodeResult === Left AuthenticationSubsystemInvalidPasswordResetKey + + prop "reset code is not generated for when there is no user for the email" $ + \email localDomain -> + let createPasswordResetCodeResult = + interpretDependencies localDomain [] mempty Nothing + . interpretAuthenticationSubsystem + $ createPasswordResetCode (userEmailKey email) + in createPasswordResetCodeResult === Left AuthenticationSubsystemInvalidPasswordResetKey + + prop "reset code is only generated once" $ + \email userNoEmail newPassword -> + let user = userNoEmail {userIdentity = Just $ EmailIdentity email} + uid = User.userId user + localDomain = userNoEmail.userQualifiedId.qDomain + Right (newPasswordHash, mCaughtException) = + interpretDependencies localDomain [UserAccount user Active] mempty Nothing + . interpretAuthenticationSubsystem + $ do + (_, (_, code)) <- createPasswordResetCode (userEmailKey email) + + mCaughtExc <- catchExpectedError $ createPasswordResetCode (userEmailKey email) + + -- Reset passwrod still works with previously generated reset code + resetPassword (PasswordResetEmailIdentity email) code newPassword + + (,mCaughtExc) <$> lookupHashedPassword uid + in (fmap (verifyPassword newPassword) newPasswordHash === Just True) + .&&. (mCaughtException === Just AuthenticationSubsystemPasswordResetInProgress) + + prop "reset code is not accepted after expiry" $ + \email userNoEmail oldPassword newPassword -> + let user = userNoEmail {userIdentity = Just $ EmailIdentity email} + uid = User.userId user + localDomain = userNoEmail.userQualifiedId.qDomain + Right (passwordInDB, resetPasswordResult) = + interpretDependencies localDomain [UserAccount user Active] mempty Nothing + . interpretAuthenticationSubsystem + $ do + upsertHashedPassword uid =<< hashPassword oldPassword + (_, (_, code)) <- createPasswordResetCode (userEmailKey email) + + passTime (passwordResetCodeTtl + 1) + + mCaughtExc <- catchExpectedError $ resetPassword (PasswordResetEmailIdentity email) code newPassword + (,mCaughtExc) <$> lookupHashedPassword uid + in resetPasswordResult === Just AuthenticationSubsystemInvalidPasswordResetCode + .&&. verifyPasswordProp oldPassword passwordInDB + + prop "password reset is not allowed with arbitrary codes when no other codes exist" $ + \email userNoEmail resetCode oldPassword newPassword -> + let user = userNoEmail {userIdentity = Just $ EmailIdentity email} + uid = User.userId user + localDomain = userNoEmail.userQualifiedId.qDomain + Right (passwordInDB, resetPasswordResult) = + interpretDependencies localDomain [UserAccount user Active] mempty Nothing + . interpretAuthenticationSubsystem + $ do + upsertHashedPassword uid =<< hashPassword oldPassword + mCaughtExc <- catchExpectedError $ resetPassword (PasswordResetEmailIdentity email) resetCode newPassword + (,mCaughtExc) <$> lookupHashedPassword uid + in resetPasswordResult === Just AuthenticationSubsystemInvalidPasswordResetCode + .&&. verifyPasswordProp oldPassword passwordInDB + + prop "password reset doesn't work if email is wrong" $ + \email wrongEmail userNoEmail resetCode oldPassword newPassword -> + let user = userNoEmail {userIdentity = Just $ EmailIdentity email} + uid = User.userId user + localDomain = userNoEmail.userQualifiedId.qDomain + Right (passwordInDB, resetPasswordResult) = + interpretDependencies localDomain [UserAccount user Active] mempty Nothing + . interpretAuthenticationSubsystem + $ do + hashAndUpsertPassword uid oldPassword + mCaughtExc <- catchExpectedError $ resetPassword (PasswordResetEmailIdentity wrongEmail) resetCode newPassword + (,mCaughtExc) <$> lookupHashedPassword uid + in email /= wrongEmail ==> + resetPasswordResult === Just AuthenticationSubsystemInvalidPasswordResetKey + .&&. verifyPasswordProp oldPassword passwordInDB + + prop "only 3 wrong password reset attempts are allowed" $ + \email userNoEmail arbitraryResetCode oldPassword newPassword (Upto4 wrongResetAttempts) -> + let user = userNoEmail {userIdentity = Just $ EmailIdentity email} + uid = User.userId user + localDomain = userNoEmail.userQualifiedId.qDomain + Right (passwordHashInDB, correctResetCode, wrongResetErrors, resetPassworedWithCorectCodeResult) = + interpretDependencies localDomain [UserAccount user Active] mempty Nothing + . interpretAuthenticationSubsystem + $ do + upsertHashedPassword uid =<< hashPassword oldPassword + (_, (_, generatedResetCode)) <- createPasswordResetCode (userEmailKey email) + + wrongResetErrs <- + replicateM wrongResetAttempts $ + catchExpectedError $ + resetPassword (PasswordResetEmailIdentity email) arbitraryResetCode newPassword + + mFinalResetErr <- catchExpectedError $ resetPassword (PasswordResetEmailIdentity email) generatedResetCode newPassword + (,generatedResetCode,wrongResetErrs,mFinalResetErr) <$> lookupHashedPassword uid + expectedFinalResetResult = + if wrongResetAttempts >= 3 + then Just AuthenticationSubsystemInvalidPasswordResetCode + else Nothing + expectedFinalPassword = + if wrongResetAttempts >= 3 + then oldPassword + else newPassword + in correctResetCode /= arbitraryResetCode ==> + wrongResetErrors == replicate wrongResetAttempts (Just AuthenticationSubsystemInvalidPasswordResetCode) + .&&. resetPassworedWithCorectCodeResult === expectedFinalResetResult + .&&. verifyPasswordProp expectedFinalPassword passwordHashInDB + + describe "internalLookupPasswordResetCode" do + prop "should find password reset code by email" $ + \email userNoEmail newPassword -> + let user = userNoEmail {userIdentity = Just $ EmailIdentity email} + uid = User.userId user + localDomain = userNoEmail.userQualifiedId.qDomain + Right passwordHashInDB = + interpretDependencies localDomain [UserAccount user Active] mempty Nothing + . interpretAuthenticationSubsystem + $ do + void $ createPasswordResetCode (userEmailKey email) + mLookupRes <- internalLookupPasswordResetCode (userEmailKey email) + for_ mLookupRes $ \(_, code) -> resetPassword (PasswordResetEmailIdentity email) code newPassword + lookupHashedPassword uid + in verifyPasswordProp newPassword passwordHashInDB + +newtype Upto4 = Upto4 Int + deriving newtype (Show, Eq) + +instance Arbitrary Upto4 where + arbitrary = Upto4 <$> elements [0 .. 4] + +verifyPasswordProp :: PlainTextPassword8 -> Maybe Password -> Property +verifyPasswordProp plainTextPassword passwordHash = + counterexample ("Password doesn't match, plainText=" <> show plainTextPassword <> ", passwordHash=" <> show passwordHash) $ + fmap (verifyPassword plainTextPassword) passwordHash == Just True + +hashAndUpsertPassword :: (Member PasswordStore r, Member HashPassword r) => UserId -> PlainTextPassword8 -> Sem r () +hashAndUpsertPassword uid password = + upsertHashedPassword uid =<< hashPassword password diff --git a/libs/wire-subsystems/src/Wire/MiniBackend.hs b/libs/wire-subsystems/test/unit/Wire/MiniBackend.hs similarity index 69% rename from libs/wire-subsystems/src/Wire/MiniBackend.hs rename to libs/wire-subsystems/test/unit/Wire/MiniBackend.hs index f4508362b7f..92272fc11ac 100644 --- a/libs/wire-subsystems/src/Wire/MiniBackend.hs +++ b/libs/wire-subsystems/test/unit/Wire/MiniBackend.hs @@ -2,10 +2,12 @@ module Wire.MiniBackend ( -- * Mini backends MiniBackend (..), AllErrors, - GetUserProfileEffects, + MiniBackendEffects, interpretFederationStack, runFederationStack, interpretNoFederationStack, + runNoFederationStackState, + interpretNoFederationStackState, runNoFederationStack, runAllErrorsUnsafe, runErrorUnsafe, @@ -22,7 +24,6 @@ where import Data.Default (Default (def)) import Data.Domain -import Data.Handle (Handle) import Data.Id import Data.LanguageCodes (ISO639_1 (EN)) import Data.LegalHold (defUserLegalHoldStatus) @@ -38,7 +39,9 @@ import Polysemy.Error import Polysemy.Input import Polysemy.Internal import Polysemy.State +import Polysemy.TinyLog import Servant.Client.Core +import System.Logger qualified as Log import Test.QuickCheck import Type.Reflection import Wire.API.Federation.API @@ -47,18 +50,21 @@ import Wire.API.Federation.Error import Wire.API.Team.Feature import Wire.API.Team.Member hiding (userId) import Wire.API.User as User hiding (DeleteUser) -import Wire.API.UserEvent +import Wire.API.User.Password import Wire.DeleteQueue import Wire.DeleteQueue.InMemory import Wire.FederationAPIAccess import Wire.FederationAPIAccess.Interpreter as FI import Wire.GalleyAPIAccess import Wire.InternalEvent hiding (DeleteUser) +import Wire.MockInterpreters +import Wire.PasswordResetCodeStore import Wire.Sem.Concurrency import Wire.Sem.Concurrency.Sequential import Wire.Sem.Now hiding (get) import Wire.StoredUser import Wire.UserEvents +import Wire.UserKeyStore import Wire.UserStore import Wire.UserSubsystem import Wire.UserSubsystem.Interpreter @@ -85,10 +91,13 @@ type AllErrors = Error FederationError ] -type GetUserProfileEffects = +type MiniBackendEffects = [ UserSubsystem, GalleyAPIAccess, UserStore, + State [StoredUser], + UserKeyStore, + State (Map UserKey UserId), DeleteQueue, UserEvents, State [InternalNotification], @@ -96,25 +105,28 @@ type GetUserProfileEffects = State [MiniEvent], Now, Input UserSubsystemConfig, + Input (Local ()), FederationAPIAccess MiniFederationMonad, + TinyLog, Concurrency 'Unsafe ] -data MiniEvent = MkMiniEvent - { userId :: UserId, - event :: UserEvent - } - deriving stock (Eq, Show) - -- | a type representing the state of a single backend data MiniBackend = MkMiniBackend { -- | this is morally the same as the users stored in the actual backend -- invariant: for each key, the user.id and the key are the same - users :: [StoredUser] + users :: [StoredUser], + userKeys :: Map UserKey UserId, + passwordResetCodes :: Map PasswordResetKey (PRQueryData Identity) } instance Default MiniBackend where - def = MkMiniBackend {users = mempty} + def = + MkMiniBackend + { users = mempty, + userKeys = mempty, + passwordResetCodes = mempty + } -- | represents an entire federated, stateful world of backends newtype MiniFederation = MkMiniFederation @@ -224,19 +236,19 @@ runMiniFederation ownDomain backends = . runInputConst MkMiniContext {ownDomain = ownDomain} . unMiniFederation -interpretNowConst :: - UTCTime -> - Sem (Now : r) a -> +noOpLogger :: + Sem (Logger (Log.Msg -> Log.Msg) ': r) a -> Sem r a -interpretNowConst time = interpret \case - Wire.Sem.Now.Get -> pure time +noOpLogger = interpret $ \case + Log _lvl _msg -> pure () runFederationStack :: + (HasCallStack) => MiniBackend -> Map Domain MiniBackend -> Maybe TeamMember -> UserSubsystemConfig -> - Sem (GetUserProfileEffects `Append` AllErrors) a -> + Sem (MiniBackendEffects `Append` AllErrors) a -> a runFederationStack localBackend fedBackends teamMember cfg = runAllErrorsUnsafe @@ -247,34 +259,36 @@ runFederationStack localBackend fedBackends teamMember cfg = cfg interpretFederationStack :: - (Members AllErrors r) => + (HasCallStack, Members AllErrors r) => -- | the local backend MiniBackend -> -- | the available backends Map Domain MiniBackend -> Maybe TeamMember -> UserSubsystemConfig -> - Sem (GetUserProfileEffects `Append` r) a -> + Sem (MiniBackendEffects `Append` r) a -> Sem r a -interpretFederationStack localBackend backends teamMember cfg = - sequentiallyPerformConcurrency - . miniFederationAPIAccess backends - . runInputConst cfg - . interpretNowConst (UTCTime (ModifiedJulianDay 0) 0) - . evalState [] - . evalState localBackend - . evalState [] - . miniEventInterpreter - . inMemoryDeleteQueueInterpreter - . staticUserStoreInterpreter - . miniGalleyAPIAccess teamMember def - . runUserSubsystem cfg +interpretFederationStack localBackend remoteBackends teamMember cfg = + snd <$$> interpretFederationStackState localBackend remoteBackends teamMember cfg + +interpretFederationStackState :: + (HasCallStack, Members AllErrors r) => + -- | the local backend + MiniBackend -> + -- | the available backends + Map Domain MiniBackend -> + Maybe TeamMember -> + UserSubsystemConfig -> + Sem (MiniBackendEffects `Append` r) a -> + Sem r (MiniBackend, a) +interpretFederationStackState localBackend backends teamMember = + interpretMaybeFederationStackState (miniFederationAPIAccess backends) localBackend teamMember def runNoFederationStack :: MiniBackend -> Maybe TeamMember -> UserSubsystemConfig -> - Sem (GetUserProfileEffects `Append` AllErrors) a -> + Sem (MiniBackendEffects `Append` AllErrors) a -> a runNoFederationStack localBackend teamMember cfg = -- (A 'runNoFederationStackEither' variant of this that returns 'AllErrors' in an 'Either' @@ -283,36 +297,76 @@ runNoFederationStack localBackend teamMember cfg = -- want to do errors?) runAllErrorsUnsafe . interpretNoFederationStack localBackend teamMember def cfg +runNoFederationStackState :: + (HasCallStack) => + MiniBackend -> + Maybe TeamMember -> + UserSubsystemConfig -> + Sem (MiniBackendEffects `Append` AllErrors) a -> + (MiniBackend, a) +runNoFederationStackState localBackend teamMember cfg = + runAllErrorsUnsafe . interpretNoFederationStackState localBackend teamMember def cfg + interpretNoFederationStack :: (Members AllErrors r) => MiniBackend -> Maybe TeamMember -> AllFeatureConfigs -> UserSubsystemConfig -> - Sem (GetUserProfileEffects `Append` r) a -> + Sem (MiniBackendEffects `Append` r) a -> Sem r a interpretNoFederationStack localBackend teamMember galleyConfigs cfg = + snd <$$> interpretNoFederationStackState localBackend teamMember galleyConfigs cfg + +interpretNoFederationStackState :: + (Members AllErrors r) => + MiniBackend -> + Maybe TeamMember -> + AllFeatureConfigs -> + UserSubsystemConfig -> + Sem (MiniBackendEffects `Append` r) a -> + Sem r (MiniBackend, a) +interpretNoFederationStackState = interpretMaybeFederationStackState emptyFederationAPIAcesss + +interpretMaybeFederationStackState :: + (Members AllErrors r) => + InterpreterFor (FederationAPIAccess MiniFederationMonad) (Logger (Log.Msg -> Log.Msg) : Concurrency 'Unsafe : r) -> + MiniBackend -> + Maybe TeamMember -> + AllFeatureConfigs -> + UserSubsystemConfig -> + Sem (MiniBackendEffects `Append` r) a -> + Sem r (MiniBackend, a) +interpretMaybeFederationStackState maybeFederationAPIAccess localBackend teamMember galleyConfigs cfg = sequentiallyPerformConcurrency - . emptyFederationAPIAcesss + . noOpLogger + . maybeFederationAPIAccess + . runInputConst (toLocalUnsafe (Domain "localdomain") ()) . runInputConst cfg . interpretNowConst (UTCTime (ModifiedJulianDay 0) 0) . evalState [] - . evalState localBackend + . runState localBackend . evalState [] . miniEventInterpreter . inMemoryDeleteQueueInterpreter - . staticUserStoreInterpreter + . liftUserKeyStoreState + . inMemoryUserKeyStoreInterpreter + . liftUserStoreState + . inMemoryUserStoreInterpreter . miniGalleyAPIAccess teamMember galleyConfigs . runUserSubsystem cfg -runErrorUnsafe :: (Exception e) => InterpreterFor (Error e) r -runErrorUnsafe action = do - res <- runError action - case res of - Left e -> error $ "Unexpected error: " <> displayException e - Right x -> pure x +liftUserKeyStoreState :: (Member (State MiniBackend) r) => Sem (State (Map UserKey UserId) : r) a -> Sem r a +liftUserKeyStoreState = interpret $ \case + Polysemy.State.Get -> gets (.userKeys) + Put newUserKeys -> modify $ \b -> b {userKeys = newUserKeys} + +liftUserStoreState :: (Member (State MiniBackend) r) => Sem (State [StoredUser] : r) a -> Sem r a +liftUserStoreState = interpret $ \case + Polysemy.State.Get -> gets (.users) + Put newUsers -> modify $ \b -> b {users = newUsers} -runAllErrorsUnsafe :: forall a. Sem AllErrors a -> a +runAllErrorsUnsafe :: forall a. (HasCallStack) => Sem AllErrors a -> a runAllErrorsUnsafe = run . runErrorUnsafe . runErrorUnsafe emptyFederationAPIAcesss :: InterpreterFor (FederationAPIAccess MiniFederationMonad) r @@ -321,6 +375,7 @@ emptyFederationAPIAcesss = interpret $ \case miniFederationAPIAccess :: forall a r. + (HasCallStack) => Map Domain MiniBackend -> Sem (FederationAPIAccess MiniFederationMonad : r) a -> Sem r a @@ -335,79 +390,3 @@ miniFederationAPIAccess online = do RunFederatedConcurrently _remotes _rpc -> error "unimplemented: RunFederatedConcurrently" RunFederatedBucketed _domain _rpc -> error "unimplemented: RunFederatedBucketed" IsFederationConfigured -> pure True - -getLocalUsers :: (Member (State MiniBackend) r) => Sem r [StoredUser] -getLocalUsers = gets (.users) - -modifyLocalUsers :: - (Member (State MiniBackend) r) => - ([StoredUser] -> Sem r [StoredUser]) -> - Sem r () -modifyLocalUsers f = do - us <- gets (.users) - us' <- f us - modify $ \b -> b {users = us'} - -staticUserStoreInterpreter :: - forall r. - (Member (State MiniBackend) r) => - InterpreterFor UserStore r -staticUserStoreInterpreter = interpret $ \case - GetUser uid -> find (\user -> user.id == uid) <$> getLocalUsers - UpdateUser uid update -> modifyLocalUsers (pure . fmap doUpdate) - where - doUpdate :: StoredUser -> StoredUser - doUpdate u = - if u.id == uid - then - maybe Imports.id setStoredUserAccentId update.accentId - . maybe Imports.id setStoredUserAssets update.assets - . maybe Imports.id setStoredUserPict update.pict - . maybe Imports.id setStoredUserName update.name - . maybe Imports.id setStoredUserLocale update.locale - . maybe Imports.id setStoredUserSupportedProtocols update.supportedProtocols - $ u - else u - UpdateUserHandleEither uid hUpdate -> runError $ modifyLocalUsers (traverse doUpdate) - where - doUpdate :: StoredUser -> Sem (Error StoredUserUpdateError : r) StoredUser - doUpdate u - | u.id == uid = do - handles <- mapMaybe (.handle) <$> gets (.users) - when - ( hUpdate.old /= Just hUpdate.new - && elem hUpdate.new handles - ) - $ throw StoredUserUpdateHandleExists - pure $ setStoredUserHandle hUpdate.new u - doUpdate u = pure u - DeleteUser user -> modifyLocalUsers $ \us -> - pure $ filter (\u -> u.id /= User.userId user) us - LookupHandle h -> miniBackendLookupHandle h - GlimpseHandle h -> miniBackendLookupHandle h - -miniBackendLookupHandle :: - (Member (State MiniBackend) r) => - Handle -> - Sem r (Maybe UserId) -miniBackendLookupHandle h = do - users <- gets (.users) - pure $ fmap (.id) (find ((== Just h) . (.handle)) users) - --- | interprets galley by statically returning the values passed -miniGalleyAPIAccess :: - -- | what to return when calling GetTeamMember - Maybe TeamMember -> - -- | what to return when calling GetAllFeatureConfigsForUser - AllFeatureConfigs -> - InterpreterFor GalleyAPIAccess r -miniGalleyAPIAccess member configs = interpret $ \case - GetTeamMember _ _ -> pure member - GetAllFeatureConfigsForUser _ -> pure configs - _ -> error "uninterpreted effect: GalleyAPIAccess" - -miniEventInterpreter :: - (Member (State [MiniEvent]) r) => - InterpreterFor UserEvents r -miniEventInterpreter = interpret \case - GenerateUserEvent uid _mconn e -> modify (MkMiniEvent uid e :) diff --git a/libs/wire-subsystems/test/unit/Wire/MockInterpreters.hs b/libs/wire-subsystems/test/unit/Wire/MockInterpreters.hs new file mode 100644 index 00000000000..51016fddd9d --- /dev/null +++ b/libs/wire-subsystems/test/unit/Wire/MockInterpreters.hs @@ -0,0 +1,16 @@ +module Wire.MockInterpreters (module MockInterpreters) where + +-- Run this from project root to generate the imports: +-- ls libs/wire-subsystems/test/unit/Wire/MockInterpreters | sed 's|\(.*\)\.hs|import Wire.MockInterpreters.\1 as MockInterpreters|' + +import Wire.MockInterpreters.Error as MockInterpreters +import Wire.MockInterpreters.GalleyAPIAccess as MockInterpreters +import Wire.MockInterpreters.HashPassword as MockInterpreters +import Wire.MockInterpreters.Now as MockInterpreters +import Wire.MockInterpreters.PasswordResetCodeStore as MockInterpreters +import Wire.MockInterpreters.PasswordStore as MockInterpreters +import Wire.MockInterpreters.SessionStore as MockInterpreters +import Wire.MockInterpreters.UserEvents as MockInterpreters +import Wire.MockInterpreters.UserKeyStore as MockInterpreters +import Wire.MockInterpreters.UserStore as MockInterpreters +import Wire.MockInterpreters.UserSubsystem as MockInterpreters diff --git a/libs/wire-subsystems/test/unit/Wire/MockInterpreters/Error.hs b/libs/wire-subsystems/test/unit/Wire/MockInterpreters/Error.hs new file mode 100644 index 00000000000..09ed07d043d --- /dev/null +++ b/libs/wire-subsystems/test/unit/Wire/MockInterpreters/Error.hs @@ -0,0 +1,15 @@ +module Wire.MockInterpreters.Error where + +import Imports +import Polysemy +import Polysemy.Error + +runErrorUnsafe :: (HasCallStack, Exception e) => InterpreterFor (Error e) r +runErrorUnsafe action = do + res <- runError action + case res of + Left e -> error $ "Unexpected error: " <> displayException e + Right x -> pure x + +catchExpectedError :: (Member (Error e) r) => Sem r a -> Sem r (Maybe e) +catchExpectedError action = (Nothing <$ action) `catch` (pure . Just) diff --git a/libs/wire-subsystems/test/unit/Wire/MockInterpreters/GalleyAPIAccess.hs b/libs/wire-subsystems/test/unit/Wire/MockInterpreters/GalleyAPIAccess.hs new file mode 100644 index 00000000000..1e8a81e9f51 --- /dev/null +++ b/libs/wire-subsystems/test/unit/Wire/MockInterpreters/GalleyAPIAccess.hs @@ -0,0 +1,19 @@ +module Wire.MockInterpreters.GalleyAPIAccess where + +import Imports +import Polysemy +import Wire.API.Team.Feature +import Wire.API.Team.Member +import Wire.GalleyAPIAccess + +-- | interprets galley by statically returning the values passed +miniGalleyAPIAccess :: + -- | what to return when calling GetTeamMember + Maybe TeamMember -> + -- | what to return when calling GetAllFeatureConfigsForUser + AllFeatureConfigs -> + InterpreterFor GalleyAPIAccess r +miniGalleyAPIAccess member configs = interpret $ \case + GetTeamMember _ _ -> pure member + GetAllFeatureConfigsForUser _ -> pure configs + _ -> error "uninterpreted effect: GalleyAPIAccess" diff --git a/libs/wire-subsystems/test/unit/Wire/MockInterpreters/HashPassword.hs b/libs/wire-subsystems/test/unit/Wire/MockInterpreters/HashPassword.hs new file mode 100644 index 00000000000..05c15259bec --- /dev/null +++ b/libs/wire-subsystems/test/unit/Wire/MockInterpreters/HashPassword.hs @@ -0,0 +1,28 @@ +module Wire.MockInterpreters.HashPassword where + +import Crypto.KDF.Argon2 as Argon2 +import Data.Misc +import Data.Text.Encoding qualified as Text +import Imports +import Polysemy +import Wire.API.Password +import Wire.HashPassword + +staticHashPasswordInterpreter :: InterpreterFor HashPassword r +staticHashPasswordInterpreter = interpret $ \case + HashPassword password -> go (hashPasswordArgon2idWithOptions fastArgon2IdOptions) "9bytesalt" password + where + go alg salt password = do + let passwordBS = Text.encodeUtf8 (fromPlainTextPassword password) + pure $ unsafeMkPassword $ alg salt passwordBS + +fastArgon2IdOptions :: Argon2.Options +fastArgon2IdOptions = + let hashParallelism = 4 + in defaultOptions + { iterations = 1, + parallelism = hashParallelism, + -- This needs to be min 8 * hashParallelism, otherewise we get an + -- unsafe error + memory = 8 * hashParallelism + } diff --git a/libs/wire-subsystems/test/unit/Wire/MockInterpreters/Now.hs b/libs/wire-subsystems/test/unit/Wire/MockInterpreters/Now.hs new file mode 100644 index 00000000000..52d4116ecaf --- /dev/null +++ b/libs/wire-subsystems/test/unit/Wire/MockInterpreters/Now.hs @@ -0,0 +1,22 @@ +module Wire.MockInterpreters.Now where + +import Data.Time +import Imports +import Polysemy +import Polysemy.State +import Wire.Sem.Now + +interpretNowConst :: + UTCTime -> + Sem (Now : r) a -> + Sem r a +interpretNowConst time = interpret \case + Wire.Sem.Now.Get -> pure time + +interpretNowAsState :: (Member (State UTCTime) r) => InterpreterFor Now r +interpretNowAsState = + interpret $ \case + Wire.Sem.Now.Get -> Polysemy.State.get + +passTime :: (Member (State UTCTime) r) => NominalDiffTime -> Sem r () +passTime t = modify (addUTCTime t) diff --git a/libs/wire-subsystems/test/unit/Wire/MockInterpreters/PasswordResetCodeStore.hs b/libs/wire-subsystems/test/unit/Wire/MockInterpreters/PasswordResetCodeStore.hs new file mode 100644 index 00000000000..25d6ab11d89 --- /dev/null +++ b/libs/wire-subsystems/test/unit/Wire/MockInterpreters/PasswordResetCodeStore.hs @@ -0,0 +1,28 @@ +module Wire.MockInterpreters.PasswordResetCodeStore where + +import Data.Map qualified as Map +import Data.Text.Ascii +import Imports +import Polysemy +import Polysemy.State +import Wire.API.User.Password +import Wire.PasswordResetCodeStore + +inMemoryPasswordResetCodeStore :: + forall r. + (Member (State (Map PasswordResetKey (PRQueryData Identity))) r) => + InterpreterFor PasswordResetCodeStore r +inMemoryPasswordResetCodeStore = + interpret + \case + GenerateEmailCode -> + pure . PasswordResetCode . encodeBase64Url $ "email-code" + GeneratePhoneCode -> (error "deprecated") + CodeSelect resetKey -> do + gets $ + fmap (mapPRQueryData (Just . runIdentity)) + . Map.lookup resetKey + CodeInsert resetKey queryData _ttl -> do + modify $ Map.insert resetKey queryData + CodeDelete resetKey -> do + modify $ Map.delete resetKey diff --git a/libs/wire-subsystems/test/unit/Wire/MockInterpreters/PasswordStore.hs b/libs/wire-subsystems/test/unit/Wire/MockInterpreters/PasswordStore.hs new file mode 100644 index 00000000000..be4f1a140d3 --- /dev/null +++ b/libs/wire-subsystems/test/unit/Wire/MockInterpreters/PasswordStore.hs @@ -0,0 +1,14 @@ +module Wire.MockInterpreters.PasswordStore where + +import Data.Id +import Data.Map qualified as Map +import Imports +import Polysemy +import Polysemy.State +import Wire.API.Password +import Wire.PasswordStore + +inMemoryPasswordStoreInterpreter :: (Member (State (Map UserId Password)) r) => InterpreterFor PasswordStore r +inMemoryPasswordStoreInterpreter = interpret $ \case + UpsertHashedPassword uid password -> modify $ Map.insert uid password + LookupHashedPassword uid -> gets $ Map.lookup uid diff --git a/libs/wire-subsystems/test/unit/Wire/MockInterpreters/SessionStore.hs b/libs/wire-subsystems/test/unit/Wire/MockInterpreters/SessionStore.hs new file mode 100644 index 00000000000..43e2736ba2e --- /dev/null +++ b/libs/wire-subsystems/test/unit/Wire/MockInterpreters/SessionStore.hs @@ -0,0 +1,17 @@ +module Wire.MockInterpreters.SessionStore where + +import Data.Id +import Data.Map qualified as Map +import Imports +import Polysemy +import Polysemy.State +import Wire.API.User.Auth +import Wire.SessionStore + +inMemorySessionStoreInterpreter :: (Member (State (Map UserId [Cookie ()])) r) => InterpreterFor SessionStore r +inMemorySessionStoreInterpreter = interpret $ \case + InsertCookie uid cookie _ttl -> modify $ Map.insertWith (<>) uid [cookie] + ListCookies uid -> gets (Map.findWithDefault [] uid) + DeleteAllCookies uid -> modify $ Map.delete uid + DeleteCookies uid cc -> (error "implement on demand") uid cc + LookupCookie uid time cid -> (error "implement on demand") uid time cid diff --git a/libs/wire-subsystems/test/unit/Wire/MockInterpreters/UserEvents.hs b/libs/wire-subsystems/test/unit/Wire/MockInterpreters/UserEvents.hs new file mode 100644 index 00000000000..4bcd7319418 --- /dev/null +++ b/libs/wire-subsystems/test/unit/Wire/MockInterpreters/UserEvents.hs @@ -0,0 +1,20 @@ +module Wire.MockInterpreters.UserEvents where + +import Data.Id +import Imports +import Polysemy +import Polysemy.State +import Wire.API.UserEvent +import Wire.UserEvents + +data MiniEvent = MkMiniEvent + { userId :: UserId, + event :: UserEvent + } + deriving stock (Eq, Show) + +miniEventInterpreter :: + (Member (State [MiniEvent]) r) => + InterpreterFor UserEvents r +miniEventInterpreter = interpret \case + GenerateUserEvent uid _mconn e -> modify (MkMiniEvent uid e :) diff --git a/libs/wire-subsystems/test/unit/Wire/MockInterpreters/UserKeyStore.hs b/libs/wire-subsystems/test/unit/Wire/MockInterpreters/UserKeyStore.hs new file mode 100644 index 00000000000..1b7ccb94c01 --- /dev/null +++ b/libs/wire-subsystems/test/unit/Wire/MockInterpreters/UserKeyStore.hs @@ -0,0 +1,31 @@ +module Wire.MockInterpreters.UserKeyStore where + +import Data.Id +import Data.Map qualified as M +import Imports +import Polysemy +import Polysemy.State +import Wire.UserKeyStore + +inMemoryUserKeyStoreInterpreter :: + (Member (State (Map UserKey UserId)) r) => + InterpreterFor UserKeyStore r +inMemoryUserKeyStoreInterpreter = interpret $ \case + LookupKey key -> do + gets (M.lookup key) + InsertKey uid key -> + modify $ M.insert key uid + DeleteKey key -> + modify $ M.delete key + DeleteKeyForUser uid key -> + modify $ M.filterWithKey (\k u -> k /= key && u /= uid) + ClaimKey key uid -> do + keys <- get + let free = M.notMember key keys || M.lookup key keys == (Just uid) + when free $ + modify $ + M.insert key uid + pure free + KeyAvailable key uid -> do + keys <- get + pure $ M.notMember key keys || M.lookup key keys == uid diff --git a/libs/wire-subsystems/test/unit/Wire/MockInterpreters/UserStore.hs b/libs/wire-subsystems/test/unit/Wire/MockInterpreters/UserStore.hs new file mode 100644 index 00000000000..1669ac292ea --- /dev/null +++ b/libs/wire-subsystems/test/unit/Wire/MockInterpreters/UserStore.hs @@ -0,0 +1,78 @@ +module Wire.MockInterpreters.UserStore where + +import Data.Handle +import Data.Id +import Imports +import Polysemy +import Polysemy.Error +import Polysemy.State +import Wire.API.User hiding (DeleteUser) +import Wire.API.User qualified as User +import Wire.StoredUser +import Wire.UserStore + +inMemoryUserStoreInterpreter :: + forall r. + (Member (State [StoredUser]) r) => + InterpreterFor UserStore r +inMemoryUserStoreInterpreter = interpret $ \case + GetUser uid -> gets $ find (\user -> user.id == uid) + UpdateUser uid update -> modify (map doUpdate) + where + doUpdate :: StoredUser -> StoredUser + doUpdate u = + if u.id == uid + then + maybe Imports.id setStoredUserAccentId update.accentId + . maybe Imports.id setStoredUserAssets update.assets + . maybe Imports.id setStoredUserPict update.pict + . maybe Imports.id setStoredUserName update.name + . maybe Imports.id setStoredUserLocale update.locale + . maybe Imports.id setStoredUserSupportedProtocols update.supportedProtocols + $ u + else u + UpdateUserHandleEither uid hUpdate -> runError $ modifyLocalUsers (traverse doUpdate) + where + doUpdate :: StoredUser -> Sem (Error StoredUserUpdateError : r) StoredUser + doUpdate u + | u.id == uid = do + handles <- gets $ mapMaybe (.handle) + when + ( hUpdate.old + /= Just hUpdate.new + && elem hUpdate.new handles + ) + $ throw StoredUserUpdateHandleExists + pure $ setStoredUserHandle hUpdate.new u + doUpdate u = pure u + + modifyLocalUsers :: forall r1. (Member (State [StoredUser]) r1) => ([StoredUser] -> Sem r1 [StoredUser]) -> Sem r1 () + modifyLocalUsers f = do + us <- get + us' <- f us + put us' + DeleteUser user -> modify $ filter (\u -> u.id /= User.userId user) + LookupHandle h -> miniBackendLookupHandle h + GlimpseHandle h -> miniBackendLookupHandle h + LookupStatus uid -> miniBackendLookupStatus uid + IsActivated uid -> miniBackendIsActivated uid + +miniBackendIsActivated :: (Member (State [StoredUser]) r) => UserId -> Sem r Bool +miniBackendIsActivated uid = do + gets $ + maybe False (.activated) + . find ((== uid) . (.id)) + +miniBackendLookupStatus :: (Member (State [StoredUser]) r) => UserId -> Sem r (Maybe AccountStatus) +miniBackendLookupStatus uid = do + users <- get + pure $ (.status) =<< (find ((== uid) . (.id)) users) + +miniBackendLookupHandle :: + (Member (State [StoredUser]) r) => + Handle -> + Sem r (Maybe UserId) +miniBackendLookupHandle h = do + gets $ + fmap (.id) + . find ((== Just h) . (.handle)) diff --git a/libs/wire-subsystems/test/unit/Wire/MockInterpreters/UserSubsystem.hs b/libs/wire-subsystems/test/unit/Wire/MockInterpreters/UserSubsystem.hs new file mode 100644 index 00000000000..c24f428e12c --- /dev/null +++ b/libs/wire-subsystems/test/unit/Wire/MockInterpreters/UserSubsystem.hs @@ -0,0 +1,16 @@ +module Wire.MockInterpreters.UserSubsystem where + +import Data.Qualified +import Imports +import Polysemy +import Wire.API.User +import Wire.UserKeyStore +import Wire.UserSubsystem + +userSubsystemTestInterpreter :: [UserAccount] -> InterpreterFor UserSubsystem r +userSubsystemTestInterpreter initialUsers = + interpret \case + GetLocalUserAccountByUserKey localUserKey -> case (tUnqualified localUserKey) of + UserEmailKey (EmailKey _ email) -> pure $ find (\u -> userEmail u.accountUser == Just email) initialUsers + UserPhoneKey _ -> pure Nothing -- Phone stuff is deprecated and soon to be deleted anyway + _ -> error $ "userSubsystemTestInterpreter: implement on demand" diff --git a/libs/wire-subsystems/test/unit/Wire/UserSubsystem/InterpreterSpec.hs b/libs/wire-subsystems/test/unit/Wire/UserSubsystem/InterpreterSpec.hs index c5dd5bd58ef..d038149d065 100644 --- a/libs/wire-subsystems/test/unit/Wire/UserSubsystem/InterpreterSpec.hs +++ b/libs/wire-subsystems/test/unit/Wire/UserSubsystem/InterpreterSpec.hs @@ -11,6 +11,7 @@ import Data.Domain import Data.Handle import Data.Id import Data.LegalHold (defUserLegalHoldStatus) +import Data.Map qualified as Map import Data.Qualified import Data.Set qualified as S import Imports @@ -28,8 +29,9 @@ import Wire.API.Team.Permission import Wire.API.User hiding (DeleteUser) import Wire.API.UserEvent import Wire.MiniBackend -import Wire.StoredUser as SU -import Wire.UserSubsystem as US +import Wire.StoredUser +import Wire.UserKeyStore +import Wire.UserSubsystem import Wire.UserSubsystem.HandleBlacklist import Wire.UserSubsystem.Interpreter (UserSubsystemConfig (..)) @@ -433,7 +435,7 @@ spec = describe "UserSubsystem.Interpreter" do where dom = Domain "localdomain" - operation :: (Monad m) => Sem (GetUserProfileEffects `Append` AllErrors) a -> m a + operation :: (Monad m) => Sem (MiniBackendEffects `Append` AllErrors) a -> m a operation op = result `seq` pure result where result = runNoFederationStack localBackend Nothing config op @@ -448,3 +450,50 @@ spec = describe "UserSubsystem.Interpreter" do then defSupportedProtocols else newSupportedProtocols in actualSupportedProtocols === expectedSupportedProtocols + + describe "getLocalUserAccountByUserKey" $ do + prop "gets users iff they are indexed by the UserKeyStore" $ + \(config :: UserSubsystemConfig) (localDomain :: Domain) (storedUser :: StoredUser) (userKey :: UserKey) -> + let localBackend = + def + { users = [storedUser], + userKeys = Map.singleton userKey storedUser.id + } + retrievedUser = + run + . runErrorUnsafe + . runErrorUnsafe @UserSubsystemError + . interpretNoFederationStack localBackend Nothing def config + $ getLocalUserAccountByUserKey (toLocalUnsafe localDomain userKey) + in retrievedUser === Just (mkAccountFromStored localDomain config.defaultLocale storedUser) + + prop "doesn't get users if they are not indexed by the UserKeyStore" $ + \(config :: UserSubsystemConfig) (localDomain :: Domain) (storedUserNoEmail :: StoredUser) (email :: Email) -> + let localBackend = + def + { users = [storedUser], + userKeys = mempty + } + storedUser = storedUserNoEmail {email = Just email} + retrievedUser = + run + . runErrorUnsafe + . runErrorUnsafe @UserSubsystemError + . interpretNoFederationStack localBackend Nothing def config + $ getLocalUserAccountByUserKey (toLocalUnsafe localDomain (userEmailKey email)) + in retrievedUser === Nothing + + prop "doesn't get users if they are not present in the UserStore but somehow are still indexed in UserKeyStore" $ + \(config :: UserSubsystemConfig) (localDomain :: Domain) (nonExistentUserId :: UserId) (userKey :: UserKey) -> + let localBackend = + def + { users = [], + userKeys = Map.singleton userKey nonExistentUserId + } + retrievedUser = + run + . runErrorUnsafe + . runErrorUnsafe @UserSubsystemError + . interpretNoFederationStack localBackend Nothing def config + $ getLocalUserAccountByUserKey (toLocalUnsafe localDomain userKey) + in retrievedUser === Nothing diff --git a/libs/wire-subsystems/wire-subsystems.cabal b/libs/wire-subsystems/wire-subsystems.cabal index 4ed2a43d58c..7825a0a5eaa 100644 --- a/libs/wire-subsystems/wire-subsystems.cabal +++ b/libs/wire-subsystems/wire-subsystems.cabal @@ -69,6 +69,9 @@ library -- cabal-fmt: expand src exposed-modules: + Wire.AuthenticationSubsystem + Wire.AuthenticationSubsystem.Error + Wire.AuthenticationSubsystem.Interpreter Wire.DeleteQueue Wire.DeleteQueue.InMemory Wire.FederationAPIAccess @@ -76,18 +79,27 @@ library Wire.GalleyAPIAccess Wire.GalleyAPIAccess.Rpc Wire.GundeckAPIAccess + Wire.HashPassword Wire.InternalEvent - Wire.MiniBackend Wire.NotificationSubsystem Wire.NotificationSubsystem.Interpreter Wire.ParseException + Wire.PasswordResetCodeStore + Wire.PasswordResetCodeStore.Cassandra + Wire.PasswordStore + Wire.PasswordStore.Cassandra Wire.Rpc + Wire.SessionStore + Wire.SessionStore.Cassandra Wire.StoredUser Wire.UserEvents + Wire.UserKeyStore + Wire.UserKeyStore.Cassandra Wire.UserStore Wire.UserStore.Cassandra Wire.UserStore.Unique Wire.UserSubsystem + Wire.UserSubsystem.Error Wire.UserSubsystem.HandleBlacklist Wire.UserSubsystem.Interpreter @@ -161,6 +173,20 @@ test-suite wire-subsystems-tests -- cabal-fmt: expand test/unit other-modules: Spec + Wire.AuthenticationSubsystem.InterpreterSpec + Wire.MiniBackend + Wire.MockInterpreters + Wire.MockInterpreters.Error + Wire.MockInterpreters.GalleyAPIAccess + Wire.MockInterpreters.HashPassword + Wire.MockInterpreters.Now + Wire.MockInterpreters.PasswordResetCodeStore + Wire.MockInterpreters.PasswordStore + Wire.MockInterpreters.SessionStore + Wire.MockInterpreters.UserEvents + Wire.MockInterpreters.UserKeyStore + Wire.MockInterpreters.UserStore + Wire.MockInterpreters.UserSubsystem Wire.NotificationSubsystem.InterpreterSpec Wire.UserStoreSpec Wire.UserSubsystem.InterpreterSpec @@ -173,6 +199,7 @@ test-suite wire-subsystems-tests , bilge , bytestring , containers + , crypton , data-default , errors , extended @@ -191,6 +218,7 @@ test-suite wire-subsystems-tests , string-conversions , text , time + , tinylog , transformers , types-common , wire-api diff --git a/services/brig/brig.cabal b/services/brig/brig.cabal index 7b4ca0998ac..d80738ecaab 100644 --- a/services/brig/brig.cabal +++ b/services/brig/brig.cabal @@ -76,7 +76,6 @@ library -- cabal-fmt: expand src exposed-modules: - Brig.Allowlists Brig.API.Auth Brig.API.Client Brig.API.Connection @@ -116,21 +115,16 @@ library Brig.Data.Properties Brig.Data.Types Brig.Data.User - Brig.Data.UserKey Brig.DeleteQueue.Interpreter Brig.Effects.BlacklistPhonePrefixStore Brig.Effects.BlacklistPhonePrefixStore.Cassandra Brig.Effects.BlacklistStore Brig.Effects.BlacklistStore.Cassandra - Brig.Effects.CodeStore - Brig.Effects.CodeStore.Cassandra Brig.Effects.ConnectionStore Brig.Effects.ConnectionStore.Cassandra Brig.Effects.FederationConfigStore Brig.Effects.FederationConfigStore.Cassandra Brig.Effects.JwtTools - Brig.Effects.PasswordResetStore - Brig.Effects.PasswordResetStore.CodeStore Brig.Effects.PublicKeyBundle Brig.Effects.SFT Brig.Effects.UserPendingActivationStore @@ -213,8 +207,6 @@ library Brig.User.Auth Brig.User.Auth.Cookie Brig.User.Auth.Cookie.Limit - Brig.User.Auth.DB.Cookie - Brig.User.Auth.DB.Instances Brig.User.EJPD Brig.User.Email Brig.User.Phone @@ -520,6 +512,7 @@ executable brig-integration , warp-tls >=3.2 , wire-api , wire-api-federation + , wire-subsystems , yaml , zauth diff --git a/services/brig/default.nix b/services/brig/default.nix index 9d72a9fefea..49fdb470ae6 100644 --- a/services/brig/default.nix +++ b/services/brig/default.nix @@ -384,6 +384,7 @@ mkDerivation { warp-tls wire-api wire-api-federation + wire-subsystems yaml zauth ]; diff --git a/services/brig/src/Brig/API/Auth.hs b/services/brig/src/Brig/API/Auth.hs index 089d2969d04..218a1cbd990 100644 --- a/services/brig/src/Brig/API/Auth.hs +++ b/services/brig/src/Brig/API/Auth.hs @@ -53,7 +53,10 @@ import Wire.API.User.Auth.ReAuth import Wire.API.User.Auth.Sso import Wire.GalleyAPIAccess import Wire.NotificationSubsystem +import Wire.PasswordStore (PasswordStore) import Wire.Sem.Paging.Cassandra (InternalPaging) +import Wire.UserKeyStore hiding (toEither) +import Wire.UserStore import Wire.UserSubsystem accessH :: @@ -91,7 +94,7 @@ access mcid t mt = traverse mkUserTokenCookie =<< Auth.renewAccess (List1 t) mt mcid !>> zauthError -sendLoginCode :: (Member TinyLog r) => SendLoginCode -> Handler r LoginCodeTimeout +sendLoginCode :: (Member TinyLog r, Member UserKeyStore r, Member PasswordStore r) => SendLoginCode -> Handler r LoginCodeTimeout sendLoginCode (SendLoginCode phone call force) = do checkAllowlist (Right phone) c <- Auth.sendLoginCode phone call force !>> sendLoginCodeError @@ -104,7 +107,10 @@ login :: Member NotificationSubsystem r, Member (Input (Local ())) r, Member (Input UTCTime) r, - Member (ConnectionStore InternalPaging) r + Member (ConnectionStore InternalPaging) r, + Member PasswordStore r, + Member UserKeyStore r, + Member UserStore r ) => Login -> Maybe Bool -> @@ -129,7 +135,9 @@ logout _ Nothing = throwStd authMissingToken logout uts (Just at) = Auth.logout (List1 uts) at !>> zauthError changeSelfEmailH :: - (Member BlacklistStore r) => + ( Member BlacklistStore r, + Member UserKeyStore r + ) => [Either Text SomeUserToken] -> Maybe (Either Text SomeAccessToken) -> EmailUpdate -> @@ -156,7 +164,7 @@ listCookies lusr (fold -> labels) = CookieList <$> wrapClientE (Auth.listCookies (tUnqualified lusr) (toList labels)) -removeCookies :: (Member TinyLog r) => Local UserId -> RemoveCookies -> Handler r () +removeCookies :: (Member TinyLog r, Member PasswordStore r) => Local UserId -> RemoveCookies -> Handler r () removeCookies lusr (RemoveCookies pw lls ids) = Auth.revokeAccess (tUnqualified lusr) pw ids lls !>> authError @@ -192,7 +200,7 @@ ssoLogin l (fromMaybe False -> persist) = do c <- Auth.ssoLogin l typ !>> loginError traverse mkUserTokenCookie c -getLoginCode :: (Member TinyLog r) => Phone -> Handler r PendingLoginCode +getLoginCode :: (Member TinyLog r, Member UserKeyStore r) => Phone -> Handler r PendingLoginCode getLoginCode phone = do code <- lift $ Auth.lookupLoginCode phone maybe (throwStd loginCodeNotFound) pure code diff --git a/services/brig/src/Brig/API/Connection.hs b/services/brig/src/Brig/API/Connection.hs index 2b6eb43e05d..f718cd465d1 100644 --- a/services/brig/src/Brig/API/Connection.hs +++ b/services/brig/src/Brig/API/Connection.hs @@ -71,6 +71,7 @@ import Wire.API.UserEvent import Wire.GalleyAPIAccess import Wire.GalleyAPIAccess qualified as GalleyAPIAccess import Wire.NotificationSubsystem +import Wire.UserStore ensureNotSameTeam :: (Member GalleyAPIAccess r) => Local UserId -> Local UserId -> (ConnectionM r) () ensureNotSameTeam self target = do @@ -84,6 +85,7 @@ createConnection :: Member GalleyAPIAccess r, Member NotificationSubsystem r, Member TinyLog r, + Member UserStore r, Member (Embed HttpClientIO) r ) => Local UserId -> @@ -103,6 +105,7 @@ createConnectionToLocalUser :: ( Member GalleyAPIAccess r, Member NotificationSubsystem r, Member TinyLog r, + Member UserStore r, Member (Embed HttpClientIO) r ) => Local UserId -> diff --git a/services/brig/src/Brig/API/Connection/Remote.hs b/services/brig/src/Brig/API/Connection/Remote.hs index ea9f16a1a1c..03b650731c8 100644 --- a/services/brig/src/Brig/API/Connection/Remote.hs +++ b/services/brig/src/Brig/API/Connection/Remote.hs @@ -53,6 +53,7 @@ import Wire.API.User import Wire.API.UserEvent import Wire.GalleyAPIAccess import Wire.NotificationSubsystem +import Wire.UserStore data LocalConnectionAction = LocalConnect @@ -300,6 +301,7 @@ performRemoteAction self other mconnection action = do createConnectionToRemoteUser :: ( Member GalleyAPIAccess r, Member FederationConfigStore r, + Member UserStore r, Member NotificationSubsystem r ) => Local UserId -> diff --git a/services/brig/src/Brig/API/Connection/Util.hs b/services/brig/src/Brig/API/Connection/Util.hs index 6b3cf894483..118c03bcc03 100644 --- a/services/brig/src/Brig/API/Connection/Util.hs +++ b/services/brig/src/Brig/API/Connection/Util.hs @@ -26,7 +26,6 @@ where import Brig.API.Types import Brig.App import Brig.Data.Connection qualified as Data -import Brig.Data.User qualified as Data import Brig.Options (Settings (setUserMaxConnections)) import Control.Error (MaybeT, noteT) import Control.Lens (view) @@ -34,7 +33,9 @@ import Control.Monad.Trans.Except import Data.Id (UserId) import Data.Qualified import Imports +import Polysemy import Wire.API.Connection (Relation (..)) +import Wire.UserStore type ConnectionM r = ExceptT ConnectionError (AppT r) @@ -46,14 +47,14 @@ checkLimit u = noteT (TooManyConnections (tUnqualified u)) $ do l <- setUserMaxConnections <$> view settings guard (n < l) -ensureNotSameAndActivated :: Local UserId -> Qualified UserId -> ConnectionM r () +ensureNotSameAndActivated :: (Member UserStore r) => Local UserId -> Qualified UserId -> ConnectionM r () ensureNotSameAndActivated self target = do when (tUntagged self == target) $ throwE (InvalidUser target) noteT ConnectNoIdentity $ ensureIsActivated self -ensureIsActivated :: Local UserId -> MaybeT (AppT r) () +ensureIsActivated :: (Member UserStore r) => Local UserId -> MaybeT (AppT r) () ensureIsActivated lusr = do - active <- lift . wrapClient $ Data.isActivated (tUnqualified lusr) + active <- lift . liftSem $ isActivated (tUnqualified lusr) guard active diff --git a/services/brig/src/Brig/API/Federation.hs b/services/brig/src/Brig/API/Federation.hs index 8d4ec27088c..68c1f4f6cc7 100644 --- a/services/brig/src/Brig/API/Federation.hs +++ b/services/brig/src/Brig/API/Federation.hs @@ -119,6 +119,7 @@ getFederationStatus _ request = do sendConnectionAction :: ( Member FederationConfigStore r, Member GalleyAPIAccess r, + Member UserStore r, Member NotificationSubsystem r ) => Domain -> @@ -129,7 +130,7 @@ sendConnectionAction originDomain NewConnectionRequest {..} = do federates <- lift . liftSem . E.backendFederatesWith $ rTeam if federates then do - active <- lift $ wrapClient $ Data.isActivated to + active <- lift . liftSem $ isActivated to if active then do self <- qualifyLocal to diff --git a/services/brig/src/Brig/API/Handler.hs b/services/brig/src/Brig/API/Handler.hs index 4c6e92e341a..ebe7ac1ac0b 100644 --- a/services/brig/src/Brig/API/Handler.hs +++ b/services/brig/src/Brig/API/Handler.hs @@ -32,7 +32,6 @@ where import Bilge (RequestId (..)) import Brig.API.Error import Brig.AWS qualified as AWS -import Brig.Allowlists qualified as Allowlists import Brig.App import Brig.CanonicalInterpreter (BrigCanonicalEffects, runBrigToIO) import Brig.Email (Email) @@ -58,6 +57,7 @@ import Network.Wai.Utilities.Server qualified as Server import Servant qualified import System.Logger qualified as Log import System.Logger.Class (Logger) +import Wire.API.Allowlists qualified as Allowlists import Wire.API.Error import Wire.API.Error.Brig diff --git a/services/brig/src/Brig/API/Internal.hs b/services/brig/src/Brig/API/Internal.hs index 0fc40ee44d4..be734c5e76d 100644 --- a/services/brig/src/Brig/API/Internal.hs +++ b/services/brig/src/Brig/API/Internal.hs @@ -40,7 +40,6 @@ import Brig.Data.MLS.KeyPackage qualified as Data import Brig.Data.User qualified as Data import Brig.Effects.BlacklistPhonePrefixStore (BlacklistPhonePrefixStore) import Brig.Effects.BlacklistStore (BlacklistStore) -import Brig.Effects.CodeStore (CodeStore) import Brig.Effects.ConnectionStore (ConnectionStore) import Brig.Effects.FederationConfigStore ( AddFederationRemoteResult (..), @@ -49,7 +48,6 @@ import Brig.Effects.FederationConfigStore UpdateFederationResult (..), ) import Brig.Effects.FederationConfigStore qualified as E -import Brig.Effects.PasswordResetStore (PasswordResetStore) import Brig.Effects.UserPendingActivationStore (UserPendingActivationStore) import Brig.IO.Intra qualified as Intra import Brig.Options hiding (internalEvents, sesQueue) @@ -103,12 +101,14 @@ import Wire.API.User.Activation import Wire.API.User.Client import Wire.API.User.RichInfo import Wire.API.UserEvent +import Wire.AuthenticationSubsystem (AuthenticationSubsystem) import Wire.DeleteQueue import Wire.GalleyAPIAccess (GalleyAPIAccess, ShowOrHideInvitationUrl (..)) import Wire.NotificationSubsystem import Wire.Rpc import Wire.Sem.Concurrency import Wire.Sem.Paging.Cassandra (InternalPaging) +import Wire.UserKeyStore import Wire.UserStore import Wire.UserSubsystem import Wire.UserSubsystem qualified as UserSubsystem @@ -118,18 +118,18 @@ servantSitemap :: ( Member BlacklistPhonePrefixStore r, Member BlacklistStore r, Member DeleteQueue r, - Member CodeStore r, Member (Concurrency 'Unsafe) r, Member (ConnectionStore InternalPaging) r, Member (Embed HttpClientIO) r, Member FederationConfigStore r, + Member AuthenticationSubsystem r, Member GalleyAPIAccess r, Member (Input (Local ())) r, Member (Input UTCTime) r, Member NotificationSubsystem r, Member UserSubsystem r, Member UserStore r, - Member PasswordResetStore r, + Member UserKeyStore r, Member Rpc r, Member TinyLog r, Member (UserPendingActivationStore p) r @@ -168,15 +168,15 @@ mlsAPI = getMLSClients accountAPI :: ( Member BlacklistStore r, - Member CodeStore r, Member BlacklistPhonePrefixStore r, - Member PasswordResetStore r, Member GalleyAPIAccess r, + Member AuthenticationSubsystem r, Member DeleteQueue r, Member (UserPendingActivationStore p) r, Member (Embed HttpClientIO) r, Member NotificationSubsystem r, Member UserSubsystem r, + Member UserKeyStore r, Member UserStore r, Member TinyLog r, Member (Input (Local ())) r, @@ -229,6 +229,7 @@ teamsAPI :: Member BlacklistStore r, Member (Embed HttpClientIO) r, Member NotificationSubsystem r, + Member UserKeyStore r, Member (Concurrency 'Unsafe) r, Member TinyLog r, Member (Input (Local ())) r, @@ -261,6 +262,7 @@ authAPI :: Member NotificationSubsystem r, Member (Input (Local ())) r, Member (Input UTCTime) r, + Member UserKeyStore r, Member (ConnectionStore InternalPaging) r ) => ServerT BrigIRoutes.AuthAPI (Handler r) @@ -456,6 +458,7 @@ createUserNoVerify :: Member TinyLog r, Member (Embed HttpClientIO) r, Member NotificationSubsystem r, + Member UserKeyStore r, Member (Input (Local ())) r, Member (Input UTCTime) r, Member (ConnectionStore InternalPaging) r @@ -506,6 +509,7 @@ deleteUserNoAuthH :: Member NotificationSubsystem r, Member UserStore r, Member TinyLog r, + Member UserKeyStore r, Member (Input (Local ())) r, Member (Input UTCTime) r, Member (ConnectionStore InternalPaging) r @@ -519,14 +523,14 @@ deleteUserNoAuthH uid = do AccountAlreadyDeleted -> pure UserResponseAccountAlreadyDeleted AccountDeleted -> pure UserResponseAccountDeleted -changeSelfEmailMaybeSendH :: (Member BlacklistStore r) => UserId -> EmailUpdate -> Maybe Bool -> (Handler r) ChangeEmailResponse +changeSelfEmailMaybeSendH :: (Member BlacklistStore r, Member UserKeyStore r) => UserId -> EmailUpdate -> Maybe Bool -> (Handler r) ChangeEmailResponse changeSelfEmailMaybeSendH u body (fromMaybe False -> validate) = do let email = euEmail body changeSelfEmailMaybeSend u (if validate then ActuallySendEmail else DoNotSendEmail) email UpdateOriginScim data MaybeSendEmail = ActuallySendEmail | DoNotSendEmail -changeSelfEmailMaybeSend :: (Member BlacklistStore r) => UserId -> MaybeSendEmail -> Email -> UpdateOriginType -> (Handler r) ChangeEmailResponse +changeSelfEmailMaybeSend :: (Member BlacklistStore r, Member UserKeyStore r) => UserId -> MaybeSendEmail -> Email -> UpdateOriginType -> (Handler r) ChangeEmailResponse changeSelfEmailMaybeSend u ActuallySendEmail email allowScim = do API.changeSelfEmail u email allowScim changeSelfEmailMaybeSend u DoNotSendEmail email allowScim = do @@ -539,7 +543,10 @@ changeSelfEmailMaybeSend u DoNotSendEmail email allowScim = do -- handler allows up to 4 lists of various user keys, and returns the union of the lookups. -- Empty list is forbidden for backwards compatibility. listActivatedAccountsH :: - (Member DeleteQueue r, Member UserStore r) => + ( Member DeleteQueue r, + Member UserKeyStore r, + Member UserStore r + ) => Maybe (CommaSeparatedList UserId) -> Maybe (CommaSeparatedList Handle) -> Maybe (CommaSeparatedList Email) -> @@ -614,8 +621,7 @@ getActivationCode emailOrPhone = do maybe (throwStd activationKeyNotFound) (pure . GetActivationCodeResp) apair getPasswordResetCodeH :: - ( Member CodeStore r, - Member PasswordResetStore r + ( Member AuthenticationSubsystem r ) => Maybe Email -> Maybe Phone -> @@ -629,8 +635,7 @@ getPasswordResetCodeH bade badp = ) getPasswordResetCode :: - ( Member CodeStore r, - Member PasswordResetStore r + ( Member AuthenticationSubsystem r ) => Either Email Phone -> (Handler r) GetPasswordResetCodeResp @@ -653,9 +658,9 @@ changeAccountStatusH usr (suStatus -> status) = do API.changeSingleAccountStatus usr status !>> accountStatusError -- FUTUREWORK: use CanThrow and related machinery pure NoContent -getAccountStatusH :: UserId -> (Handler r) AccountStatusResp +getAccountStatusH :: (Member UserStore r) => UserId -> (Handler r) AccountStatusResp getAccountStatusH uid = do - status <- lift $ wrapClient $ API.lookupStatus uid + status <- lift $ liftSem $ lookupStatus uid maybe (throwStd (errorToWai @'E.UserNotFound)) (pure . AccountStatusResp) @@ -691,6 +696,7 @@ revokeIdentityH :: Member TinyLog r, Member (Input (Local ())) r, Member (Input UTCTime) r, + Member UserKeyStore r, Member (ConnectionStore InternalPaging) r, Member UserSubsystem r ) => diff --git a/services/brig/src/Brig/API/OAuth.hs b/services/brig/src/Brig/API/OAuth.hs index 915b9844e44..5ff461bf652 100644 --- a/services/brig/src/Brig/API/OAuth.hs +++ b/services/brig/src/Brig/API/OAuth.hs @@ -47,7 +47,7 @@ import Polysemy (Member) import Servant hiding (Handler, Tagged) import Wire.API.Error import Wire.API.OAuth as OAuth -import Wire.API.Password (Password, mkSafePassword) +import Wire.API.Password (Password, mkSafePasswordScrypt) import Wire.API.Routes.Internal.Brig.OAuth qualified as I import Wire.API.Routes.Named (Named (Named)) import Wire.API.Routes.Public.Brig.OAuth @@ -93,7 +93,7 @@ registerOAuthClient (OAuthClientConfig name uri) = do createSecret = OAuthClientPlainTextSecret <$> rand32Bytes hashClientSecret :: (MonadIO m) => OAuthClientPlainTextSecret -> m Password - hashClientSecret = mkSafePassword . plainTextPassword8Unsafe . toText . unOAuthClientPlainTextSecret + hashClientSecret = mkSafePasswordScrypt . plainTextPassword8Unsafe . toText . unOAuthClientPlainTextSecret rand32Bytes :: (MonadIO m) => m AsciiBase16 rand32Bytes = liftIO . fmap encodeBase16 $ randBytes 32 diff --git a/services/brig/src/Brig/API/Public.hs b/services/brig/src/Brig/API/Public.hs index f08d79cdabf..fe2ca44c642 100644 --- a/services/brig/src/Brig/API/Public.hs +++ b/services/brig/src/Brig/API/Public.hs @@ -43,14 +43,11 @@ import Brig.Code qualified as Code import Brig.Data.Connection qualified as Data import Brig.Data.Nonce as Nonce import Brig.Data.User qualified as Data -import Brig.Data.UserKey qualified as UserKey import Brig.Effects.BlacklistPhonePrefixStore (BlacklistPhonePrefixStore) import Brig.Effects.BlacklistStore (BlacklistStore) -import Brig.Effects.CodeStore (CodeStore) import Brig.Effects.ConnectionStore (ConnectionStore) import Brig.Effects.FederationConfigStore (FederationConfigStore) import Brig.Effects.JwtTools (JwtTools) -import Brig.Effects.PasswordResetStore (PasswordResetStore) import Brig.Effects.PublicKeyBundle (PublicKeyBundle) import Brig.Effects.SFT import Brig.Effects.UserPendingActivationStore (UserPendingActivationStore) @@ -157,14 +154,17 @@ import Wire.API.User.Password qualified as Public import Wire.API.User.RichInfo qualified as Public import Wire.API.UserMap qualified as Public import Wire.API.Wrapped qualified as Public +import Wire.AuthenticationSubsystem (AuthenticationSubsystem, createPasswordResetCode, resetPassword) import Wire.DeleteQueue import Wire.GalleyAPIAccess (GalleyAPIAccess) import Wire.GalleyAPIAccess qualified as GalleyAPIAccess import Wire.NotificationSubsystem +import Wire.PasswordStore (PasswordStore, lookupHashedPassword) import Wire.Sem.Concurrency import Wire.Sem.Jwk (Jwk) import Wire.Sem.Now (Now) import Wire.Sem.Paging.Cassandra (InternalPaging) +import Wire.UserKeyStore hiding (keyText) import Wire.UserStore (UserStore) import Wire.UserSubsystem hiding (checkHandle, checkHandles) import Wire.UserSubsystem qualified as UserSubsystem @@ -281,7 +281,6 @@ servantSitemap :: forall r p. ( Member BlacklistPhonePrefixStore r, Member BlacklistStore r, - Member CodeStore r, Member DeleteQueue r, Member (Concurrency 'Unsafe) r, Member (ConnectionStore InternalPaging) r, @@ -289,6 +288,7 @@ servantSitemap :: Member (Embed IO) r, Member FederationConfigStore r, Member (Input (Local ())) r, + Member AuthenticationSubsystem r, Member (Input UTCTime) r, Member Jwk r, Member GalleyAPIAccess r, @@ -296,8 +296,9 @@ servantSitemap :: Member NotificationSubsystem r, Member UserSubsystem r, Member UserStore r, + Member PasswordStore r, + Member UserKeyStore r, Member Now r, - Member PasswordResetStore r, Member PublicKeyBundle r, Member SFT r, Member TinyLog r, @@ -737,6 +738,7 @@ createUser :: Member TinyLog r, Member (Embed HttpClientIO) r, Member NotificationSubsystem r, + Member UserKeyStore r, Member (Input (Local ())) r, Member (Input UTCTime) r, Member (ConnectionStore InternalPaging) r @@ -945,6 +947,7 @@ updateUser uid conn uu = do changePhone :: ( Member BlacklistStore r, + Member UserKeyStore r, Member BlacklistPhonePrefixStore r ) => UserId -> @@ -960,7 +963,9 @@ changePhone u _ (Public.puPhone -> phone) = lift . exceptTToMaybe $ do removePhone :: ( Member (Embed HttpClientIO) r, Member NotificationSubsystem r, + Member UserKeyStore r, Member TinyLog r, + Member PasswordStore r, Member (Input (Local ())) r, Member (Input UTCTime) r, Member (ConnectionStore InternalPaging) r, @@ -978,6 +983,7 @@ removeEmail :: Member TinyLog r, Member (Input (Local ())) r, Member (Input UTCTime) r, + Member UserKeyStore r, Member (ConnectionStore InternalPaging) r, Member UserSubsystem r ) => @@ -987,10 +993,10 @@ removeEmail :: removeEmail self conn = lift . exceptTToMaybe $ API.removeEmail self conn -checkPasswordExists :: UserId -> (Handler r) Bool -checkPasswordExists = fmap isJust . lift . wrapClient . API.lookupPassword +checkPasswordExists :: (Member PasswordStore r) => UserId -> (Handler r) Bool +checkPasswordExists = fmap isJust . lift . liftSem . lookupHashedPassword -changePassword :: UserId -> Public.PasswordChange -> (Handler r) (Maybe Public.ChangePasswordError) +changePassword :: (Member PasswordStore r, Member UserStore r) => UserId -> Public.PasswordChange -> (Handler r) (Maybe Public.ChangePasswordError) changePassword u cp = lift . exceptTToMaybe $ API.changePassword u cp changeLocale :: @@ -1054,32 +1060,34 @@ changeHandle u conn (Public.HandleUpdate h) = lift $ liftSem do UserSubsystem.updateHandle u (Just conn) UpdateOriginWireClient h beginPasswordReset :: - (Member PasswordResetStore r, Member TinyLog r) => + (Member AuthenticationSubsystem r) => Public.NewPasswordReset -> Handler r () beginPasswordReset (Public.NewPasswordReset target) = do - checkAllowlist target - (u, pair) <- API.beginPasswordReset target !>> pwResetError + (u, pair) <- lift (liftSem $ createPasswordResetCode (fromEither target)) !>> pwResetError loc <- lift $ wrapClient $ API.lookupLocale u lift $ case target of Left email -> sendPasswordResetMail email pair loc Right phone -> wrapHttp $ sendPasswordResetSms phone pair loc completePasswordReset :: - ( Member CodeStore r, - Member PasswordResetStore r, - Member TinyLog r + ( Member AuthenticationSubsystem r ) => Public.CompletePasswordReset -> (Handler r) () completePasswordReset req = do - API.completePasswordReset (Public.cpwrIdent req) (Public.cpwrCode req) (Public.cpwrPassword req) !>> pwResetError + lift . liftSem $ + resetPassword + (Public.cpwrIdent req) + (Public.cpwrCode req) + (Public.cpwrPassword req) -- docs/reference/user/activation.md {#RefActivationRequest} -- docs/reference/user/registration.md {#RefRegistration} sendActivationCode :: ( Member BlacklistStore r, Member BlacklistPhonePrefixStore r, + Member UserKeyStore r, Member GalleyAPIAccess r ) => Public.SendActivationCode -> @@ -1109,6 +1117,7 @@ createConnectionUnqualified :: ( Member GalleyAPIAccess r, Member NotificationSubsystem r, Member TinyLog r, + Member UserStore r, Member (Embed HttpClientIO) r ) => UserId -> @@ -1124,6 +1133,7 @@ createConnection :: ( Member FederationConfigStore r, Member GalleyAPIAccess r, Member NotificationSubsystem r, + Member UserStore r, Member TinyLog r, Member (Embed HttpClientIO) r ) => @@ -1231,8 +1241,10 @@ deleteSelfUser :: ( Member GalleyAPIAccess r, Member TinyLog r, Member (Embed HttpClientIO) r, + Member UserKeyStore r, Member NotificationSubsystem r, Member UserStore r, + Member PasswordStore r, Member (Input (Local ())) r, Member (Input UTCTime) r, Member (ConnectionStore InternalPaging) r @@ -1249,6 +1261,7 @@ verifyDeleteUser :: Member UserStore r, Member TinyLog r, Member (Input (Local ())) r, + Member UserKeyStore r, Member (Input UTCTime) r, Member (ConnectionStore InternalPaging) r ) => @@ -1259,6 +1272,7 @@ verifyDeleteUser body = API.verifyDeleteUser body !>> deleteUserError updateUserEmail :: forall r. ( Member BlacklistStore r, + Member UserKeyStore r, Member GalleyAPIAccess r ) => UserId -> @@ -1330,7 +1344,7 @@ activateKey (Public.Activate tgt code dryrun) sendVerificationCode :: forall r. - (Member GalleyAPIAccess r) => + (Member GalleyAPIAccess r, Member UserKeyStore r) => Public.SendVerificationCode -> (Handler r) () sendVerificationCode req = do @@ -1355,7 +1369,7 @@ sendVerificationCode req = do where getAccount :: Public.Email -> (Handler r) (Maybe UserAccount) getAccount email = lift $ do - mbUserId <- wrapClient . UserKey.lookupKey $ UserKey.userEmailKey email + mbUserId <- liftSem $ lookupKey $ userEmailKey email join <$> wrapClient (Data.lookupAccount `traverse` mbUserId) sendMail :: Public.Email -> Code.Value -> Maybe Public.Locale -> Public.VerificationAction -> (Handler r) () @@ -1390,19 +1404,17 @@ deprecatedOnboarding :: UserId -> JsonValue -> (Handler r) DeprecatedMatchingRes deprecatedOnboarding _ _ = pure DeprecatedMatchingResult deprecatedCompletePasswordReset :: - ( Member CodeStore r, - Member PasswordResetStore r, - Member TinyLog r + ( Member AuthenticationSubsystem r ) => Public.PasswordResetKey -> Public.PasswordReset -> (Handler r) () deprecatedCompletePasswordReset k pwr = do - API.completePasswordReset - (Public.PasswordResetIdentityKey k) - (Public.pwrCode pwr) - (Public.pwrPassword pwr) - !>> pwResetError + lift . liftSem $ + resetPassword + (Public.PasswordResetIdentityKey k) + (Public.pwrCode pwr) + (Public.pwrPassword pwr) -- Utilities diff --git a/services/brig/src/Brig/API/Types.hs b/services/brig/src/Brig/API/Types.hs index 721ec2cde36..60bb89adccc 100644 --- a/services/brig/src/Brig/API/Types.hs +++ b/services/brig/src/Brig/API/Types.hs @@ -36,7 +36,6 @@ import Brig.Data.Activation (Activation (..), ActivationError (..)) import Brig.Data.Client (ClientDataError (..)) import Brig.Data.Properties (PropertiesDataError (..)) import Brig.Data.User (AuthError (..), ReAuthError (..)) -import Brig.Data.UserKey (UserKey, foldKey) import Brig.Types.Intra import Data.Code import Data.Id @@ -47,6 +46,7 @@ import Imports import Network.Wai.Utilities.Error qualified as Wai import Wire.API.Federation.Error import Wire.API.User +import Wire.UserKeyStore (UserKey, foldKey) ------------------------------------------------------------------------------- -- Successes diff --git a/services/brig/src/Brig/API/User.hs b/services/brig/src/Brig/API/User.hs index 85956b8d88d..086cebebeb6 100644 --- a/services/brig/src/Brig/API/User.hs +++ b/services/brig/src/Brig/API/User.hs @@ -35,7 +35,6 @@ module Brig.API.User changeSingleAccountStatus, Data.lookupAccounts, Data.lookupAccount, - Data.lookupStatus, lookupAccountsByIdentity, lookupProfilesV3, getLegalHoldStatus, @@ -62,14 +61,10 @@ module Brig.API.User preverify, activate, Brig.API.User.lookupActivationCode, - Data.isActivated, -- * Password Management changePassword, - beginPasswordReset, - completePasswordReset, lookupPasswordResetCode, - Data.lookupPassword, -- * Blacklisting isBlacklisted, @@ -100,17 +95,11 @@ import Brig.Data.Connection qualified as Data import Brig.Data.Properties qualified as Data import Brig.Data.User import Brig.Data.User qualified as Data -import Brig.Data.UserKey -import Brig.Data.UserKey qualified as Data import Brig.Effects.BlacklistPhonePrefixStore (BlacklistPhonePrefixStore) import Brig.Effects.BlacklistPhonePrefixStore qualified as BlacklistPhonePrefixStore import Brig.Effects.BlacklistStore (BlacklistStore) import Brig.Effects.BlacklistStore qualified as BlacklistStore -import Brig.Effects.CodeStore (CodeStore) -import Brig.Effects.CodeStore qualified as E import Brig.Effects.ConnectionStore (ConnectionStore) -import Brig.Effects.PasswordResetStore (PasswordResetStore) -import Brig.Effects.PasswordResetStore qualified as E import Brig.Effects.UserPendingActivationStore (UserPendingActivation (..), UserPendingActivationStore) import Brig.Effects.UserPendingActivationStore qualified as UserPendingActivationStore import Brig.IO.Intra qualified as Intra @@ -119,7 +108,7 @@ import Brig.Team.DB qualified as Team import Brig.Types.Activation (ActivationPair) import Brig.Types.Connection import Brig.Types.Intra -import Brig.User.Auth.Cookie (listCookies, revokeAllCookies) +import Brig.User.Auth.Cookie qualified as Auth import Brig.User.Email import Brig.User.Phone import Brig.User.Search.Index (reindex) @@ -167,14 +156,16 @@ import Wire.API.Team.Size import Wire.API.User import Wire.API.User.Activation import Wire.API.User.Client -import Wire.API.User.Password import Wire.API.User.RichInfo import Wire.API.UserEvent +import Wire.AuthenticationSubsystem (AuthenticationSubsystem, internalLookupPasswordResetCode) import Wire.DeleteQueue import Wire.GalleyAPIAccess as GalleyAPIAccess import Wire.NotificationSubsystem +import Wire.PasswordStore (PasswordStore, lookupHashedPassword, upsertHashedPassword) import Wire.Sem.Concurrency import Wire.Sem.Paging.Cassandra (InternalPaging) +import Wire.UserKeyStore import Wire.UserStore import Wire.UserSubsystem as User import Wire.UserSubsystem.HandleBlacklist @@ -199,15 +190,18 @@ identityErrorToBrigError = \case IdentityErrorBlacklistedPhone -> Error.StdError $ errorToWai @'E.BlacklistedPhone IdentityErrorUserKeyExists -> Error.StdError $ errorToWai @'E.UserKeyExists -verifyUniquenessAndCheckBlacklist :: (Member BlacklistStore r) => UserKey -> ExceptT IdentityError (AppT r) () +verifyUniquenessAndCheckBlacklist :: + (Member BlacklistStore r, Member UserKeyStore r) => + UserKey -> + ExceptT IdentityError (AppT r) () verifyUniquenessAndCheckBlacklist uk = do - wrapClientE $ checkKey Nothing uk + checkKey Nothing uk blacklisted <- lift $ liftSem $ BlacklistStore.exists uk when blacklisted $ throwE (foldKey (const IdentityErrorBlacklistedEmail) (const IdentityErrorBlacklistedPhone) uk) where checkKey u k = do - av <- lift $ Data.keyAvailable k u + av <- lift $ liftSem $ keyAvailable k u unless av $ throwE IdentityErrorUserKeyExists @@ -286,6 +280,7 @@ createUser :: ( Member BlacklistStore r, Member GalleyAPIAccess r, Member (UserPendingActivationStore p) r, + Member UserKeyStore r, Member TinyLog r, Member (Embed HttpClientIO) r, Member NotificationSubsystem r, @@ -452,7 +447,7 @@ createUser new = do ExceptT RegisterError (AppT r) () acceptTeamInvitation account inv ii uk ident = do let uid = userId (accountUser account) - ok <- lift . wrapClient $ Data.claimKey uk uid + ok <- lift $ liftSem $ claimKey uk uid unless ok $ throwE RegisterErrorUserKeyExists let minvmeta :: (Maybe (UserId, UTCTimeMillis), Role) @@ -535,6 +530,7 @@ initAccountFeatureConfig uid = do -- users are invited to the team via scim. createUserInviteViaScim :: ( Member BlacklistStore r, + Member UserKeyStore r, Member (UserPendingActivationStore p) r, Member TinyLog r ) => @@ -598,7 +594,7 @@ changeManagedBy uid conn (ManagedByUpdate mb) = do -- | Call 'changeEmail' and process result: if email changes to itself, succeed, if not, send -- validation email. -changeSelfEmail :: (Member BlacklistStore r) => UserId -> Email -> UpdateOriginType -> ExceptT Error.Error (AppT r) ChangeEmailResponse +changeSelfEmail :: (Member BlacklistStore r, Member UserKeyStore r) => UserId -> Email -> UpdateOriginType -> ExceptT Error.Error (AppT r) ChangeEmailResponse changeSelfEmail u email allowScim = do changeEmail u email allowScim !>> Error.changeEmailError >>= \case ChangeEmailIdempotent -> @@ -618,7 +614,7 @@ changeSelfEmail u email allowScim = do (userIdentity usr) -- | Prepare changing the email (checking a number of invariants). -changeEmail :: (Member BlacklistStore r) => UserId -> Email -> UpdateOriginType -> ExceptT ChangeEmailError (AppT r) ChangeEmailResult +changeEmail :: (Member BlacklistStore r, Member UserKeyStore r) => UserId -> Email -> UpdateOriginType -> ExceptT ChangeEmailError (AppT r) ChangeEmailResult changeEmail u email updateOrigin = do em <- either @@ -629,7 +625,7 @@ changeEmail u email updateOrigin = do blacklisted <- lift . liftSem $ BlacklistStore.exists ek when blacklisted $ throwE (ChangeBlacklistedEmail email) - available <- lift . wrapClient $ Data.keyAvailable ek (Just u) + available <- lift $ liftSem $ keyAvailable ek (Just u) unless available $ throwE $ EmailExists email @@ -649,6 +645,7 @@ changeEmail u email updateOrigin = do changePhone :: ( Member BlacklistStore r, + Member UserKeyStore r, Member BlacklistPhonePrefixStore r ) => UserId -> @@ -661,7 +658,7 @@ changePhone u phone = do pure =<< lift (wrapClient $ validatePhone phone) let pk = userPhoneKey canonical - available <- lift . wrapClient $ Data.keyAvailable pk (Just u) + available <- lift $ liftSem $ keyAvailable pk (Just u) unless available $ throwE PhoneExists timeout <- setActivationTimeout <$> view settings @@ -681,6 +678,7 @@ changePhone u phone = do removeEmail :: ( Member (Embed HttpClientIO) r, Member NotificationSubsystem r, + Member UserKeyStore r, Member TinyLog r, Member (Input (Local ())) r, Member (Input UTCTime) r, @@ -694,7 +692,7 @@ removeEmail uid conn = do ident <- lift $ fetchUserIdentity uid case ident of Just (FullIdentity e _) -> lift $ do - wrapClient . deleteKey $ userEmailKey e + liftSem $ deleteKey $ userEmailKey e wrapClient $ Data.deleteEmail uid liftSem $ Intra.onUserEvent uid (Just conn) (emailRemoved uid e) Just _ -> throwE LastIdentity @@ -706,6 +704,8 @@ removeEmail uid conn = do removePhone :: ( Member (Embed HttpClientIO) r, Member NotificationSubsystem r, + Member UserKeyStore r, + Member PasswordStore r, Member TinyLog r, Member (Input (Local ())) r, Member (Input UTCTime) r, @@ -719,11 +719,11 @@ removePhone uid conn = do ident <- lift $ fetchUserIdentity uid case ident of Just (FullIdentity _ p) -> do - pw <- lift . wrapClient $ Data.lookupPassword uid + pw <- lift $ liftSem $ lookupHashedPassword uid unless (isJust pw) $ throwE NoPassword lift $ do - wrapClient . deleteKey $ userPhoneKey p + liftSem $ deleteKey $ userPhoneKey p wrapClient $ Data.deletePhone uid liftSem $ Intra.onUserEvent uid (Just conn) (phoneRemoved uid p) Just _ -> throwE LastIdentity @@ -737,6 +737,7 @@ revokeIdentity :: ( Member (Embed HttpClientIO) r, Member NotificationSubsystem r, Member TinyLog r, + Member UserKeyStore r, Member (Input (Local ())) r, Member (Input UTCTime) r, Member (ConnectionStore InternalPaging) r, @@ -746,7 +747,7 @@ revokeIdentity :: AppT r () revokeIdentity key = do let uk = either userEmailKey userPhoneKey key - mu <- wrapClient $ Data.lookupKey uk + mu <- liftSem $ lookupKey uk case mu of Nothing -> pure () Just u -> @@ -762,7 +763,7 @@ revokeIdentity key = do where revokeKey :: UserId -> UserKey -> AppT r () revokeKey u uk = do - wrapClient $ deleteKey uk + liftSem $ deleteKey uk wrapClient $ foldKey (\(_ :: Email) -> Data.deleteEmail u) @@ -826,7 +827,7 @@ mkUserEvent usrs status = case status of Active -> pure UserResumed Suspended -> do - lift $ wrapHttpClient (mapConcurrently_ revokeAllCookies usrs) + lift $ wrapHttpClient (mapConcurrently_ Auth.revokeAllCookies usrs) pure UserSuspended Deleted -> throwE InvalidAccountStatus Ephemeral -> throwE InvalidAccountStatus @@ -927,6 +928,7 @@ onActivated (PhoneActivated uid phone) = do sendActivationCode :: ( Member BlacklistStore r, Member BlacklistPhonePrefixStore r, + Member UserKeyStore r, Member GalleyAPIAccess r ) => Either Email Phone -> @@ -940,7 +942,7 @@ sendActivationCode emailOrPhone loc call = case emailOrPhone of (const . throwE . InvalidRecipient $ userEmailKey email) (pure . userEmailKey) (validateEmail email) - exists <- lift $ isJust <$> wrapClient (Data.lookupKey ek) + exists <- lift $ liftSem $ isJust <$> lookupKey ek when exists $ throwE $ UserKeyInUse ek @@ -960,7 +962,7 @@ sendActivationCode emailOrPhone loc call = case emailOrPhone of pure =<< lift (wrapClient $ validatePhone phone) let pk = userPhoneKey canonical - exists <- lift $ isJust <$> wrapClient (Data.lookupKey pk) + exists <- lift $ liftSem $ isJust <$> lookupKey pk when exists $ throwE $ UserKeyInUse pk @@ -1033,15 +1035,16 @@ mkActivationKey (ActivatePhone p) = do ------------------------------------------------------------------------------- -- Password Management -changePassword :: UserId -> PasswordChange -> ExceptT ChangePasswordError (AppT r) () +changePassword :: (Member PasswordStore r, Member UserStore r) => UserId -> PasswordChange -> ExceptT ChangePasswordError (AppT r) () changePassword uid cp = do - activated <- lift . wrapClient $ Data.isActivated uid + activated <- lift $ liftSem $ isActivated uid unless activated $ throwE ChangePasswordNoIdentity - currpw <- lift . wrapClient $ Data.lookupPassword uid + currpw <- lift $ liftSem $ lookupHashedPassword uid let newpw = cpNewPassword cp + hashedNewPw <- mkSafePasswordScrypt newpw case (currpw, cpOldPassword cp) of - (Nothing, _) -> lift . wrapClient $ Data.updatePassword uid newpw + (Nothing, _) -> lift . liftSem $ upsertHashedPassword uid hashedNewPw (Just _, Nothing) -> throwE InvalidCurrentPassword (Just pw, Just pw') -> do -- We are updating the pwd here anyway, so we don't care about the pwd status @@ -1049,72 +1052,7 @@ changePassword uid cp = do throwE InvalidCurrentPassword when (verifyPassword newpw pw) $ throwE ChangePasswordMustDiffer - lift $ wrapClient (Data.updatePassword uid newpw) >> wrapClient (revokeAllCookies uid) - -beginPasswordReset :: - ( Member TinyLog r, - Member PasswordResetStore r - ) => - Either Email Phone -> - ExceptT PasswordResetError (AppT r) (UserId, PasswordResetPair) -beginPasswordReset target = do - let key = either userEmailKey userPhoneKey target - user <- lift (wrapClient $ Data.lookupKey key) >>= maybe (throwE InvalidPasswordResetKey) pure - lift . liftSem . Log.debug $ field "user" (toByteString user) . field "action" (val "User.beginPasswordReset") - status <- lift . wrapClient $ Data.lookupStatus user - unless (status == Just Active) $ - throwE InvalidPasswordResetKey - code <- lift . liftSem $ E.lookupPasswordResetCode user - when (isJust code) $ - throwE (PasswordResetInProgress Nothing) - (user,) <$> lift (liftSem $ E.createPasswordResetCode user target) - -completePasswordReset :: - ( Member CodeStore r, - Member PasswordResetStore r, - Member TinyLog r - ) => - PasswordResetIdentity -> - PasswordResetCode -> - PlainTextPassword8 -> - ExceptT PasswordResetError (AppT r) () -completePasswordReset ident code pw = do - key <- mkPasswordResetKey ident - muid :: Maybe UserId <- lift . liftSem $ E.verifyPasswordResetCode (key, code) - case muid of - Nothing -> throwE InvalidPasswordResetCode - Just uid -> do - lift . liftSem . Log.debug $ field "user" (toByteString uid) . field "action" (val "User.completePasswordReset") - checkNewIsDifferent uid pw - lift $ do - wrapClient $ Data.updatePassword uid pw - liftSem $ E.codeDelete key - wrapClient $ revokeAllCookies uid - --- | Pull the current password of a user and compare it against the one about to be installed. --- If the two are the same, throw an error. If no current password can be found, do nothing. -checkNewIsDifferent :: UserId -> PlainTextPassword' t -> ExceptT PasswordResetError (AppT r) () -checkNewIsDifferent uid pw = do - mcurrpw <- lift . wrapClient $ Data.lookupPassword uid - case mcurrpw of - Just currpw - | (verifyPassword pw currpw) -> throwE ResetPasswordMustDiffer - _ -> pure () - -mkPasswordResetKey :: - (Member CodeStore r) => - PasswordResetIdentity -> - ExceptT PasswordResetError (AppT r) PasswordResetKey -mkPasswordResetKey ident = case ident of - PasswordResetIdentityKey k -> pure k - PasswordResetEmailIdentity e -> - wrapClientE (user (userEmailKey e)) - >>= lift . liftSem . E.mkPasswordResetKey - PasswordResetPhoneIdentity p -> - wrapClientE (user (userPhoneKey p)) - >>= lift . liftSem . E.mkPasswordResetKey - where - user uk = lift (Data.lookupKey uk) >>= maybe (throwE InvalidPasswordResetKey) pure + lift $ liftSem (upsertHashedPassword uid hashedNewPw) >> wrapClient (Auth.revokeAllCookies uid) ------------------------------------------------------------------------------- -- User Deletion @@ -1135,8 +1073,10 @@ deleteSelfUser :: ( Member GalleyAPIAccess r, Member TinyLog r, Member (Embed HttpClientIO) r, + Member UserKeyStore r, Member NotificationSubsystem r, Member (Input (Local ())) r, + Member PasswordStore r, Member UserStore r, Member (Input UTCTime) r, Member (ConnectionStore InternalPaging) r @@ -1179,7 +1119,7 @@ deleteSelfUser uid pwd = do lift . liftSem . Log.info $ field "user" (toByteString uid) . msg (val "Attempting account deletion with a password") - actual <- lift . wrapClient $ Data.lookupPassword uid + actual <- lift $ liftSem $ lookupHashedPassword uid case actual of Nothing -> throwE DeleteUserInvalidPassword Just p -> do @@ -1223,6 +1163,7 @@ deleteSelfUser uid pwd = do verifyDeleteUser :: ( Member (Embed HttpClientIO) r, Member NotificationSubsystem r, + Member UserKeyStore r, Member TinyLog r, Member (Input (Local ())) r, Member UserStore r, @@ -1249,6 +1190,7 @@ ensureAccountDeleted :: ( Member (Embed HttpClientIO) r, Member NotificationSubsystem r, Member TinyLog r, + Member UserKeyStore r, Member (Input (Local ())) r, Member (Input UTCTime) r, Member (ConnectionStore InternalPaging) r, @@ -1268,7 +1210,7 @@ ensureAccountDeleted uid = do localUid <- qualifyLocal uid conCount <- wrapClient $ countConnections localUid [(minBound @Relation) .. maxBound] - cookies <- wrapClient $ listCookies uid [] + cookies <- wrapClient $ Auth.listCookies uid [] if notNull probs || not accIsDeleted @@ -1296,6 +1238,7 @@ ensureAccountDeleted uid = do deleteAccount :: ( Member (Embed HttpClientIO) r, Member NotificationSubsystem r, + Member UserKeyStore r, Member TinyLog r, Member (Input (Local ())) r, Member UserStore r, @@ -1309,8 +1252,8 @@ deleteAccount (accountUser -> user) = do Log.info $ field "user" (toByteString uid) . msg (val "Deleting account") do -- Free unique keys - for_ (userEmail user) $ embed . deleteKeyForUser uid . userEmailKey - for_ (userPhone user) $ embed . deleteKeyForUser uid . userPhoneKey + for_ (userEmail user) $ deleteKeyForUser uid . userEmailKey + for_ (userPhone user) $ deleteKeyForUser uid . userPhoneKey embed $ Data.clearProperties uid @@ -1324,7 +1267,7 @@ deleteAccount (accountUser -> user) = do -- Note: Connections can only be deleted afterwards, since -- they need to be notified. Data.deleteConnections uid - revokeAllCookies uid + Auth.revokeAllCookies uid ------------------------------------------------------------------------------- -- Lookups @@ -1340,20 +1283,13 @@ lookupActivationCode emailOrPhone = do pure $ (k,) <$> c lookupPasswordResetCode :: - ( Member CodeStore r, - Member PasswordResetStore r + ( Member AuthenticationSubsystem r ) => Either Email Phone -> (AppT r) (Maybe PasswordResetPair) lookupPasswordResetCode emailOrPhone = do let uk = either userEmailKey userPhoneKey emailOrPhone - usr <- wrapClient $ Data.lookupKey uk - liftSem $ case usr of - Nothing -> pure Nothing - Just u -> do - k <- E.mkPasswordResetKey u - c <- E.lookupPasswordResetCode u - pure $ (k,) <$> c + liftSem $ internalLookupPasswordResetCode uk deleteUserNoVerify :: (Member DeleteQueue r) => @@ -1420,10 +1356,10 @@ getLegalHoldStatus' user = -- | Find user accounts for a given identity, both activated and those -- currently pending activation. -lookupAccountsByIdentity :: Either Email Phone -> Bool -> AppT r [UserAccount] +lookupAccountsByIdentity :: (Member UserKeyStore r) => Either Email Phone -> Bool -> AppT r [UserAccount] lookupAccountsByIdentity emailOrPhone includePendingInvitations = do let uk = either userEmailKey userPhoneKey emailOrPhone - activeUid <- wrapClient $ Data.lookupKey uk + activeUid <- liftSem $ lookupKey uk uidFromKey <- (>>= fst) <$> wrapClient (Data.lookupActivationCode uk) result <- wrapClient $ Data.lookupAccounts (nub $ catMaybes [activeUid, uidFromKey]) if includePendingInvitations diff --git a/services/brig/src/Brig/AWS/SesNotification.hs b/services/brig/src/Brig/AWS/SesNotification.hs index 63b1f5c07ca..d107b1551a5 100644 --- a/services/brig/src/Brig/AWS/SesNotification.hs +++ b/services/brig/src/Brig/AWS/SesNotification.hs @@ -22,7 +22,6 @@ where import Brig.AWS.Types import Brig.App -import Brig.Data.UserKey (userEmailKey) import Brig.Effects.BlacklistStore (BlacklistStore) import Brig.Effects.BlacklistStore qualified as BlacklistStore import Imports @@ -30,6 +29,7 @@ import Polysemy (Member) import System.Logger.Class (field, msg, (~~)) import System.Logger.Class qualified as Log import Wire.API.User.Identity +import Wire.UserKeyStore (userEmailKey) onEvent :: (Member BlacklistStore r) => SESNotification -> AppT r () onEvent (MailBounce BouncePermanent es) = onPermanentBounce es diff --git a/services/brig/src/Brig/App.hs b/services/brig/src/Brig/App.hs index aa504c79d0a..eee95801d55 100644 --- a/services/brig/src/Brig/App.hs +++ b/services/brig/src/Brig/App.hs @@ -87,6 +87,8 @@ module Brig.App lowerAppT, temporaryGetEnv, initHttpManagerWithTLSConfig, + adhocUserKeyStoreInterpreter, + adhocSessionStoreInterpreter, ) where @@ -110,7 +112,7 @@ import Brig.User.Search.Index (IndexEnv (..), MonadIndexIO (..), runIndexIO) import Brig.User.Template import Brig.ZAuth (MonadZAuth (..), runZAuth) import Brig.ZAuth qualified as ZAuth -import Cassandra (runClient) +import Cassandra (MonadClient, runClient) import Cassandra qualified as Cas import Cassandra.Util (initCassandraForService) import Control.AutoUpdate @@ -154,6 +156,12 @@ import Wire.API.Federation.Error (federationNotImplemented) import Wire.API.Routes.Version import Wire.API.User.Identity (Email) import Wire.API.User.Profile (Locale) +import Wire.SessionStore +import Wire.SessionStore.Cassandra +import Wire.UserKeyStore +import Wire.UserKeyStore.Cassandra +import Wire.UserStore +import Wire.UserStore.Cassandra schemaVersion :: Int32 schemaVersion = Migrations.lastSchemaVersion @@ -625,6 +633,21 @@ instance (MonadIndexIO (AppT r)) => MonadIndexIO (ExceptT err (AppT r)) where instance HasRequestId (AppT r) where getRequestId = view requestId +------------------------------------------------------------------------------- +-- Ad hoc interpreters + +-- | similarly to `wrapClient`, this function serves as a crutch while Brig is being polysemised. +adhocUserKeyStoreInterpreter :: (MonadClient m, MonadReader Env m) => Sem '[UserKeyStore, UserStore, Embed IO] a -> m a +adhocUserKeyStoreInterpreter action = do + clientState <- asks (view casClient) + liftIO $ runM . interpretUserStoreCassandra clientState . interpretUserKeyStoreCassandra clientState $ action + +-- | similarly to `wrapClient`, this function serves as a crutch while Brig is being polysemised. +adhocSessionStoreInterpreter :: (MonadClient m, MonadReader Env m) => Sem '[SessionStore, Embed IO] a -> m a +adhocSessionStoreInterpreter action = do + clientState <- asks (view casClient) + liftIO $ runM . interpretSessionStoreCassandra clientState $ action + -------------------------------------------------------------------------------- -- Federation diff --git a/services/brig/src/Brig/CanonicalInterpreter.hs b/services/brig/src/Brig/CanonicalInterpreter.hs index a7dbd00267f..e49bdd02edc 100644 --- a/services/brig/src/Brig/CanonicalInterpreter.hs +++ b/services/brig/src/Brig/CanonicalInterpreter.hs @@ -6,15 +6,11 @@ import Brig.Effects.BlacklistPhonePrefixStore (BlacklistPhonePrefixStore) import Brig.Effects.BlacklistPhonePrefixStore.Cassandra (interpretBlacklistPhonePrefixStoreToCassandra) import Brig.Effects.BlacklistStore (BlacklistStore) import Brig.Effects.BlacklistStore.Cassandra (interpretBlacklistStoreToCassandra) -import Brig.Effects.CodeStore (CodeStore) -import Brig.Effects.CodeStore.Cassandra (codeStoreToCassandra, interpretClientToIO) import Brig.Effects.ConnectionStore (ConnectionStore) import Brig.Effects.ConnectionStore.Cassandra (connectionStoreToCassandra) import Brig.Effects.FederationConfigStore (FederationConfigStore) import Brig.Effects.FederationConfigStore.Cassandra (interpretFederationDomainConfig, remotesMapFromCfgFile) import Brig.Effects.JwtTools -import Brig.Effects.PasswordResetStore (PasswordResetStore) -import Brig.Effects.PasswordResetStore.CodeStore (passwordResetStoreToCodeStore) import Brig.Effects.PublicKeyBundle import Brig.Effects.SFT (SFT, interpretSFT) import Brig.Effects.UserPendingActivationStore (UserPendingActivationStore) @@ -37,45 +33,65 @@ import Polysemy.Embed (runEmbedded) import Polysemy.Error (Error, errorToIOFinal, mapError, runError) import Polysemy.Input (Input, runInputConst, runInputSem) import Polysemy.TinyLog (TinyLog) +import Wire.API.Allowlists (AllowlistEmailDomains, AllowlistPhonePrefixes) import Wire.API.Federation.Client qualified import Wire.API.Federation.Error +import Wire.AuthenticationSubsystem +import Wire.AuthenticationSubsystem.Interpreter import Wire.DeleteQueue import Wire.FederationAPIAccess qualified import Wire.FederationAPIAccess.Interpreter (FederationAPIAccessConfig (..), interpretFederationAPIAccess) import Wire.GalleyAPIAccess (GalleyAPIAccess) import Wire.GalleyAPIAccess.Rpc import Wire.GundeckAPIAccess +import Wire.HashPassword import Wire.NotificationSubsystem import Wire.NotificationSubsystem.Interpreter (defaultNotificationSubsystemConfig, runNotificationSubsystemGundeck) import Wire.ParseException +import Wire.PasswordResetCodeStore (PasswordResetCodeStore) +import Wire.PasswordResetCodeStore.Cassandra (interpretClientToIO, passwordResetCodeStoreToCassandra) +import Wire.PasswordStore (PasswordStore) +import Wire.PasswordStore.Cassandra (interpretPasswordStore) import Wire.Rpc import Wire.Sem.Concurrency import Wire.Sem.Concurrency.IO import Wire.Sem.Delay import Wire.Sem.Jwk -import Wire.Sem.Logger.TinyLog (loggerToTinyLog) +import Wire.Sem.Logger.TinyLog (loggerToTinyLogReqId) import Wire.Sem.Now (Now) import Wire.Sem.Now.IO (nowToIOAction) import Wire.Sem.Paging.Cassandra (InternalPaging) +import Wire.SessionStore +import Wire.SessionStore.Cassandra (interpretSessionStoreCassandra) import Wire.UserEvents +import Wire.UserKeyStore +import Wire.UserKeyStore.Cassandra import Wire.UserStore import Wire.UserStore.Cassandra import Wire.UserSubsystem import Wire.UserSubsystem.Interpreter type BrigCanonicalEffects = - '[ UserSubsystem, + '[ AuthenticationSubsystem, + UserSubsystem, DeleteQueue, UserEvents, Error UserSubsystemError, + Error AuthenticationSubsystemError, Error Wire.API.Federation.Error.FederationError, Error Wai.Error, Wire.FederationAPIAccess.FederationAPIAccess Wire.API.Federation.Client.FederatorClient, + HashPassword, + UserKeyStore, UserStore, + SessionStore, + PasswordStore, SFT, ConnectionStore InternalPaging, Input UTCTime, Input (Local ()), + Input (Maybe AllowlistEmailDomains), + Input (Maybe AllowlistPhonePrefixes), NotificationSubsystem, GundeckAPIAccess, FederationConfigStore, @@ -84,11 +100,10 @@ type BrigCanonicalEffects = JwtTools, BlacklistPhonePrefixStore, BlacklistStore, - PasswordResetStore, UserPendingActivationStore InternalPaging, Now, Delay, - CodeStore, + PasswordResetCodeStore, GalleyAPIAccess, Rpc, Embed Cas.Client, @@ -125,18 +140,17 @@ runBrigToIO e (AppT ma) = do . interpretRace . embedToFinal . runEmbedded (runHttpClientIO e) - . loggerToTinyLog (e ^. applog) + . loggerToTinyLogReqId (e ^. App.requestId) (e ^. applog) . runError @SomeException . mapError @ErrorCall SomeException . mapError @ParseException SomeException . interpretClientToIO (e ^. casClient) . runRpcWithHttp (e ^. httpManager) (e ^. App.requestId) . interpretGalleyAPIAccessToRpc (e ^. disabledVersions) (e ^. galleyEndpoint) - . codeStoreToCassandra @Cas.Client + . passwordResetCodeStoreToCassandra @Cas.Client . runDelay . nowToIOAction (e ^. currentTime) . userPendingActivationStoreToCassandra - . passwordResetStoreToCodeStore . interpretBlacklistStoreToCassandra @Cas.Client . interpretBlacklistPhonePrefixStoreToCassandra @Cas.Client . interpretJwtTools @@ -145,18 +159,26 @@ runBrigToIO e (AppT ma) = do . interpretFederationDomainConfig (e ^. settings . federationStrategy) (foldMap (remotesMapFromCfgFile . fmap (.federationDomainConfig)) (e ^. settings . federationDomainConfigs)) . runGundeckAPIAccess (e ^. gundeckEndpoint) . runNotificationSubsystemGundeck (defaultNotificationSubsystemConfig (e ^. App.requestId)) + . runInputConst (e ^. settings . Opt.allowlistPhonePrefixes) + . runInputConst (e ^. settings . Opt.allowlistEmailDomains) . runInputConst (toLocalUnsafe (e ^. settings . Opt.federationDomain) ()) . runInputSem (embed getCurrentTime) . connectionStoreToCassandra . interpretSFT (e ^. httpManager) + . interpretPasswordStore (e ^. casClient) + . interpretSessionStoreCassandra (e ^. casClient) . interpretUserStoreCassandra (e ^. casClient) + . interpretUserKeyStoreCassandra (e ^. casClient) + . runHashPassword . interpretFederationAPIAccess federationApiAccessConfig . rethrowWaiErrorIO . mapError federationErrorToWai + . mapError authenticationSubsystemErrorToWai . mapError userSubsystemErrorToWai . runUserEvents . runDeleteQueue (e ^. internalEvents) . runUserSubsystem userSubsystemConfig + . interpretAuthenticationSubsystem ) ) $ runReaderT ma e diff --git a/services/brig/src/Brig/Data/Activation.hs b/services/brig/src/Brig/Data/Activation.hs index 66ab54f85b3..7efe8c1080a 100644 --- a/services/brig/src/Brig/Data/Activation.hs +++ b/services/brig/src/Brig/Data/Activation.hs @@ -29,11 +29,8 @@ module Brig.Data.Activation ) where -import Brig.App (Env) +import Brig.App (Env, adhocUserKeyStoreInterpreter) import Brig.Data.User -import Brig.Data.UserKey -import Brig.Effects.CodeStore qualified as E -import Brig.Effects.CodeStore.Cassandra import Brig.Options import Brig.Types.Intra import Cassandra @@ -50,6 +47,10 @@ import Polysemy import Text.Printf (printf) import Wire.API.User import Wire.API.User.Activation +import Wire.API.User.Password +import Wire.PasswordResetCodeStore qualified as E +import Wire.PasswordResetCodeStore.Cassandra +import Wire.UserKeyStore -- | The information associated with the pending activation of a 'UserKey'. data Activation = Activation @@ -124,17 +125,17 @@ activateKey k c u = verifyCode k c >>= pickUser >>= activate pure . Just $ foldKey (EmailActivated uid) (PhoneActivated uid) key -- if the key is the same, we only want to update our profile | otherwise = do - lift (runM (codeStoreToCassandra @m @'[Embed m] (E.mkPasswordResetKey uid >>= E.codeDelete))) + lift (runM (passwordResetCodeStoreToCassandra @m @'[Embed m] (E.codeDelete (mkPasswordResetKey uid)))) claim key uid lift $ foldKey (updateEmailAndDeleteEmailUnvalidated uid) (updatePhone uid) key - for_ oldKey $ lift . deleteKey + for_ oldKey $ lift . adhocUserKeyStoreInterpreter . deleteKey pure . Just $ foldKey (EmailActivated uid) (PhoneActivated uid) key where updateEmailAndDeleteEmailUnvalidated :: UserId -> Email -> m () updateEmailAndDeleteEmailUnvalidated u' email = updateEmail u' email <* deleteEmailUnvalidated u' claim key uid = do - ok <- lift $ claimKey key uid + ok <- lift $ adhocUserKeyStoreInterpreter (claimKey key uid) unless ok $ throwE . UserKeyExists . LT.fromStrict $ foldKey fromEmail fromPhone key diff --git a/services/brig/src/Brig/Data/Client.hs b/services/brig/src/Brig/Data/Client.hs index 4c03acc49b4..946d58577b3 100644 --- a/services/brig/src/Brig/Data/Client.hs +++ b/services/brig/src/Brig/Data/Client.hs @@ -59,7 +59,6 @@ import Brig.App import Brig.Data.User (AuthError (..), ReAuthError (..)) import Brig.Data.User qualified as User import Brig.Types.Instances () -import Brig.User.Auth.DB.Instances () import Cassandra as C hiding (Client) import Cassandra.Settings as C hiding (Client) import Control.Error diff --git a/services/brig/src/Brig/Data/LoginCode.hs b/services/brig/src/Brig/Data/LoginCode.hs index 2bb0a86febf..3103e939747 100644 --- a/services/brig/src/Brig/Data/LoginCode.hs +++ b/services/brig/src/Brig/Data/LoginCode.hs @@ -27,7 +27,6 @@ module Brig.Data.LoginCode where import Brig.App (Env, currentTime) -import Brig.User.Auth.DB.Instances () import Cassandra import Control.Lens (view) import Data.Code diff --git a/services/brig/src/Brig/Data/User.hs b/services/brig/src/Brig/Data/User.hs index 15b83ca054f..fa25cbebb51 100644 --- a/services/brig/src/Brig/Data/User.hs +++ b/services/brig/src/Brig/Data/User.hs @@ -29,7 +29,6 @@ module Brig.Data.User authenticate, reauthenticate, filterActive, - isActivated, isSamlUser, -- * Lookups @@ -39,8 +38,6 @@ module Brig.Data.User lookupUsers, lookupName, lookupLocale, - lookupPassword, - lookupStatus, lookupRichInfo, lookupRichInfoMultiUsers, lookupUserTeam, @@ -57,7 +54,6 @@ module Brig.Data.User updateManagedBy, activateUser, deactivateUser, - updatePassword, updateStatus, updateRichInfo, updateFeatureConferenceCalling, @@ -70,7 +66,7 @@ module Brig.Data.User ) where -import Brig.App (Env, currentTime, settings, viewFederationDomain, zauthEnv) +import Brig.App import Brig.Options import Brig.Types.Intra import Brig.ZAuth qualified as ZAuth @@ -88,11 +84,13 @@ import Data.Range (fromRange) import Data.Time (addUTCTime) import Data.UUID.V4 import Imports +import Polysemy import Wire.API.Password import Wire.API.Provider.Service import Wire.API.Team.Feature qualified as ApiFt import Wire.API.User import Wire.API.User.RichInfo +import Wire.PasswordStore -- | Authentication errors. data AuthError @@ -128,7 +126,7 @@ newAccount u inv tid mbHandle = do (Just (toUUID -> uuid), _) -> pure uuid (_, Just uuid) -> pure uuid (Nothing, Nothing) -> liftIO nextRandom - passwd <- maybe (pure Nothing) (fmap Just . liftIO . mkSafePassword) pass + passwd <- maybe (pure Nothing) (fmap Just . liftIO . mkSafePasswordScrypt) pass expiry <- case status of Ephemeral -> do -- Ephemeral users' expiry time is in expires_in (default sessionTokenTimeout) seconds @@ -180,9 +178,9 @@ newAccountInviteViaScim uid tid locale name email = do defSupportedProtocols -- | Mandatory password authentication. -authenticate :: (MonadClient m) => UserId -> PlainTextPassword6 -> ExceptT AuthError m () +authenticate :: forall r. (Member PasswordStore r) => UserId -> PlainTextPassword6 -> ExceptT AuthError (AppT r) () authenticate u pw = - lift (lookupAuth u) >>= \case + lift (wrapHttp $ lookupAuth u) >>= \case Nothing -> throwE AuthInvalidUser Just (_, Deleted) -> throwE AuthInvalidUser Just (_, Suspended) -> throwE AuthSuspended @@ -195,8 +193,13 @@ authenticate u pw = (True, PasswordStatusNeedsUpdate) -> do -- FUTUREWORK(elland): 6char pwd allowed for now -- throwE AuthStalePassword in the future - for_ (plainTextPassword8 . fromPlainTextPassword $ pw) (updatePassword u) + for_ (plainTextPassword8 . fromPlainTextPassword $ pw) (lift . hashAndUpdatePwd u) (True, _) -> pure () + where + hashAndUpdatePwd :: UserId -> PlainTextPassword8 -> AppT r () + hashAndUpdatePwd uid pwd = do + hashed <- mkSafePasswordScrypt pwd + liftSem $ upsertHashedPassword uid hashed -- | Password reauthentication. If the account has a password, reauthentication -- is mandatory. If the account has no password, or is an SSO user, and no password is given, @@ -299,11 +302,6 @@ updateSSOId u ssoid = do updateManagedBy :: (MonadClient m) => UserId -> ManagedBy -> m () updateManagedBy u h = retry x5 $ write userManagedByUpdate (params LocalQuorum (h, u)) -updatePassword :: (MonadClient m) => UserId -> PlainTextPassword8 -> m () -updatePassword u t = do - p <- liftIO $ mkSafePassword t - retry x5 $ write userPasswordUpdate (params LocalQuorum (p, u)) - updateRichInfo :: (MonadClient m) => UserId -> RichInfoAssocList -> m () updateRichInfo u ri = retry x5 $ write userRichInfoUpdate (params LocalQuorum (ri, u)) @@ -352,13 +350,6 @@ updateStatus u s = userExists :: (MonadClient m) => UserId -> m Bool userExists uid = isJust <$> retry x1 (query1 idSelect (params LocalQuorum (Identity uid))) --- | Whether the account has been activated by verifying --- an email address or phone number. -isActivated :: (MonadClient m) => UserId -> m Bool -isActivated u = - (== Just (Identity True)) - <$> retry x1 (query1 activatedSelect (params LocalQuorum (Identity u))) - filterActive :: (MonadClient m) => [UserId] -> m [UserId] filterActive us = map (view _1) . filter isActiveUser @@ -391,16 +382,6 @@ lookupName u = fmap runIdentity <$> retry x1 (query1 nameSelect (params LocalQuorum (Identity u))) -lookupPassword :: (MonadClient m) => UserId -> m (Maybe Password) -lookupPassword u = - (runIdentity =<<) - <$> retry x1 (query1 passwordSelect (params LocalQuorum (Identity u))) - -lookupStatus :: (MonadClient m) => UserId -> m (Maybe AccountStatus) -lookupStatus u = - (runIdentity =<<) - <$> retry x1 (query1 statusSelect (params LocalQuorum (Identity u))) - lookupRichInfo :: (MonadClient m) => UserId -> m (Maybe RichInfoAssocList) lookupRichInfo u = fmap runIdentity @@ -564,18 +545,9 @@ localeSelect = "SELECT language, country FROM user WHERE id = ?" authSelect :: PrepQuery R (Identity UserId) (Maybe Password, Maybe AccountStatus) authSelect = "SELECT password, status FROM user WHERE id = ?" -passwordSelect :: PrepQuery R (Identity UserId) (Identity (Maybe Password)) -passwordSelect = "SELECT password FROM user WHERE id = ?" - -activatedSelect :: PrepQuery R (Identity UserId) (Identity Bool) -activatedSelect = "SELECT activated FROM user WHERE id = ?" - accountStateSelectAll :: PrepQuery R (Identity [UserId]) (UserId, Bool, Maybe AccountStatus) accountStateSelectAll = "SELECT id, activated, status FROM user WHERE id IN ?" -statusSelect :: PrepQuery R (Identity UserId) (Identity (Maybe AccountStatus)) -statusSelect = "SELECT status FROM user WHERE id = ?" - richInfoSelect :: PrepQuery R (Identity UserId) (Identity RichInfoAssocList) richInfoSelect = "SELECT json FROM rich_info WHERE user = ?" @@ -617,9 +589,6 @@ userSSOIdUpdate = {- `IF EXISTS`, but that requires benchmarking -} "UPDATE user userManagedByUpdate :: PrepQuery W (ManagedBy, UserId) () userManagedByUpdate = {- `IF EXISTS`, but that requires benchmarking -} "UPDATE user SET managed_by = ? WHERE id = ?" -userPasswordUpdate :: PrepQuery W (Password, UserId) () -userPasswordUpdate = {- `IF EXISTS`, but that requires benchmarking -} "UPDATE user SET password = ? WHERE id = ?" - userStatusUpdate :: PrepQuery W (AccountStatus, UserId) () userStatusUpdate = {- `IF EXISTS`, but that requires benchmarking -} "UPDATE user SET status = ? WHERE id = ?" diff --git a/services/brig/src/Brig/Data/UserKey.hs b/services/brig/src/Brig/Data/UserKey.hs deleted file mode 100644 index 15323d0f98d..00000000000 --- a/services/brig/src/Brig/Data/UserKey.hs +++ /dev/null @@ -1,146 +0,0 @@ --- This file is part of the Wire Server implementation. --- --- Copyright (C) 2022 Wire Swiss GmbH --- --- This program is free software: you can redistribute it and/or modify it under --- the terms of the GNU Affero General Public License as published by the Free --- Software Foundation, either version 3 of the License, or (at your option) any --- later version. --- --- This program is distributed in the hope that it will be useful, but WITHOUT --- ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS --- FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for more --- details. --- --- You should have received a copy of the GNU Affero General Public License along --- with this program. If not, see . - --- | Natural, addressable external identifiers of users. -module Brig.Data.UserKey - ( UserKey, - userEmailKey, - userPhoneKey, - forEmailKey, - forPhoneKey, - foldKey, - keyText, - keyTextOriginal, - claimKey, - keyAvailable, - lookupKey, - deleteKey, - deleteKeyForUser, - ) -where - -import Brig.Data.User qualified as User -import Brig.Email -import Brig.Phone -import Cassandra -import Data.Id -import Imports -import Wire.API.User (fromEmail) - --- | A natural identifier (i.e. unique key) of a user. -data UserKey - = UserEmailKey !EmailKey - | UserPhoneKey !PhoneKey - deriving stock (Eq, Show) - -userEmailKey :: Email -> UserKey -userEmailKey = UserEmailKey . mkEmailKey - -userPhoneKey :: Phone -> UserKey -userPhoneKey = UserPhoneKey . mkPhoneKey - -foldKey :: (Email -> a) -> (Phone -> a) -> UserKey -> a -foldKey f g k = case k of - UserEmailKey ek -> f (emailKeyOrig ek) - UserPhoneKey pk -> g (phoneKeyOrig pk) - -forEmailKey :: (Applicative f) => UserKey -> (Email -> f a) -> f (Maybe a) -forEmailKey k f = foldKey (fmap Just . f) (const (pure Nothing)) k - -forPhoneKey :: (Applicative f) => UserKey -> (Phone -> f a) -> f (Maybe a) -forPhoneKey k f = foldKey (const (pure Nothing)) (fmap Just . f) k - --- | Get the normalised text of a 'UserKey'. -keyText :: UserKey -> Text -keyText (UserEmailKey k) = emailKeyUniq k -keyText (UserPhoneKey k) = phoneKeyUniq k - --- | Get the original text of a 'UserKey', i.e. the original phone number --- or email address. -keyTextOriginal :: UserKey -> Text -keyTextOriginal (UserEmailKey k) = fromEmail (emailKeyOrig k) -keyTextOriginal (UserPhoneKey k) = fromPhone (phoneKeyOrig k) - --- | Claim a 'UserKey' for a user. -claimKey :: - (MonadClient m) => - -- | The key to claim. - UserKey -> - -- | The user claiming the key. - UserId -> - m Bool -claimKey k u = do - free <- keyAvailable k (Just u) - when free (insertKey u k) - pure free - --- | Check whether a 'UserKey' is available. --- A key is available if it is not already actived for another user or --- if the other user and the user looking to claim the key are the same. -keyAvailable :: - (MonadClient m) => - -- | The key to check. - UserKey -> - -- | The user looking to claim the key, if any. - Maybe UserId -> - m Bool -keyAvailable k u = do - o <- lookupKey k - case (o, u) of - (Nothing, _) -> pure True - (Just x, Just y) | x == y -> pure True - (Just x, _) -> not <$> User.isActivated x - -lookupKey :: (MonadClient m) => UserKey -> m (Maybe UserId) -lookupKey k = - fmap runIdentity - <$> retry x1 (query1 keySelect (params LocalQuorum (Identity $ keyText k))) - -insertKey :: (MonadClient m) => UserId -> UserKey -> m () -insertKey u k = do - retry x5 $ write keyInsert (params LocalQuorum (keyText k, u)) - -deleteKey :: (MonadClient m) => UserKey -> m () -deleteKey k = do - retry x5 $ write keyDelete (params LocalQuorum (Identity $ keyText k)) - --- | Delete `UserKey` for `UserId` --- --- This function ensures that keys of other users aren't accidentally deleted. --- E.g. the email address or phone number of a partially deleted user could --- already belong to a new user. To not interrupt deletion flows (that may be --- executed several times due to cassandra not supporting transactions) --- `deleteKeyForUser` does not fail for missing keys or keys that belong to --- another user: It always returns `()` as result. -deleteKeyForUser :: (MonadClient m) => UserId -> UserKey -> m () -deleteKeyForUser uid k = do - mbKeyUid <- lookupKey k - case mbKeyUid of - Just keyUid | keyUid == uid -> deleteKey k - _ -> pure () - --------------------------------------------------------------------------------- --- Queries - -keyInsert :: PrepQuery W (Text, UserId) () -keyInsert = "INSERT INTO user_keys (key, user) VALUES (?, ?)" - -keySelect :: PrepQuery R (Identity Text) (Identity UserId) -keySelect = "SELECT user FROM user_keys WHERE key = ?" - -keyDelete :: PrepQuery W (Identity Text) () -keyDelete = "DELETE FROM user_keys WHERE key = ?" diff --git a/services/brig/src/Brig/Effects/BlacklistStore.hs b/services/brig/src/Brig/Effects/BlacklistStore.hs index d116bc5b18e..3eca04e72df 100644 --- a/services/brig/src/Brig/Effects/BlacklistStore.hs +++ b/services/brig/src/Brig/Effects/BlacklistStore.hs @@ -2,9 +2,9 @@ module Brig.Effects.BlacklistStore where -import Brig.Data.UserKey import Imports import Polysemy +import Wire.UserKeyStore data BlacklistStore m a where Insert :: UserKey -> BlacklistStore m () diff --git a/services/brig/src/Brig/Effects/BlacklistStore/Cassandra.hs b/services/brig/src/Brig/Effects/BlacklistStore/Cassandra.hs index 8cbebdf7ac6..4a426b69efb 100644 --- a/services/brig/src/Brig/Effects/BlacklistStore/Cassandra.hs +++ b/services/brig/src/Brig/Effects/BlacklistStore/Cassandra.hs @@ -3,11 +3,11 @@ module Brig.Effects.BlacklistStore.Cassandra ) where -import Brig.Data.UserKey import Brig.Effects.BlacklistStore (BlacklistStore (..)) import Cassandra import Imports import Polysemy +import Wire.UserKeyStore interpretBlacklistStoreToCassandra :: forall m r a. diff --git a/services/brig/src/Brig/Effects/PasswordResetStore/CodeStore.hs b/services/brig/src/Brig/Effects/PasswordResetStore/CodeStore.hs deleted file mode 100644 index d01e3f7524f..00000000000 --- a/services/brig/src/Brig/Effects/PasswordResetStore/CodeStore.hs +++ /dev/null @@ -1,99 +0,0 @@ --- This file is part of the Wire Server implementation. --- --- Copyright (C) 2022 Wire Swiss GmbH --- --- This program is free software: you can redistribute it and/or modify it under --- the terms of the GNU Affero General Public License as published by the Free --- Software Foundation, either version 3 of the License, or (at your option) any --- later version. --- --- This program is distributed in the hope that it will be useful, but WITHOUT --- ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS --- FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for more --- details. --- --- You should have received a copy of the GNU Affero General Public License along --- with this program. If not, see . - -module Brig.Effects.PasswordResetStore.CodeStore - ( passwordResetStoreToCodeStore, - ) -where - -import Brig.Effects.CodeStore -import Brig.Effects.PasswordResetStore -import Brig.Types.User (PasswordResetPair) -import Data.Id -import Data.Time -import Imports hiding (lookup) -import Polysemy -import Wire.API.User.Identity -import Wire.API.User.Password -import Wire.Sem.Now -import Wire.Sem.Now qualified as Now - -passwordResetStoreToCodeStore :: - forall r a. - ( Member CodeStore r, - Member Now r - ) => - Sem (PasswordResetStore ': r) a -> - Sem r a -passwordResetStoreToCodeStore = interpret $ \case - CreatePasswordResetCode uid eEmailPhone -> create uid eEmailPhone - LookupPasswordResetCode uid -> lookup uid - VerifyPasswordResetCode prp -> verify prp - -maxAttempts :: Int32 -maxAttempts = 3 - -ttl :: NominalDiffTime -ttl = 3600 -- 60 minutes - -create :: - ( Member CodeStore r, - Member Now r - ) => - UserId -> - Either Email Phone -> - Sem r PasswordResetPair -create u target = do - key <- mkPasswordResetKey u - now <- Now.get - code <- either (const generateEmailCode) (const generatePhoneCode) target - codeInsert - key - (PRQueryData code u (Identity maxAttempts) (Identity (ttl `addUTCTime` now))) - (round ttl) - pure (key, code) - -lookup :: - ( Member CodeStore r, - Member Now r - ) => - UserId -> - Sem r (Maybe PasswordResetCode) -lookup u = do - key <- mkPasswordResetKey u - now <- Now.get - validate now =<< codeSelect key - where - validate now (Just (PRQueryData c _ _ (Just t))) | t > now = pure $ Just c - validate _ _ = pure Nothing - -verify :: - ( Member CodeStore r, - Member Now r - ) => - PasswordResetPair -> - Sem r (Maybe UserId) -verify (k, c) = do - now <- Now.get - code <- codeSelect k - case code of - Just (PRQueryData c' u _ (Just t)) | c == c' && t >= now -> pure (Just u) - Just (PRQueryData c' u (Just n) (Just t)) | n > 1 && t > now -> do - codeInsert k (PRQueryData c' u (Identity (n - 1)) (Identity t)) (round ttl) - pure Nothing - Just PRQueryData {} -> codeDelete k $> Nothing - Nothing -> pure Nothing diff --git a/services/brig/src/Brig/Email.hs b/services/brig/src/Brig/Email.hs index 2954400dc2b..d4ec3f4f0f8 100644 --- a/services/brig/src/Brig/Email.hs +++ b/services/brig/src/Brig/Email.hs @@ -47,6 +47,7 @@ import Data.Text qualified as Text import Imports import Network.Mail.Mime import Wire.API.User +import Wire.UserKeyStore ------------------------------------------------------------------------------- sendMail :: (MonadIO m, MonadReader Env m) => Mail -> m () @@ -55,39 +56,6 @@ sendMail m = Just smtp -> view applog >>= \logger -> SMTP.sendMail logger smtp m Nothing -> view awsEnv >>= \e -> AWS.execute e $ AWS.sendMail m -------------------------------------------------------------------------------- --- Unique Keys - --- | An 'EmailKey' is an 'Email' in a form that serves as a unique lookup key. -data EmailKey = EmailKey - { emailKeyUniq :: !Text, - emailKeyOrig :: !Email - } - -instance Show EmailKey where - showsPrec _ = shows . emailKeyUniq - -instance Eq EmailKey where - (EmailKey k _) == (EmailKey k' _) = k == k' - --- | Turn an 'Email' into an 'EmailKey'. --- --- The following transformations are performed: --- --- * Both local and domain parts are forced to lowercase to make --- e-mail addresses fully case-insensitive. --- * "+" suffixes on the local part are stripped unless the domain --- part is contained in a trusted whitelist. -mkEmailKey :: Email -> EmailKey -mkEmailKey orig@(Email localPart domain) = - let uniq = Text.toLower localPart' <> "@" <> Text.toLower domain - in EmailKey uniq orig - where - localPart' - | domain `notElem` trusted = Text.takeWhile (/= '+') localPart - | otherwise = localPart - trusted = ["wearezeta.com", "wire.com", "simulator.amazonses.com"] - ------------------------------------------------------------------------------- -- MIME Conversions diff --git a/services/brig/src/Brig/InternalEvent/Process.hs b/services/brig/src/Brig/InternalEvent/Process.hs index 484e4026e11..912d5241c01 100644 --- a/services/brig/src/Brig/InternalEvent/Process.hs +++ b/services/brig/src/Brig/InternalEvent/Process.hs @@ -41,6 +41,7 @@ import Wire.API.UserEvent import Wire.NotificationSubsystem import Wire.Sem.Delay import Wire.Sem.Paging.Cassandra (InternalPaging) +import Wire.UserKeyStore import Wire.UserStore (UserStore) -- | Handle an internal event. @@ -53,6 +54,7 @@ onEvent :: Member Delay r, Member Race r, Member (Input (Local ())) r, + Member UserKeyStore r, Member (Input UTCTime) r, Member UserStore r, Member (ConnectionStore InternalPaging) r diff --git a/services/brig/src/Brig/Options.hs b/services/brig/src/Brig/Options.hs index d837fb7a2f4..32935e4eb07 100644 --- a/services/brig/src/Brig/Options.hs +++ b/services/brig/src/Brig/Options.hs @@ -23,7 +23,6 @@ module Brig.Options where -import Brig.Allowlists (AllowlistEmailDomains (..), AllowlistPhonePrefixes (..)) import Brig.Queue.Types (QueueOpts (..)) import Brig.SMTP (SMTPConnType (..)) import Brig.User.Auth.Cookie.Limit @@ -56,6 +55,7 @@ import Network.AMQP.Extended import Network.DNS qualified as DNS import System.Logger.Extended (Level, LogFormat) import Util.Options +import Wire.API.Allowlists (AllowlistEmailDomains (..), AllowlistPhonePrefixes (..)) import Wire.API.Routes.FederationDomainConfig import Wire.API.Routes.Version import Wire.API.Team.Feature qualified as Public @@ -931,7 +931,9 @@ Lens.makeLensesFor ("setOAuthAccessTokenExpirationTimeSecsInternal", "oauthAccessTokenExpirationTimeSecsInternal"), ("setDisabledAPIVersions", "disabledAPIVersions"), ("setOAuthRefreshTokenExpirationTimeSecsInternal", "oauthRefreshTokenExpirationTimeSecsInternal"), - ("setOAuthMaxActiveRefreshTokensInternal", "oauthMaxActiveRefreshTokensInternal") + ("setOAuthMaxActiveRefreshTokensInternal", "oauthMaxActiveRefreshTokensInternal"), + ("setAllowlistEmailDomains", "allowlistEmailDomains"), + ("setAllowlistPhonePrefixes", "allowlistPhonePrefixes") ] ''Settings diff --git a/services/brig/src/Brig/Phone.hs b/services/brig/src/Brig/Phone.hs index e87a46ea739..37d874a8552 100644 --- a/services/brig/src/Brig/Phone.hs +++ b/services/brig/src/Brig/Phone.hs @@ -56,6 +56,7 @@ import Ropes.Twilio qualified as Twilio import System.Logger.Class qualified as Log import System.Logger.Message (field, msg, val, (~~)) import Wire.API.User +import Wire.UserKeyStore ------------------------------------------------------------------------------- -- Sending SMS and Voice Calls @@ -292,27 +293,6 @@ withCallBudget phone go = do ~~ field "phone" phone pure a --------------------------------------------------------------------------------- --- Unique Keys - -data PhoneKey = PhoneKey - { -- | canonical form of 'phoneKeyOrig', without whitespace. - phoneKeyUniq :: !Text, - -- | phone number with whitespace. - phoneKeyOrig :: !Phone - } - -instance Show PhoneKey where - showsPrec _ = shows . phoneKeyUniq - -instance Eq PhoneKey where - (PhoneKey k _) == (PhoneKey k' _) = k == k' - -mkPhoneKey :: Phone -> PhoneKey -mkPhoneKey orig = - let uniq = Text.filter (not . isSpace) (fromPhone orig) - in PhoneKey uniq orig - ------------------------------------------------------------------------------- -- Retry Settings diff --git a/services/brig/src/Brig/Provider/API.hs b/services/brig/src/Brig/Provider/API.hs index ee58e2d005a..f226c052043 100644 --- a/services/brig/src/Brig/Provider/API.hs +++ b/services/brig/src/Brig/Provider/API.hs @@ -193,10 +193,10 @@ newAccount new = do let emailKey = mkEmailKey email wrapClientE (DB.lookupKey emailKey) >>= mapM_ (const $ throwStd emailExists) (safePass, newPass) <- case pass of - Just newPass -> (,Nothing) <$> mkSafePassword newPass + Just newPass -> (,Nothing) <$> mkSafePasswordScrypt newPass Nothing -> do newPass <- genPassword - safePass <- mkSafePassword newPass + safePass <- mkSafePasswordScrypt newPass pure (safePass, Just newPass) pid <- wrapClientE $ DB.insertAccount name safePass url descr gen <- Code.mkGen (Code.ForEmail email) diff --git a/services/brig/src/Brig/Provider/DB.hs b/services/brig/src/Brig/Provider/DB.hs index 9d25bbc570a..0ef612f5a1b 100644 --- a/services/brig/src/Brig/Provider/DB.hs +++ b/services/brig/src/Brig/Provider/DB.hs @@ -131,7 +131,7 @@ updateAccountPassword :: PlainTextPassword6 -> m () updateAccountPassword pid pwd = do - p <- liftIO $ mkSafePassword pwd + p <- liftIO $ mkSafePasswordScrypt pwd retry x5 $ write cql $ params LocalQuorum (p, pid) where cql :: PrepQuery W (Password, ProviderId) () diff --git a/services/brig/src/Brig/Run.hs b/services/brig/src/Brig/Run.hs index 7e31ac802b1..5f713dd5edb 100644 --- a/services/brig/src/Brig/Run.hs +++ b/services/brig/src/Brig/Run.hs @@ -73,6 +73,7 @@ import Wire.API.Routes.Version.Wai import Wire.API.User (AccountStatus (PendingInvitation)) import Wire.DeleteQueue import Wire.Sem.Paging qualified as P +import Wire.UserStore -- FUTUREWORK: If any of these async threads die, we will have no clue about it -- and brig could start misbehaving. We should ensure that brig dies whenever a @@ -180,7 +181,8 @@ pendingActivationCleanup :: forall r p. ( P.Paging p, Member (UserPendingActivationStore p) r, - Member DeleteQueue r + Member DeleteQueue r, + Member UserStore r ) => AppT r () pendingActivationCleanup = do @@ -189,7 +191,7 @@ pendingActivationCleanup = do forExpirationsPaged $ \exps -> do uids <- for exps $ \(UserPendingActivation uid expiresAt) -> do - isPendingInvitation <- (Just PendingInvitation ==) <$> wrapClient (API.lookupStatus uid) + isPendingInvitation <- (Just PendingInvitation ==) <$> liftSem (lookupStatus uid) pure ( expiresAt < now, isPendingInvitation, diff --git a/services/brig/src/Brig/Team/API.hs b/services/brig/src/Brig/Team/API.hs index 4dc9e8d5b42..e5d6133664a 100644 --- a/services/brig/src/Brig/Team/API.hs +++ b/services/brig/src/Brig/Team/API.hs @@ -32,8 +32,6 @@ import Brig.API.User (createUserInviteViaScim, fetchUserIdentity) import Brig.API.User qualified as API import Brig.API.Util (logEmail, logInvitationCode) import Brig.App -import Brig.Data.UserKey -import Brig.Data.UserKey qualified as Data import Brig.Effects.BlacklistStore (BlacklistStore) import Brig.Effects.BlacklistStore qualified as BlacklistStore import Brig.Effects.ConnectionStore (ConnectionStore) @@ -85,11 +83,13 @@ import Wire.GalleyAPIAccess qualified as GalleyAPIAccess import Wire.NotificationSubsystem import Wire.Sem.Concurrency import Wire.Sem.Paging.Cassandra (InternalPaging) +import Wire.UserKeyStore import Wire.UserSubsystem servantAPI :: ( Member BlacklistStore r, Member GalleyAPIAccess r, + Member UserKeyStore r, Member UserSubsystem r ) => ServerT TeamsAPI (Handler r) @@ -118,6 +118,7 @@ getInvitationCode t r = do createInvitationPublicH :: ( Member BlacklistStore r, Member GalleyAPIAccess r, + Member UserKeyStore r, Member UserSubsystem r ) => UserId -> @@ -141,6 +142,7 @@ data CreateInvitationInviter = CreateInvitationInviter createInvitationPublic :: ( Member BlacklistStore r, Member GalleyAPIAccess r, + Member UserKeyStore r, Member UserSubsystem r ) => UserId -> @@ -169,6 +171,7 @@ createInvitationPublic uid tid body = do createInvitationViaScim :: ( Member BlacklistStore r, Member GalleyAPIAccess r, + Member UserKeyStore r, Member (UserPendingActivationStore p) r, Member TinyLog r ) => @@ -218,7 +221,8 @@ logInvitationRequest context action = createInvitation' :: ( Member BlacklistStore r, - Member GalleyAPIAccess r + Member GalleyAPIAccess r, + Member UserKeyStore r ) => TeamId -> Maybe UserId -> @@ -237,7 +241,7 @@ createInvitation' tid mUid inviteeRole mbInviterUid fromEmail body = do blacklistedEm <- lift $ liftSem $ BlacklistStore.exists uke when blacklistedEm $ throwStd blacklistedEmail - emailTaken <- lift $ isJust <$> wrapClient (Data.lookupKey uke) + emailTaken <- lift $ liftSem $ isJust <$> lookupKey uke when emailTaken $ throwStd emailExists @@ -248,7 +252,7 @@ createInvitation' tid mUid inviteeRole mbInviterUid fromEmail body = do blacklistedPh <- lift $ liftSem $ BlacklistStore.exists ukp when blacklistedPh $ throwStd (errorToWai @'E.BlacklistedPhone) - phoneTaken <- lift $ isJust <$> wrapClient (Data.lookupKey ukp) + phoneTaken <- lift $ liftSem $ isJust <$> lookupKey ukp when phoneTaken $ throwStd phoneExists pure validatedPhone diff --git a/services/brig/src/Brig/User/Auth.hs b/services/brig/src/Brig/User/Auth.hs index 1ec0faa86e4..d2b00159d12 100644 --- a/services/brig/src/Brig/User/Auth.hs +++ b/services/brig/src/Brig/User/Auth.hs @@ -45,8 +45,6 @@ import Brig.Data.Activation qualified as Data import Brig.Data.Client import Brig.Data.LoginCode qualified as Data import Brig.Data.User qualified as Data -import Brig.Data.UserKey -import Brig.Data.UserKey qualified as Data import Brig.Effects.ConnectionStore (ConnectionStore) import Brig.Email import Brig.Options qualified as Opt @@ -84,12 +82,16 @@ import Wire.API.User.Auth.Sso import Wire.GalleyAPIAccess (GalleyAPIAccess) import Wire.GalleyAPIAccess qualified as GalleyAPIAccess import Wire.NotificationSubsystem +import Wire.PasswordStore (PasswordStore, lookupHashedPassword) import Wire.Sem.Paging.Cassandra (InternalPaging) +import Wire.UserKeyStore import Wire.UserStore -import Wire.UserStore.Cassandra (interpretUserStoreCassandra) sendLoginCode :: - (Member TinyLog r) => + ( Member TinyLog r, + Member UserKeyStore r, + Member PasswordStore r + ) => Phone -> Bool -> Bool -> @@ -100,12 +102,12 @@ sendLoginCode phone call force = do (throwE $ SendLoginInvalidPhone phone) (pure . userPhoneKey) =<< lift (wrapHttpClient $ validatePhone phone) - user <- lift $ wrapHttpClient $ Data.lookupKey pk + user <- lift $ liftSem $ lookupKey pk case user of Nothing -> throwE $ SendLoginInvalidPhone phone Just u -> do lift . liftSem . Log.debug $ field "user" (toByteString u) . field "action" (val "User.sendLoginCode") - pw <- lift $ wrapClient $ Data.lookupPassword u + pw <- lift $ liftSem $ lookupHashedPassword u unless (isNothing pw || force) $ throwE SendLoginPasswordExists lift $ wrapHttpClient $ do @@ -118,11 +120,11 @@ sendLoginCode phone call force = do pure c lookupLoginCode :: - (Member TinyLog r) => + (Member TinyLog r, Member UserKeyStore r) => Phone -> AppT r (Maybe PendingLoginCode) lookupLoginCode phone = - wrapClient (Data.lookupKey (userPhoneKey phone)) >>= \case + liftSem (lookupKey (userPhoneKey phone)) >>= \case Nothing -> pure Nothing Just u -> do liftSem $ Log.debug $ field "user" (toByteString u) . field "action" (val "User.lookupLoginCode") @@ -136,22 +138,24 @@ login :: Member NotificationSubsystem r, Member (Input (Local ())) r, Member (Input UTCTime) r, - Member (ConnectionStore InternalPaging) r + Member (ConnectionStore InternalPaging) r, + Member PasswordStore r, + Member UserKeyStore r, + Member UserStore r ) => Login -> CookieType -> ExceptT LoginError (AppT r) (Access ZAuth.User) login (PasswordLogin (PasswordLoginData li pw label code)) typ = do - uid <- wrapHttpClientE $ resolveLoginId li + uid <- resolveLoginId li lift . liftSem . Log.debug $ field "user" (toByteString uid) . field "action" (val "User.login") wrapHttpClientE $ checkRetryLimit uid - wrapHttpClientE $ - Data.authenticate uid pw `catchE` \case - AuthInvalidUser -> loginFailed uid - AuthInvalidCredentials -> loginFailed uid - AuthSuspended -> throwE LoginSuspended - AuthEphemeral -> throwE LoginEphemeral - AuthPendingInvitation -> throwE LoginPendingActivation + Data.authenticate uid pw `catchE` \case + AuthInvalidUser -> wrapHttpClientE $ loginFailed uid + AuthInvalidCredentials -> wrapHttpClientE $ loginFailed uid + AuthSuspended -> throwE LoginSuspended + AuthEphemeral -> throwE LoginEphemeral + AuthPendingInvitation -> throwE LoginPendingActivation verifyLoginCode code uid newAccess @ZAuth.User @ZAuth.Access uid Nothing typ label where @@ -163,7 +167,7 @@ login (PasswordLogin (PasswordLoginData li pw label code)) typ = do VerificationCodeRequired -> wrapHttpClientE $ loginFailedWith LoginCodeRequired uid VerificationCodeNoEmail -> wrapHttpClientE $ loginFailed uid login (SmsLogin (SmsLoginData phone code label)) typ = do - uid <- wrapClientE $ resolveLoginId (LoginByPhone phone) + uid <- resolveLoginId (LoginByPhone phone) lift . liftSem . Log.debug $ field "user" (toByteString uid) . field "action" (val "User.login") wrapHttpClientE $ checkRetryLimit uid ok <- wrapHttpClientE $ Data.verifyLoginCode uid code @@ -264,7 +268,7 @@ renewAccess uts at mcid = do pure $ Access at' ck' revokeAccess :: - (Member TinyLog r) => + (Member TinyLog r, Member PasswordStore r) => UserId -> PlainTextPassword6 -> [CookieId] -> @@ -272,7 +276,7 @@ revokeAccess :: ExceptT AuthError (AppT r) () revokeAccess u pw cc ll = do lift . liftSem $ Log.debug $ field "user" (toByteString u) . field "action" (val "User.revokeAccess") - wrapHttpClientE $ unlessM (Data.isSamlUser u) $ Data.authenticate u pw + unlessM (lift . wrapHttpClient $ Data.isSamlUser u) $ Data.authenticate u pw lift $ wrapHttpClient $ revokeCookies u cc ll -------------------------------------------------------------------------------- @@ -329,17 +333,12 @@ newAccess uid cid ct cl = do t <- lift $ newAccessToken @u @a ck Nothing pure $ Access t (Just ck) -resolveLoginId :: forall m. (MonadClient m, MonadReader Env m) => LoginId -> ExceptT LoginError m UserId +resolveLoginId :: (Member UserKeyStore r, Member UserStore r) => LoginId -> ExceptT LoginError (AppT r) UserId resolveLoginId li = do - let adhocInterpreter :: Sem '[UserStore, Embed IO] a -> m a - adhocInterpreter action = do - clientState <- asks (view casClient) - liftIO (runM (interpretUserStoreCassandra clientState action)) - - usr <- validateLoginId li >>= lift . either lookupKey (adhocInterpreter . lookupHandle) + usr <- wrapClientE (validateLoginId li) >>= lift . either (liftSem . lookupKey) (liftSem . lookupHandle) case usr of Nothing -> do - pending <- lift $ isPendingActivation li + pending <- wrapClientE $ isPendingActivation li throwE $ if pending then LoginPendingActivation diff --git a/services/brig/src/Brig/User/Auth/Cookie.hs b/services/brig/src/Brig/User/Auth/Cookie.hs index 5eeacc27ed3..1be8ff2c778 100644 --- a/services/brig/src/Brig/User/Auth/Cookie.hs +++ b/services/brig/src/Brig/User/Auth/Cookie.hs @@ -43,7 +43,6 @@ where import Brig.App import Brig.Options hiding (user) import Brig.User.Auth.Cookie.Limit -import Brig.User.Auth.DB.Cookie qualified as DB import Brig.ZAuth qualified as ZAuth import Cassandra import Control.Error @@ -63,6 +62,7 @@ import System.Logger.Class (field, msg, val, (~~)) import System.Logger.Class qualified as Log import Web.Cookie qualified as WebCookie import Wire.API.User.Auth +import Wire.SessionStore qualified as Store -------------------------------------------------------------------------------- -- Basic Cookie Management @@ -94,7 +94,7 @@ newCookie uid cid typ label = do cookieSucc = Nothing, cookieValue = tok } - DB.insertCookie uid c Nothing + adhocSessionStoreInterpreter $ Store.insertCookie uid (toUnitCookie c) Nothing pure c -- | Renew the given cookie with a fresh token, if its age @@ -133,7 +133,7 @@ nextCookie c mNewCid = runMaybeT $ do ck <- hoistMaybe $ cookieSucc c let uid = ZAuth.userTokenOf (cookieValue c) lift $ trackSuperseded uid (cookieId c) - cs <- lift $ DB.listCookies uid + cs <- lift $ adhocSessionStoreInterpreter $ Store.listCookies uid c' <- hoistMaybe $ List.find (\x -> cookieId x == ck && cookieType x == PersistentCookie) cs @@ -161,7 +161,7 @@ renewCookie old mcid = do -- an ever growing chain of superseded cookies. let old' = old {cookieSucc = Just (cookieId new)} ttl <- setUserCookieRenewAge <$> view settings - DB.insertCookie uid old' (Just (DB.TTL (fromIntegral ttl))) + adhocSessionStoreInterpreter $ Store.insertCookie uid (toUnitCookie old') (Just (Store.TTL (fromIntegral ttl))) pure new -- | Whether a user has not renewed any of her cookies for longer than @@ -205,29 +205,29 @@ newAccessToken c mt = do -- | Lookup the stored cookie associated with a user token, -- if one exists. -lookupCookie :: (ZAuth.UserTokenLike u, MonadClient m) => ZAuth.Token u -> m (Maybe (Cookie (ZAuth.Token u))) +lookupCookie :: (ZAuth.UserTokenLike u, MonadClient m, MonadReader Env m) => ZAuth.Token u -> m (Maybe (Cookie (ZAuth.Token u))) lookupCookie t = do let user = ZAuth.userTokenOf t let rand = ZAuth.userTokenRand t let expi = ZAuth.tokenExpiresUTC t - fmap setToken <$> DB.lookupCookie user expi (CookieId rand) + adhocSessionStoreInterpreter $ fmap setToken <$> Store.lookupCookie user expi (CookieId rand) where setToken c = c {cookieValue = t} -listCookies :: (MonadClient m) => UserId -> [CookieLabel] -> m [Cookie ()] -listCookies u [] = DB.listCookies u -listCookies u ll = filter byLabel <$> DB.listCookies u +listCookies :: (MonadClient m, MonadReader Env m) => UserId -> [CookieLabel] -> m [Cookie ()] +listCookies u [] = adhocSessionStoreInterpreter $ Store.listCookies u +listCookies u ll = filter byLabel <$> adhocSessionStoreInterpreter (Store.listCookies u) where byLabel c = maybe False (`elem` ll) (cookieLabel c) -revokeAllCookies :: (MonadClient m) => UserId -> m () +revokeAllCookies :: (MonadClient m, MonadReader Env m) => UserId -> m () revokeAllCookies u = revokeCookies u [] [] -revokeCookies :: (MonadClient m) => UserId -> [CookieId] -> [CookieLabel] -> m () -revokeCookies u [] [] = DB.deleteAllCookies u +revokeCookies :: (MonadClient m, MonadReader Env m) => UserId -> [CookieId] -> [CookieLabel] -> m () +revokeCookies u [] [] = adhocSessionStoreInterpreter $ Store.deleteAllCookies u revokeCookies u ids labels = do - cc <- filter matching <$> DB.listCookies u - DB.deleteCookies u cc + cc <- filter matching <$> adhocSessionStoreInterpreter (Store.listCookies u) + adhocSessionStoreInterpreter $ Store.deleteCookies u cc where matching c = cookieId c `elem` ids @@ -248,7 +248,7 @@ newCookieLimited :: Maybe CookieLabel -> m (Either RetryAfter (Cookie (ZAuth.Token t))) newCookieLimited u c typ label = do - cs <- filter ((typ ==) . cookieType) <$> DB.listCookies u + cs <- filter ((typ ==) . cookieType) <$> adhocSessionStoreInterpreter (Store.listCookies u) now <- liftIO =<< view currentTime lim <- CookieLimit . setUserCookieLimit <$> view settings thr <- setUserCookieThrottle <$> view settings diff --git a/services/brig/src/Brig/User/Auth/DB/Instances.hs b/services/brig/src/Brig/User/Auth/DB/Instances.hs deleted file mode 100644 index 5cd536e4fba..00000000000 --- a/services/brig/src/Brig/User/Auth/DB/Instances.hs +++ /dev/null @@ -1,53 +0,0 @@ -{-# LANGUAGE GeneralizedNewtypeDeriving #-} -{-# OPTIONS_GHC -fno-warn-orphans #-} - --- This file is part of the Wire Server implementation. --- --- Copyright (C) 2022 Wire Swiss GmbH --- --- This program is free software: you can redistribute it and/or modify it under --- the terms of the GNU Affero General Public License as published by the Free --- Software Foundation, either version 3 of the License, or (at your option) any --- later version. --- --- This program is distributed in the hope that it will be useful, but WITHOUT --- ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS --- FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for more --- details. --- --- You should have received a copy of the GNU Affero General Public License along --- with this program. If not, see . - -module Brig.User.Auth.DB.Instances - ( - ) -where - -import Cassandra.CQL -import Data.Id () -import Data.Misc () -import Data.Range () -import Data.Text.Ascii () -import Imports -import Wire.API.User.Auth - -deriving instance Cql CookieLabel - -deriving instance Cql LoginCode - -instance Cql CookieId where - ctype = Tagged BigIntColumn - toCql = CqlBigInt . fromIntegral . cookieIdNum - - fromCql (CqlBigInt i) = pure (CookieId (fromIntegral i)) - fromCql _ = Left "fromCql: invalid cookie id" - -instance Cql CookieType where - ctype = Tagged IntColumn - - toCql SessionCookie = CqlInt 0 - toCql PersistentCookie = CqlInt 1 - - fromCql (CqlInt 0) = pure SessionCookie - fromCql (CqlInt 1) = pure PersistentCookie - fromCql _ = Left "fromCql: invalid cookie type" diff --git a/services/brig/test/integration/API/Internal.hs b/services/brig/test/integration/API/Internal.hs index b4d730fcd94..f3b65f6b37c 100644 --- a/services/brig/test/integration/API/Internal.hs +++ b/services/brig/test/integration/API/Internal.hs @@ -27,7 +27,7 @@ import API.Internal.Util import API.MLS.Util import Bilge import Bilge.Assert -import Brig.Data.User (lookupFeatureConferenceCalling, lookupStatus, userExists) +import Brig.Data.User (lookupFeatureConferenceCalling, userExists) import Brig.Options qualified as Opt import Cassandra qualified as C import Cassandra qualified as Cass @@ -222,3 +222,11 @@ testWritetimeRepresentation _ _mgr db brig _brigep _galley = do q2 :: C.PrepQuery C.R (Identity UserId) (Identity (Writetime ())) q2 = "SELECT WRITETIME(status) from user where id = ?" + +lookupStatus :: UserId -> C.Client (Maybe AccountStatus) +lookupStatus u = + (runIdentity =<<) + <$> C.retry C.x1 (C.query1 statusSelect (C.params C.LocalQuorum (Identity u))) + where + statusSelect :: C.PrepQuery C.R (Identity UserId) (Identity (Maybe AccountStatus)) + statusSelect = "SELECT status FROM user WHERE id = ?" diff --git a/services/brig/test/integration/API/User/Auth.hs b/services/brig/test/integration/API/User/Auth.hs index d45863fcb19..8020c56360b 100644 --- a/services/brig/test/integration/API/User/Auth.hs +++ b/services/brig/test/integration/API/User/Auth.hs @@ -30,7 +30,6 @@ import Bilge qualified as Http import Bilge.Assert hiding (assert) import Brig.Code qualified as Code import Brig.Options qualified as Opts -import Brig.User.Auth.Cookie (revokeAllCookies) import Brig.ZAuth (ZAuth, runZAuth) import Brig.ZAuth qualified as ZAuth import Cassandra hiding (Value) @@ -62,7 +61,7 @@ import Test.Tasty.HUnit qualified as HUnit import UnliftIO.Async hiding (wait) import Util import Wire.API.Conversation (Conversation (..)) -import Wire.API.Password (Password, mkSafePassword) +import Wire.API.Password (Password, mkSafePasswordScrypt) import Wire.API.User as Public import Wire.API.User.Auth as Auth import Wire.API.User.Auth.LegalHold @@ -191,16 +190,22 @@ testLoginWith6CharPassword brig db = do -- we need to write this directly to the db, to be able to test this writeDirectlyToDB :: UserId -> PlainTextPassword6 -> Http () writeDirectlyToDB uid pw = - liftIO (runClient db (updatePassword uid pw >> revokeAllCookies uid)) + liftIO (runClient db (updatePassword uid pw >> deleteAllCookies uid)) updatePassword :: (MonadClient m) => UserId -> PlainTextPassword6 -> m () updatePassword u t = do - p <- liftIO $ mkSafePassword t + p <- liftIO $ mkSafePasswordScrypt t retry x5 $ write userPasswordUpdate (params LocalQuorum (p, u)) userPasswordUpdate :: PrepQuery W (Password, UserId) () userPasswordUpdate = {- `IF EXISTS`, but that requires benchmarking -} "UPDATE user SET password = ? WHERE id = ?" + deleteAllCookies :: (MonadClient m) => UserId -> m () + deleteAllCookies u = retry x5 (write cql (params LocalQuorum (Identity u))) + where + cql :: PrepQuery W (Identity UserId) () + cql = "DELETE FROM user_cookies WHERE user = ?" + -------------------------------------------------------------------------------- -- ZAuth test environment for generating arbitrary tokens. diff --git a/services/brig/test/integration/API/User/PasswordReset.hs b/services/brig/test/integration/API/User/PasswordReset.hs index 9a5c69987ec..aa6c4d0ec80 100644 --- a/services/brig/test/integration/API/User/PasswordReset.hs +++ b/services/brig/test/integration/API/User/PasswordReset.hs @@ -31,6 +31,7 @@ import Data.Aeson as A import Data.Aeson.KeyMap qualified as KeyMap import Data.Misc import Imports +import Network.Wai.Utilities (Error (label)) import Test.Tasty hiding (Timeout) import Util import Wire.API.User @@ -46,16 +47,16 @@ tests :: Cannon -> Galley -> TestTree -tests cs _cl _at _conf p b _c _g = +tests _cs _cl _at _conf p b _c _g = testGroup "password-reset" - [ test p "post /password-reset[/complete] - 201[/200]" $ testPasswordReset b cs, - test p "post /password-reset after put /access/self/email - 400" $ testPasswordResetAfterEmailUpdate b cs, - test p "post /password-reset/complete - password too short - 400" $ testPasswordResetInvalidPasswordLength b cs + [ test p "post /password-reset[/complete] - 201[/200]" $ testPasswordReset b, + test p "post /password-reset after put /access/self/email - 400" $ testPasswordResetAfterEmailUpdate b, + test p "post /password-reset/complete - password too short - 400" $ testPasswordResetInvalidPasswordLength b ] -testPasswordReset :: Brig -> DB.ClientState -> Http () -testPasswordReset brig cs = do +testPasswordReset :: Brig -> Http () +testPasswordReset brig = do u <- randomUser brig let Just email = userEmail u let uid = userId u @@ -63,7 +64,12 @@ testPasswordReset brig cs = do let newpw = plainTextPassword8Unsafe "newsecret" do initiatePasswordReset brig email !!! const 201 === statusCode - passwordResetData <- preparePasswordReset brig cs email uid newpw + initiatePasswordReset brig email !!! do + const 409 === statusCode + const (Just "code-exists") === fmap label . responseJsonMaybe + const Nothing {- the "retry-after" header is only added for provider, not user, at the time of writing this test -} === getHeader "Retry-After" + + passwordResetData <- preparePasswordReset brig email uid newpw completePasswordReset brig passwordResetData !!! const 200 === statusCode -- try login login brig (defEmailLogin email) PersistentCookie @@ -76,33 +82,33 @@ testPasswordReset brig cs = do -- reset password again to the same new password, get 400 "must be different" do initiatePasswordReset brig email !!! const 201 === statusCode - passwordResetData <- preparePasswordReset brig cs email uid newpw + passwordResetData <- preparePasswordReset brig email uid newpw completePasswordReset brig passwordResetData !!! const 409 === statusCode -testPasswordResetAfterEmailUpdate :: Brig -> DB.ClientState -> Http () -testPasswordResetAfterEmailUpdate brig cs = do +testPasswordResetAfterEmailUpdate :: Brig -> Http () +testPasswordResetAfterEmailUpdate brig = do u <- randomUser brig let uid = userId u let Just email = userEmail u eml <- randomEmail initiateEmailUpdateLogin brig eml (emailLogin email defPassword Nothing) uid !!! const 202 === statusCode initiatePasswordReset brig email !!! const 201 === statusCode - passwordResetData <- preparePasswordReset brig cs email uid (plainTextPassword8Unsafe "newsecret") + passwordResetData <- preparePasswordReset brig email uid (plainTextPassword8Unsafe "newsecret") -- activate new email activateEmail brig eml checkEmail brig uid eml -- attempting to complete password reset should fail completePasswordReset brig passwordResetData !!! const 400 === statusCode -testPasswordResetInvalidPasswordLength :: Brig -> DB.ClientState -> Http () -testPasswordResetInvalidPasswordLength brig cs = do +testPasswordResetInvalidPasswordLength :: Brig -> Http () +testPasswordResetInvalidPasswordLength brig = do u <- randomUser brig let Just email = userEmail u let uid = userId u -- for convenience, we create a valid password first that we replace with an invalid one in the JSON later let newpw = plainTextPassword8Unsafe "newsecret" initiatePasswordReset brig email !!! const 201 === statusCode - passwordResetData <- preparePasswordReset brig cs email uid newpw + passwordResetData <- preparePasswordReset brig email uid newpw let shortPassword = String "123456" let reqBody = toJSON passwordResetData & addJsonKey "password" shortPassword postCompletePasswordReset reqBody !!! const 400 === statusCode diff --git a/services/brig/test/integration/API/User/Util.hs b/services/brig/test/integration/API/User/Util.hs index 882735a1e48..fd6f2b6cbe0 100644 --- a/services/brig/test/integration/API/User/Util.hs +++ b/services/brig/test/integration/API/User/Util.hs @@ -24,8 +24,6 @@ module API.User.Util where import Bilge hiding (accept, timeout) import Bilge.Assert import Brig.Code qualified as Code -import Brig.Effects.CodeStore -import Brig.Effects.CodeStore.Cassandra import Brig.Options (Opts) import Brig.Types.Team.LegalHold (LegalHoldClientRequest (..)) import Brig.ZAuth (Token) @@ -55,7 +53,6 @@ import Federation.Util (withTempMockFederator) import Federator.MockServer (FederatedRequest (..)) import GHC.TypeLits (KnownSymbol) import Imports -import Polysemy import Test.Tasty.Cannon qualified as WS import Test.Tasty.HUnit import Util @@ -209,21 +206,18 @@ initiateEmailUpdateNoSend brig email uid = preparePasswordReset :: (MonadIO m, MonadHttp m) => Brig -> - DB.ClientState -> Email -> UserId -> PlainTextPassword8 -> m CompletePasswordReset -preparePasswordReset brig cState email uid newpw = do +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) - ident <- PasswordResetIdentityKey <$> runSem (mkPasswordResetKey uid) + let ident = PasswordResetIdentityKey (mkPasswordResetKey uid) let complete = CompletePasswordReset ident pwcode newpw pure complete - where - runSem = liftIO . runFinal @IO . interpretClientToIO cState . codeStoreToCassandra @DB.Client completePasswordReset :: Brig -> CompletePasswordReset -> (MonadHttp m) => m ResponseLBS completePasswordReset brig passwordResetData = diff --git a/services/galley/src/Galley/API/Update.hs b/services/galley/src/Galley/API/Update.hs index e16a7e8c96e..6fe22e53beb 100644 --- a/services/galley/src/Galley/API/Update.hs +++ b/services/galley/src/Galley/API/Update.hs @@ -125,7 +125,7 @@ import Wire.API.Federation.API import Wire.API.Federation.API.Galley import Wire.API.Federation.Error import Wire.API.Message -import Wire.API.Password (mkSafePassword) +import Wire.API.Password (mkSafePasswordScrypt) import Wire.API.Routes.Public (ZHostValue) import Wire.API.Routes.Public.Galley.Messaging import Wire.API.Routes.Public.Util (UpdateResult (..)) @@ -569,7 +569,7 @@ addCode lusr mbZHost mZcon lcnv mReq = do Nothing -> do ttl <- realToFrac . unGuestLinkTTLSeconds . fromMaybe defGuestLinkTTLSeconds . view (settings . guestLinkTTLSeconds) <$> input code <- E.generateCode (tUnqualified lcnv) ReusableCode (Timeout ttl) - mPw <- for (mReq >>= (.password)) mkSafePassword + mPw <- for (mReq >>= (.password)) mkSafePasswordScrypt E.createCode code mPw now <- input let event = Event (tUntagged lcnv) Nothing (tUntagged lusr) now (EdConvCodeUpdate (mkConversationCodeInfo (isJust mPw) (codeKey code) (codeValue code) convUri)) diff --git a/tools/db/inconsistencies/default.nix b/tools/db/inconsistencies/default.nix index 2ad3a98e5eb..2f99a6c37ed 100644 --- a/tools/db/inconsistencies/default.nix +++ b/tools/db/inconsistencies/default.nix @@ -20,6 +20,7 @@ , types-common , unliftio , wire-api +, wire-subsystems }: mkDerivation { pname = "inconsistencies"; @@ -43,6 +44,7 @@ mkDerivation { types-common unliftio wire-api + wire-subsystems ]; description = "Find handles which belong to deleted users"; license = lib.licenses.agpl3Only; diff --git a/tools/db/inconsistencies/inconsistencies.cabal b/tools/db/inconsistencies/inconsistencies.cabal index 0c0a76d1a4d..cb12446f727 100644 --- a/tools/db/inconsistencies/inconsistencies.cabal +++ b/tools/db/inconsistencies/inconsistencies.cabal @@ -84,5 +84,6 @@ executable inconsistencies , types-common , unliftio , wire-api + , wire-subsystems default-language: GHC2021 diff --git a/tools/db/inconsistencies/src/DanglingUserKeys.hs b/tools/db/inconsistencies/src/DanglingUserKeys.hs index 12c9b09ea75..6812ac66293 100644 --- a/tools/db/inconsistencies/src/DanglingUserKeys.hs +++ b/tools/db/inconsistencies/src/DanglingUserKeys.hs @@ -22,9 +22,6 @@ module DanglingUserKeys where -import Brig.Data.UserKey -import Brig.Email (EmailKey (..), mkEmailKey) -import Brig.Phone (PhoneKey (..), mkPhoneKey) import Cassandra import Cassandra.Util import Conduit @@ -40,6 +37,7 @@ import System.Logger import System.Logger qualified as Log import UnliftIO.Async import Wire.API.User hiding (userEmail, userPhone) +import Wire.UserKeyStore runCommand :: Logger -> ClientState -> FilePath -> IO () runCommand l brig inconsistenciesFile = do diff --git a/tools/db/inconsistencies/src/EmailLessUsers.hs b/tools/db/inconsistencies/src/EmailLessUsers.hs index 68f2fb25fd4..1fba919d813 100644 --- a/tools/db/inconsistencies/src/EmailLessUsers.hs +++ b/tools/db/inconsistencies/src/EmailLessUsers.hs @@ -21,7 +21,6 @@ module EmailLessUsers where -import Brig.Data.UserKey import Brig.Email import Cassandra import Cassandra.Util @@ -40,6 +39,7 @@ import System.Logger import System.Logger qualified as Log import UnliftIO.Async import Wire.API.User hiding (userEmail) +import Wire.UserKeyStore runCommand :: Logger -> ClientState -> FilePath -> IO () runCommand l brig inconsistenciesFile = do From 16161c6bc307fe0e6a6b8c040cc96f68c1d9b04e Mon Sep 17 00:00:00 2001 From: Leif Battermann Date: Tue, 2 Jul 2024 14:31:03 +0200 Subject: [PATCH 53/64] Introduce EmailSmsSubsystem, use it for a few emails and password reset SMS (#4111) Emails related to user account are being sent using the new subsystem. Password Reset SMS is also being sent using it, however the SMS sending is still part of brig. This code is to be deleted soon, hence it doesn't make sense to move it to wire-subsystems. Co-authored-by: Matthias Fischmann Co-authored-by: Akshay Mankar --- .../5-internal/WPB-9831-email-subsystem | 1 + libs/wire-api/default.nix | 2 - .../wire-api/src/Wire/API/Conversation/Bot.hs | 3 +- libs/wire-api/src/Wire/API/Locale.hs | 231 +++++++++ .../src/Wire/API/Provider/External.hs | 3 +- libs/wire-api/src/Wire/API/Team/Invitation.hs | 3 +- libs/wire-api/src/Wire/API/User.hs | 2 + libs/wire-api/src/Wire/API/User/Activation.hs | 2 +- libs/wire-api/src/Wire/API/User/Profile.hs | 114 +---- libs/wire-api/src/Wire/API/User/Scim.hs | 1 + libs/wire-api/src/Wire/API/UserEvent.hs | 1 + .../Generated/InvitationRequest_team.hs | 8 +- .../Generated/NewBotRequest_provider.hs | 4 +- .../unit/Test/Wire/API/Roundtrip/Aeson.hs | 3 +- libs/wire-api/wire-api.cabal | 20 +- libs/wire-subsystems/default.nix | 28 +- libs/wire-subsystems/src/Wire/AWS.hs | 31 ++ .../src/Wire/AuthenticationSubsystem.hs | 3 +- .../AuthenticationSubsystem/Interpreter.hs | 33 +- libs/wire-subsystems/src/Wire/EmailSending.hs | 11 + .../src/Wire/EmailSending/SES.hs | 70 +++ .../src/Wire/EmailSending}/SMTP.hs | 37 +- .../src/Wire/EmailSmsSubsystem.hs | 26 ++ .../src/Wire/EmailSmsSubsystem/Interpreter.hs | 393 ++++++++++++++++ .../src/Wire/EmailSmsSubsystem/Template.hs | 204 ++++++++ libs/wire-subsystems/src/Wire/StoredUser.hs | 1 + libs/wire-subsystems/src/Wire/UserStore.hs | 1 + .../src/Wire/UserStore/Cassandra.hs | 8 + .../wire-subsystems/src/Wire/UserSubsystem.hs | 2 + .../src/Wire/UserSubsystem/Interpreter.hs | 7 + .../InterpreterSpec.hs | 30 +- .../test/unit/Wire/MockInterpreters.hs | 1 + .../MockInterpreters/EmailSmsSubsystem.hs | 25 + .../unit/Wire/MockInterpreters/UserStore.hs | 27 +- libs/wire-subsystems/wire-subsystems.cabal | 23 +- services/brig/brig.cabal | 8 - services/brig/default.nix | 8 - services/brig/src/Brig/API/Auth.hs | 14 +- services/brig/src/Brig/API/Client.hs | 10 +- services/brig/src/Brig/API/Handler.hs | 2 +- services/brig/src/Brig/API/Internal.hs | 21 +- services/brig/src/Brig/API/Public.hs | 56 ++- services/brig/src/Brig/API/User.hs | 32 +- services/brig/src/Brig/AWS.hs | 68 +-- services/brig/src/Brig/App.hs | 8 +- .../brig/src/Brig/CanonicalInterpreter.hs | 34 ++ services/brig/src/Brig/Code.hs | 3 +- services/brig/src/Brig/Data/User.hs | 9 - services/brig/src/Brig/Email.hs | 72 --- services/brig/src/Brig/Locale.hs | 115 ----- services/brig/src/Brig/Options.hs | 2 +- services/brig/src/Brig/Phone.hs | 2 +- services/brig/src/Brig/Provider/API.hs | 13 +- services/brig/src/Brig/Provider/DB.hs | 2 +- services/brig/src/Brig/Provider/Email.hs | 23 +- services/brig/src/Brig/Provider/Template.hs | 21 +- services/brig/src/Brig/Team/API.hs | 18 +- services/brig/src/Brig/Team/DB.hs | 2 +- services/brig/src/Brig/Team/Email.hs | 19 +- services/brig/src/Brig/Team/Template.hs | 2 - services/brig/src/Brig/Template.hs | 54 +-- services/brig/src/Brig/User/Auth.hs | 8 +- services/brig/src/Brig/User/Email.hs | 438 ------------------ services/brig/src/Brig/User/Phone.hs | 6 +- services/brig/src/Brig/User/Template.hs | 115 +---- services/brig/test/integration/SMTP.hs | 19 +- services/spar/src/Spar/Intra/Brig.hs | 1 + services/spar/src/Spar/Sem/BrigAccess.hs | 1 + tools/db/inconsistencies/default.nix | 2 - .../db/inconsistencies/inconsistencies.cabal | 1 - .../db/inconsistencies/src/EmailLessUsers.hs | 1 - 71 files changed, 1375 insertions(+), 1194 deletions(-) create mode 100644 changelog.d/5-internal/WPB-9831-email-subsystem create mode 100644 libs/wire-api/src/Wire/API/Locale.hs create mode 100644 libs/wire-subsystems/src/Wire/AWS.hs create mode 100644 libs/wire-subsystems/src/Wire/EmailSending.hs create mode 100644 libs/wire-subsystems/src/Wire/EmailSending/SES.hs rename {services/brig/src/Brig => libs/wire-subsystems/src/Wire/EmailSending}/SMTP.hs (90%) create mode 100644 libs/wire-subsystems/src/Wire/EmailSmsSubsystem.hs create mode 100644 libs/wire-subsystems/src/Wire/EmailSmsSubsystem/Interpreter.hs create mode 100644 libs/wire-subsystems/src/Wire/EmailSmsSubsystem/Template.hs create mode 100644 libs/wire-subsystems/test/unit/Wire/MockInterpreters/EmailSmsSubsystem.hs delete mode 100644 services/brig/src/Brig/Email.hs delete mode 100644 services/brig/src/Brig/Locale.hs delete mode 100644 services/brig/src/Brig/User/Email.hs diff --git a/changelog.d/5-internal/WPB-9831-email-subsystem b/changelog.d/5-internal/WPB-9831-email-subsystem new file mode 100644 index 00000000000..eb14a50e4ac --- /dev/null +++ b/changelog.d/5-internal/WPB-9831-email-subsystem @@ -0,0 +1 @@ +Introduce email subsystem diff --git a/libs/wire-api/default.nix b/libs/wire-api/default.nix index 8996b4081db..ce55894b212 100644 --- a/libs/wire-api/default.nix +++ b/libs/wire-api/default.nix @@ -121,7 +121,6 @@ mkDerivation { libraryHaskellDepends = [ aeson asn1-encoding - async attoparsec base base64-bytestring @@ -247,7 +246,6 @@ mkDerivation { proto-lens QuickCheck random - saml2-web-sso schema-profunctor servant servant-server diff --git a/libs/wire-api/src/Wire/API/Conversation/Bot.hs b/libs/wire-api/src/Wire/API/Conversation/Bot.hs index f46a83869d4..aea518cfc92 100644 --- a/libs/wire-api/src/Wire/API/Conversation/Bot.hs +++ b/libs/wire-api/src/Wire/API/Conversation/Bot.hs @@ -32,8 +32,9 @@ import Data.OpenApi qualified as S import Data.Schema import Imports import Wire.API.Event.Conversation (Event) +import Wire.API.Locale (Locale) import Wire.API.User.Client.Prekey (Prekey) -import Wire.API.User.Profile (Asset, ColourId, Locale, Name) +import Wire.API.User.Profile (Asset, ColourId, Name) import Wire.Arbitrary (Arbitrary, GenericUniform (..)) -------------------------------------------------------------------------------- diff --git a/libs/wire-api/src/Wire/API/Locale.hs b/libs/wire-api/src/Wire/API/Locale.hs new file mode 100644 index 00000000000..576c7eeeb10 --- /dev/null +++ b/libs/wire-api/src/Wire/API/Locale.hs @@ -0,0 +1,231 @@ +-- This file is part of the Wire Server implementation. +-- +-- Copyright (C) 2022 Wire Swiss GmbH +-- +-- This program is free software: you can redistribute it and/or modify it under +-- the terms of the GNU Affero General Public License as published by the Free +-- Software Foundation, either version 3 of the License, or (at your option) any +-- later version. +-- +-- This program is distributed in the hope that it will be useful, but WITHOUT +-- ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS +-- FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for more +-- details. +-- +-- You should have received a copy of the GNU Affero General Public License along +-- with this program. If not, see . + +module Wire.API.Locale + ( Locale (..), + Language (..), + Country (..), + timeLocale, + formatDateTime, + deDe, + frFr, + locToText, + parseLocale, + lan2Text, + parseLanguage, + con2Text, + parseCountry, + ) +where + +import Cassandra as C +import Control.Applicative (optional) +import Control.Error.Util (hush, note) +import Data.Aeson (FromJSON, ToJSON) +import Data.Attoparsec.Text +import Data.ISO3166_CountryCodes (CountryCode) +import Data.LanguageCodes (ISO639_1 (DE, FR)) +import Data.OpenApi qualified as S +import Data.Schema +import Data.Text qualified as Text +import Data.Time.Clock (UTCTime) +import Data.Time.Format +import Data.Time.LocalTime (TimeZone (..), utc) +import Imports +import Test.QuickCheck +import Wire.API.User.Orphans () +import Wire.Arbitrary + +timeLocale :: Locale -> TimeLocale +timeLocale (Locale (Language DE) _) = deDe +timeLocale (Locale (Language FR) _) = frFr +timeLocale _ = defaultTimeLocale + +formatDateTime :: String -> TimeLocale -> UTCTime -> Text +formatDateTime s l = fromString . formatTime l s + +deDe :: TimeLocale +deDe = + TimeLocale + { wDays = + [ ("Sonntag", "Son"), + ("Montag", "Mon"), + ("Dienstag", "Die"), + ("Mittwoch", "Mit"), + ("Donnerstag", "Don"), + ("Freitag", "Fre"), + ("Samstag", "Sam") + ], + months = + [ ("Januar", "Jan"), + ("Februar", "Feb"), + ("März", "Mär"), + ("April", "Apr"), + ("Mai", "Mai"), + ("Juni", "Jun"), + ("Juli", "Jul"), + ("August", "Aug"), + ("September", "Sep"), + ("Oktober", "Okt"), + ("November", "Nov"), + ("Dezember", "Dez") + ], + amPm = ("", ""), + dateTimeFmt = "%d. %B %Y %H:%M:%S %Z", + dateFmt = "%d.%m.%Y", + timeFmt = "%H:%M:%S", + time12Fmt = "%H:%M:%S", + knownTimeZones = + [ utc, + TimeZone 60 False "MEZ", + TimeZone 120 True "MESZ" + ] + } + +frFr :: TimeLocale +frFr = + TimeLocale + { wDays = + [ ("dimanche", "dim"), + ("lundi", "lun"), + ("mardi", "mar"), + ("mercredi", "mer"), + ("jeudi", "jeu"), + ("vendredi", "ven"), + ("samedi", "sam") + ], + months = + [ ("janvier", "jan"), + ("février", "fév"), + ("mars", "mar"), + ("avril", "avr"), + ("mai", "mai"), + ("juin", "jun"), + ("juillet", "jul"), + ("août", "aoû"), + ("septembre", "sep"), + ("octobre", "oct"), + ("novembre", "nov"), + ("décembre", "déc") + ], + amPm = ("", ""), + dateTimeFmt = "%d %B %Y %H h %M %Z", + dateFmt = "%d/%m/%Y", + timeFmt = "%H h %M", + time12Fmt = "%H h %M", + knownTimeZones = + [ utc, + TimeZone 60 False "HNEC", + TimeZone 120 True "HAEC" + ] + } + +-------------------------------------------------------------------------------- +-- Locale + +data Locale = Locale + { lLanguage :: Language, + lCountry :: Maybe Country + } + deriving stock (Eq, Ord, Generic) + deriving (Arbitrary) via (GenericUniform Locale) + deriving (FromJSON, ToJSON, S.ToSchema) via Schema Locale + +instance ToSchema Locale where + schema = locToText .= parsedText "Locale" (note err . parseLocale) + where + err = "Invalid locale. Expected (-)? format" + +instance Show Locale where + show = Text.unpack . locToText + +locToText :: Locale -> Text +locToText (Locale l c) = lan2Text l <> foldMap (("-" <>) . con2Text) c + +parseLocale :: Text -> Maybe Locale +parseLocale = hush . parseOnly localeParser + where + localeParser :: Parser Locale + localeParser = + Locale + <$> (languageParser "Language code") + <*> (optional (char '-' *> countryParser) "Country code") + +-------------------------------------------------------------------------------- +-- Language + +newtype Language = Language {fromLanguage :: ISO639_1} + deriving stock (Eq, Ord, Show, Generic) + deriving newtype (Arbitrary, S.ToSchema) + +instance C.Cql Language where + ctype = C.Tagged C.AsciiColumn + toCql = C.toCql . lan2Text + + fromCql (C.CqlAscii l) = case parseLanguage l of + Just l' -> pure l' + Nothing -> Left "Language: ISO 639-1 expected." + fromCql _ = Left "Language: ASCII expected" + +languageParser :: Parser Language +languageParser = codeParser "language" $ fmap Language . checkAndConvert isLower + +lan2Text :: Language -> Text +lan2Text = Text.toLower . Text.pack . show . fromLanguage + +parseLanguage :: Text -> Maybe Language +parseLanguage = hush . parseOnly languageParser + +-------------------------------------------------------------------------------- +-- Country + +newtype Country = Country {fromCountry :: CountryCode} + deriving stock (Eq, Ord, Show, Generic) + deriving newtype (Arbitrary, S.ToSchema) + +instance C.Cql Country where + ctype = C.Tagged C.AsciiColumn + toCql = C.toCql . con2Text + + fromCql (C.CqlAscii c) = case parseCountry c of + Just c' -> pure c' + Nothing -> Left "Country: ISO 3166-1-alpha2 expected." + fromCql _ = Left "Country: ASCII expected" + +countryParser :: Parser Country +countryParser = codeParser "country" $ fmap Country . checkAndConvert isUpper + +con2Text :: Country -> Text +con2Text = Text.pack . show . fromCountry + +parseCountry :: Text -> Maybe Country +parseCountry = hush . parseOnly countryParser + +-------------------------------------------------------------------------------- +-- helpers + +-- Common language / country functions +checkAndConvert :: (Read a) => (Char -> Bool) -> String -> Maybe a +checkAndConvert f t = + if all f t + then readMaybe (map toUpper t) + else fail "Format not supported." + +codeParser :: String -> (String -> Maybe a) -> Parser a +codeParser err conv = do + code <- count 2 anyChar + maybe (fail err) pure (conv code) diff --git a/libs/wire-api/src/Wire/API/Provider/External.hs b/libs/wire-api/src/Wire/API/Provider/External.hs index 402812f1285..aebbd8f38e3 100644 --- a/libs/wire-api/src/Wire/API/Provider/External.hs +++ b/libs/wire-api/src/Wire/API/Provider/External.hs @@ -27,9 +27,10 @@ import Data.Aeson import Data.Id import Data.Json.Util ((#)) import Imports +import Wire.API.Locale (Locale) import Wire.API.Provider.Bot (BotConvView, BotUserView) import Wire.API.User.Client.Prekey (LastPrekey, Prekey) -import Wire.API.User.Profile (Asset, ColourId, Locale, Name) +import Wire.API.User.Profile (Asset, ColourId, Name) import Wire.Arbitrary (Arbitrary, GenericUniform (..)) -------------------------------------------------------------------------------- diff --git a/libs/wire-api/src/Wire/API/Team/Invitation.hs b/libs/wire-api/src/Wire/API/Team/Invitation.hs index 44cc508ab69..c51492dc19c 100644 --- a/libs/wire-api/src/Wire/API/Team/Invitation.hs +++ b/libs/wire-api/src/Wire/API/Team/Invitation.hs @@ -41,10 +41,11 @@ import Servant (FromHttpApiData (..), ToHttpApiData (..)) import URI.ByteString import Wire.API.Error import Wire.API.Error.Brig +import Wire.API.Locale (Locale) import Wire.API.Routes.MultiVerb import Wire.API.Team.Role (Role, defaultRole) import Wire.API.User.Identity (Email, Phone) -import Wire.API.User.Profile (Locale, Name) +import Wire.API.User.Profile (Name) import Wire.Arbitrary (Arbitrary, GenericUniform (..)) -------------------------------------------------------------------------------- diff --git a/libs/wire-api/src/Wire/API/User.hs b/libs/wire-api/src/Wire/API/User.hs index ce26cfb4eca..997e52e04a1 100644 --- a/libs/wire-api/src/Wire/API/User.hs +++ b/libs/wire-api/src/Wire/API/User.hs @@ -143,6 +143,7 @@ module Wire.API.User EmailVisibilityConfigWithViewer, -- * re-exports + module Wire.API.Locale, module Wire.API.User.Identity, module Wire.API.User.Profile, @@ -214,6 +215,7 @@ import Wire.API.Conversation.Protocol import Wire.API.Error import Wire.API.Error.Brig import Wire.API.Error.Brig qualified as E +import Wire.API.Locale import Wire.API.Provider.Service (ServiceRef) import Wire.API.Routes.MultiVerb import Wire.API.Team (BindingNewTeam, bindingNewTeamObjectSchema) diff --git a/libs/wire-api/src/Wire/API/User/Activation.hs b/libs/wire-api/src/Wire/API/User/Activation.hs index 8998854b2e2..6fd9e2d8f30 100644 --- a/libs/wire-api/src/Wire/API/User/Activation.hs +++ b/libs/wire-api/src/Wire/API/User/Activation.hs @@ -48,8 +48,8 @@ import Data.Text.Ascii import Data.Tuple.Extra (fst3, snd3, thd3) import Imports import Servant (FromHttpApiData (..)) +import Wire.API.Locale import Wire.API.User.Identity -import Wire.API.User.Profile import Wire.Arbitrary (Arbitrary, GenericUniform (..)) -------------------------------------------------------------------------------- diff --git a/libs/wire-api/src/Wire/API/User/Profile.hs b/libs/wire-api/src/Wire/API/User/Profile.hs index a946c6249aa..022c0cc50cf 100644 --- a/libs/wire-api/src/Wire/API/User/Profile.hs +++ b/libs/wire-api/src/Wire/API/User/Profile.hs @@ -28,17 +28,6 @@ module Wire.API.User.Profile Asset (..), AssetSize (..), - -- * Locale - Locale (..), - locToText, - parseLocale, - Language (..), - lan2Text, - parseLanguage, - Country (..), - con2Text, - parseCountry, - -- * ManagedBy ManagedBy (..), defaultManagedBy, @@ -50,19 +39,14 @@ module Wire.API.User.Profile where import Cassandra qualified as C -import Control.Applicative (optional) -import Control.Error (hush, note) +import Control.Error (note) import Data.Aeson (FromJSON (..), ToJSON (..)) import Data.Aeson qualified as A import Data.Attoparsec.ByteString.Char8 (takeByteString) -import Data.Attoparsec.Text import Data.ByteString.Conversion -import Data.ISO3166_CountryCodes -import Data.LanguageCodes import Data.OpenApi qualified as S import Data.Range import Data.Schema -import Data.Text qualified as Text import Imports import Wire.API.Asset (AssetKey (..)) import Wire.API.User.Orphans () @@ -188,87 +172,6 @@ instance C.Cql AssetSize where toCql AssetPreview = C.CqlInt 0 toCql AssetComplete = C.CqlInt 1 --------------------------------------------------------------------------------- --- Locale - -data Locale = Locale - { lLanguage :: Language, - lCountry :: Maybe Country - } - deriving stock (Eq, Ord, Generic) - deriving (Arbitrary) via (GenericUniform Locale) - deriving (FromJSON, ToJSON, S.ToSchema) via Schema Locale - -instance ToSchema Locale where - schema = locToText .= parsedText "Locale" (note err . parseLocale) - where - err = "Invalid locale. Expected (-)? format" - -instance Show Locale where - show = Text.unpack . locToText - -locToText :: Locale -> Text -locToText (Locale l c) = lan2Text l <> foldMap (("-" <>) . con2Text) c - -parseLocale :: Text -> Maybe Locale -parseLocale = hush . parseOnly localeParser - where - localeParser :: Parser Locale - localeParser = - Locale - <$> (languageParser "Language code") - <*> (optional (char '-' *> countryParser) "Country code") - --------------------------------------------------------------------------------- --- Language - -newtype Language = Language {fromLanguage :: ISO639_1} - deriving stock (Eq, Ord, Show, Generic) - deriving newtype (Arbitrary, S.ToSchema) - -instance C.Cql Language where - ctype = C.Tagged C.AsciiColumn - toCql = C.toCql . lan2Text - - fromCql (C.CqlAscii l) = case parseLanguage l of - Just l' -> pure l' - Nothing -> Left "Language: ISO 639-1 expected." - fromCql _ = Left "Language: ASCII expected" - -languageParser :: Parser Language -languageParser = codeParser "language" $ fmap Language . checkAndConvert isLower - -lan2Text :: Language -> Text -lan2Text = Text.toLower . Text.pack . show . fromLanguage - -parseLanguage :: Text -> Maybe Language -parseLanguage = hush . parseOnly languageParser - --------------------------------------------------------------------------------- --- Country - -newtype Country = Country {fromCountry :: CountryCode} - deriving stock (Eq, Ord, Show, Generic) - deriving newtype (Arbitrary, S.ToSchema) - -instance C.Cql Country where - ctype = C.Tagged C.AsciiColumn - toCql = C.toCql . con2Text - - fromCql (C.CqlAscii c) = case parseCountry c of - Just c' -> pure c' - Nothing -> Left "Country: ISO 3166-1-alpha2 expected." - fromCql _ = Left "Country: ASCII expected" - -countryParser :: Parser Country -countryParser = codeParser "country" $ fmap Country . checkAndConvert isUpper - -con2Text :: Country -> Text -con2Text = Text.pack . show . fromCountry - -parseCountry :: Text -> Maybe Country -parseCountry = hush . parseOnly countryParser - -------------------------------------------------------------------------------- -- ManagedBy @@ -357,18 +260,3 @@ instance C.Cql Pict where noPict :: Pict noPict = Pict [] - --------------------------------------------------------------------------------- --- helpers - --- Common language / country functions -checkAndConvert :: (Read a) => (Char -> Bool) -> String -> Maybe a -checkAndConvert f t = - if all f t - then readMaybe (map toUpper t) - else fail "Format not supported." - -codeParser :: String -> (String -> Maybe a) -> Parser a -codeParser err conv = do - code <- count 2 anyChar - maybe (fail err) pure (conv code) diff --git a/libs/wire-api/src/Wire/API/User/Scim.hs b/libs/wire-api/src/Wire/API/User/Scim.hs index eebfe13621c..e27bfcb26d2 100644 --- a/libs/wire-api/src/Wire/API/User/Scim.hs +++ b/libs/wire-api/src/Wire/API/User/Scim.hs @@ -83,6 +83,7 @@ import Web.Scim.Schema.Schema (Schema (CustomSchema)) import Web.Scim.Schema.Schema qualified as Scim import Web.Scim.Schema.User qualified as Scim import Web.Scim.Schema.User qualified as Scim.User +import Wire.API.Locale import Wire.API.Team.Role (Role) import Wire.API.User (emailFromSAMLNameID, urefToExternalIdUnsafe) import Wire.API.User.Identity (Email, fromEmail) diff --git a/libs/wire-api/src/Wire/API/UserEvent.hs b/libs/wire-api/src/Wire/API/UserEvent.hs index 59e5ff91502..ffcf9166be4 100644 --- a/libs/wire-api/src/Wire/API/UserEvent.hs +++ b/libs/wire-api/src/Wire/API/UserEvent.hs @@ -32,6 +32,7 @@ import Data.Schema import Imports import System.Logger.Message hiding (field, (.=)) import Wire.API.Connection +import Wire.API.Locale import Wire.API.Properties import Wire.API.Routes.Version import Wire.API.User diff --git a/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated/InvitationRequest_team.hs b/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated/InvitationRequest_team.hs index ae61c5089ae..c76edfc41a2 100644 --- a/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated/InvitationRequest_team.hs +++ b/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated/InvitationRequest_team.hs @@ -20,15 +20,11 @@ module Test.Wire.API.Golden.Generated.InvitationRequest_team where import Data.ISO3166_CountryCodes (CountryCode (BJ, FJ, GH, LB, ME, NL, OM, PA, TC, TZ)) import Data.LanguageCodes qualified (ISO639_1 (AF, AR, DA, DV, KJ, KS, KU, LG, NN, NY, OM, SI)) import Imports (Maybe (Just, Nothing)) +import Wire.API.Locale import Wire.API.Team.Invitation (InvitationRequest (..)) import Wire.API.Team.Role (Role (RoleAdmin, RoleExternalPartner, RoleMember, RoleOwner)) import Wire.API.User.Identity (Email (Email, emailDomain, emailLocal), Phone (Phone, fromPhone)) -import Wire.API.User.Profile - ( Country (Country, fromCountry), - Language (Language), - Locale (Locale, lCountry, lLanguage), - Name (Name, fromName), - ) +import Wire.API.User.Profile (Name (Name, fromName)) testObject_InvitationRequest_team_1 :: InvitationRequest testObject_InvitationRequest_team_1 = diff --git a/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated/NewBotRequest_provider.hs b/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated/NewBotRequest_provider.hs index 77bb41b00b8..2c98a252b64 100644 --- a/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated/NewBotRequest_provider.hs +++ b/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated/NewBotRequest_provider.hs @@ -71,6 +71,7 @@ import Data.UUID qualified as UUID (fromString) import Imports (Maybe (Just, Nothing), fromJust, (.)) import Wire.API.Conversation.Member import Wire.API.Conversation.Role (parseRoleName) +import Wire.API.Locale import Wire.API.Provider.Bot ( BotUserView ( BotUserView, @@ -86,9 +87,6 @@ import Wire.API.Provider.External (NewBotRequest (..)) import Wire.API.Provider.Service (ServiceRef (ServiceRef, _serviceRefId, _serviceRefProvider)) import Wire.API.User.Profile ( ColourId (ColourId, fromColourId), - Country (Country, fromCountry), - Language (Language), - Locale (Locale, lCountry, lLanguage), Name (Name, fromName), ) diff --git a/libs/wire-api/test/unit/Test/Wire/API/Roundtrip/Aeson.hs b/libs/wire-api/test/unit/Test/Wire/API/Roundtrip/Aeson.hs index 5e464d36dec..bec9d3c96f1 100644 --- a/libs/wire-api/test/unit/Test/Wire/API/Roundtrip/Aeson.hs +++ b/libs/wire-api/test/unit/Test/Wire/API/Roundtrip/Aeson.hs @@ -39,6 +39,7 @@ import Wire.API.CustomBackend qualified as CustomBackend import Wire.API.Event.Conversation qualified as Event.Conversation import Wire.API.Event.Team qualified as Event.Team import Wire.API.FederationStatus qualified as FederationStatus +import Wire.API.Locale qualified as Locale import Wire.API.Message qualified as Message import Wire.API.OAuth qualified as OAuth import Wire.API.Properties qualified as Properties @@ -151,6 +152,7 @@ tests = testRoundTrip @FederationDomainConfig.FederationStrategy, testRoundTrip @FederationStatus.FederationStatus, testRoundTrip @FederationStatus.RemoteDomains, + testRoundTrip @Locale.Locale, testRoundTrip @Message.Priority, testRoundTrip @Message.OtrRecipients, testRoundTrip @Message.NewOtrMessage, @@ -325,7 +327,6 @@ tests = testRoundTrip @User.Profile.ColourId, testRoundTrip @User.Profile.AssetSize, testRoundTrip @User.Profile.Asset, - testRoundTrip @User.Profile.Locale, testRoundTrip @User.Profile.ManagedBy, testRoundTrip @User.RichInfo.RichField, testRoundTrip @User.RichInfo.RichInfoAssocList, diff --git a/libs/wire-api/wire-api.cabal b/libs/wire-api/wire-api.cabal index 69e4c6ead1a..5c37e1dbca2 100644 --- a/libs/wire-api/wire-api.cabal +++ b/libs/wire-api/wire-api.cabal @@ -15,7 +15,7 @@ common common-all ghc-options: -O2 -Wall -Wincomplete-uni-patterns -Wincomplete-record-updates -Wpartial-fields -fwarn-tabs -optP-Wno-nonportable-include-path - -Wredundant-constraints + -Wredundant-constraints -Wunused-packages default-extensions: AllowAmbiguousTypes @@ -103,6 +103,7 @@ library Wire.API.FederationUpdate Wire.API.Internal.BulkPush Wire.API.Internal.Notification + Wire.API.Locale Wire.API.MakesFederatedCall Wire.API.Message Wire.API.Message.Proto @@ -249,7 +250,6 @@ library build-depends: , aeson >=2.0.1.0 , asn1-encoding - , async , attoparsec >=0.10 , base >=4 && <5 , base64-bytestring >=1.0 @@ -605,7 +605,7 @@ test-suite wire-api-golden-tests Test.Wire.API.Golden.Run Test.Wire.API.Golden.Runner - ghc-options: -threaded -with-rtsopts=-N + ghc-options: -threaded -with-rtsopts=-N -Wunused-packages hs-source-dirs: test/golden build-depends: , aeson >=2.0.1.0 @@ -615,7 +615,6 @@ test-suite wire-api-golden-tests , bytestring , bytestring-conversion , containers >=0.5 - , crypton , currency-codes , either , imports @@ -672,18 +671,17 @@ test-suite wire-api-tests hs-source-dirs: test/unit build-depends: - , aeson >=2.0.1.0 + , aeson >=2.0.1.0 , aeson-qq , async , base , binary , bytestring - , bytestring-arbitrary >=0.1.3 + , bytestring-arbitrary >=0.1.3 , bytestring-conversion , cassava - , containers >=0.5 + , containers >=0.5 , crypton - , either , filepath , hex , hspec @@ -697,7 +695,6 @@ test-suite wire-api-tests , process , QuickCheck , random - , saml2-web-sso , schema-profunctor , servant , servant-server @@ -707,13 +704,12 @@ test-suite wire-api-tests , tasty-hunit , tasty-quickcheck , text - , types-common >=0.16 + , types-common >=0.16 , unliftio , uuid , vector , wai , wire-api - , wire-message-proto-lens - ghc-options: -threaded -with-rtsopts=-N + ghc-options: -threaded -with-rtsopts=-N -Wunused-packages default-language: GHC2021 diff --git a/libs/wire-subsystems/default.nix b/libs/wire-subsystems/default.nix index c6c2c5a6f8b..2e3a1eb36db 100644 --- a/libs/wire-subsystems/default.nix +++ b/libs/wire-subsystems/default.nix @@ -6,7 +6,7 @@ , aeson , amazonka , amazonka-core -, amazonka-sqs +, amazonka-ses , async , base , base16-bytestring @@ -26,9 +26,12 @@ , extra , gitignoreSource , gundeck-types +, HaskellNet +, HaskellNet-SSL , HsOpenSSL , hspec , hspec-discover +, html-entities , http-client , http-types , http2-manager @@ -38,21 +41,29 @@ , lib , mime , mime-mail +, network , network-conduit-tls +, pipes , polysemy , polysemy-plugin , polysemy-time , polysemy-wire-zoo +, postie , QuickCheck , quickcheck-instances +, resource-pool , resourcet , retry , servant , servant-client-core , stomp-queue +, streaming-commons , string-conversions +, template , text , time +, time-out +, time-units , tinylog , transformers , transitive-anns @@ -72,7 +83,7 @@ mkDerivation { aeson amazonka amazonka-core - amazonka-sqs + amazonka-ses async base base16-bytestring @@ -90,8 +101,11 @@ mkDerivation { extended extra gundeck-types + HaskellNet + HaskellNet-SSL HsOpenSSL hspec + html-entities http-client http-types http2-manager @@ -100,19 +114,24 @@ mkDerivation { lens mime mime-mail + network network-conduit-tls polysemy polysemy-plugin polysemy-time polysemy-wire-zoo QuickCheck + resource-pool resourcet retry servant servant-client-core stomp-queue + template text time + time-out + time-units tinylog transformers transitive-anns @@ -140,13 +159,18 @@ mkDerivation { imports iso639 lens + mime-mail + network + pipes polysemy polysemy-plugin polysemy-time polysemy-wire-zoo + postie QuickCheck quickcheck-instances servant-client-core + streaming-commons string-conversions text time diff --git a/libs/wire-subsystems/src/Wire/AWS.hs b/libs/wire-subsystems/src/Wire/AWS.hs new file mode 100644 index 00000000000..b462db9a6cc --- /dev/null +++ b/libs/wire-subsystems/src/Wire/AWS.hs @@ -0,0 +1,31 @@ +module Wire.AWS where + +import Amazonka (Env, runResourceT) +import Amazonka.Core.Lens.Internal qualified as AWS +import Amazonka.Send as AWS +import Amazonka.Types qualified as AWS +import Control.Lens +import Imports +import Network.HTTP.Client +import Polysemy +import Polysemy.Input + +sendCatch :: + ( Member (Input Amazonka.Env) r, + Member (Embed IO) r, + AWS.AWSRequest req, + Typeable req, + Typeable (AWS.AWSResponse req) + ) => + req -> + Sem r (Either AWS.Error (AWS.AWSResponse req)) +sendCatch req = do + env <- input + embed . AWS.trying AWS._Error . runResourceT . AWS.send env $ req + +canRetry :: Either AWS.Error a -> Bool +canRetry (Right _) = False +canRetry (Left e) = case e of + AWS.TransportError (HttpExceptionRequest _ ResponseTimeout) -> True + AWS.ServiceError se | se ^. AWS.serviceError_code == AWS.ErrorCode "RequestThrottled" -> True + _ -> False diff --git a/libs/wire-subsystems/src/Wire/AuthenticationSubsystem.hs b/libs/wire-subsystems/src/Wire/AuthenticationSubsystem.hs index 57cae3087d9..415982b984c 100644 --- a/libs/wire-subsystems/src/Wire/AuthenticationSubsystem.hs +++ b/libs/wire-subsystems/src/Wire/AuthenticationSubsystem.hs @@ -18,7 +18,6 @@ module Wire.AuthenticationSubsystem where -import Data.Id import Data.Misc import Imports import Polysemy @@ -27,7 +26,7 @@ import Wire.API.User.Password import Wire.UserKeyStore data AuthenticationSubsystem m a where - CreatePasswordResetCode :: UserKey -> AuthenticationSubsystem m (UserId, PasswordResetPair) + CreatePasswordResetCode :: UserKey -> AuthenticationSubsystem m () ResetPassword :: PasswordResetIdentity -> PasswordResetCode -> PlainTextPassword8 -> AuthenticationSubsystem m () -- For testing InternalLookupPasswordResetCode :: UserKey -> AuthenticationSubsystem m (Maybe PasswordResetPair) diff --git a/libs/wire-subsystems/src/Wire/AuthenticationSubsystem/Interpreter.hs b/libs/wire-subsystems/src/Wire/AuthenticationSubsystem/Interpreter.hs index f2a344e13a6..f71355610ad 100644 --- a/libs/wire-subsystems/src/Wire/AuthenticationSubsystem/Interpreter.hs +++ b/libs/wire-subsystems/src/Wire/AuthenticationSubsystem/Interpreter.hs @@ -41,6 +41,7 @@ import Wire.API.User import Wire.API.User.Password import Wire.AuthenticationSubsystem import Wire.AuthenticationSubsystem.Error +import Wire.EmailSmsSubsystem import Wire.HashPassword import Wire.PasswordResetCodeStore import Wire.PasswordStore @@ -62,7 +63,8 @@ interpretAuthenticationSubsystem :: Member (Input (Maybe AllowlistEmailDomains)) r, Member (Input (Maybe AllowlistPhonePrefixes)) r, Member UserSubsystem r, - Member PasswordStore r + Member PasswordStore r, + Member EmailSmsSubsystem r ) => InterpreterFor AuthenticationSubsystem r interpretAuthenticationSubsystem = interpret $ \case @@ -84,31 +86,40 @@ createPasswordResetCodeImpl :: Member (Input (Maybe AllowlistPhonePrefixes)) r, Member (Error AuthenticationSubsystemError) r, Member TinyLog r, - Member UserSubsystem r + Member UserSubsystem r, + Member EmailSmsSubsystem r ) => UserKey -> - Sem r (UserId, PasswordResetPair) + Sem r () createPasswordResetCodeImpl target = do allowListOk <- (\e p -> AllowLists.verify e p (toEither target)) <$> input <*> input unless allowListOk $ throw AuthenticationSubsystemAllowListError - user <- lookupActiveUserIdByUserKey target >>= maybe (throw AuthenticationSubsystemInvalidPasswordResetKey) pure - Log.debug $ field "user" (toByteString user) . field "action" (val "User.beginPasswordReset") + user <- lookupActiveUserByUserKey target >>= maybe (throw AuthenticationSubsystemInvalidPasswordResetKey) pure + let uid = userId user + Log.debug $ field "user" (toByteString uid) . field "action" (val "User.beginPasswordReset") - mExistingCode <- lookupPasswordResetCode user + mExistingCode <- lookupPasswordResetCode uid when (isJust mExistingCode) $ throw AuthenticationSubsystemPasswordResetInProgress - let key = mkPasswordResetKey user + let key = mkPasswordResetKey uid now <- Now.get code <- foldKey (const generateEmailCode) (const generatePhoneCode) target codeInsert key - (PRQueryData code user (Identity maxAttempts) (Identity (passwordResetCodeTtl `addUTCTime` now))) + (PRQueryData code uid (Identity maxAttempts) (Identity (passwordResetCodeTtl `addUTCTime` now))) (round passwordResetCodeTtl) - pure (user, (key, code)) + foldKey + (\email -> sendPasswordResetMail email (key, code) (Just user.userLocale)) + (\phone -> sendPasswordResetSms phone (key, code) (Just user.userLocale)) + target + pure () lookupActiveUserIdByUserKey :: (Member UserSubsystem r, Member (Input (Local ())) r) => UserKey -> Sem r (Maybe UserId) -lookupActiveUserIdByUserKey target = do +lookupActiveUserIdByUserKey target = userId <$$> lookupActiveUserByUserKey target + +lookupActiveUserByUserKey :: (Member UserSubsystem r, Member (Input (Local ())) r) => UserKey -> Sem r (Maybe User) +lookupActiveUserByUserKey target = do localUnit <- input let ltarget = qualifyAs localUnit target mUser <- getLocalUserAccountByUserKey ltarget @@ -116,7 +127,7 @@ lookupActiveUserIdByUserKey target = do Just user -> do pure $ if user.accountStatus == Active - then Just $ userId user.accountUser + then Just user.accountUser else Nothing Nothing -> pure Nothing diff --git a/libs/wire-subsystems/src/Wire/EmailSending.hs b/libs/wire-subsystems/src/Wire/EmailSending.hs new file mode 100644 index 00000000000..88b2a937646 --- /dev/null +++ b/libs/wire-subsystems/src/Wire/EmailSending.hs @@ -0,0 +1,11 @@ +{-# LANGUAGE TemplateHaskell #-} + +module Wire.EmailSending where + +import Network.Mail.Mime (Mail) +import Polysemy (makeSem) + +data EmailSending m r where + SendMail :: Mail -> EmailSending m () + +makeSem ''EmailSending diff --git a/libs/wire-subsystems/src/Wire/EmailSending/SES.hs b/libs/wire-subsystems/src/Wire/EmailSending/SES.hs new file mode 100644 index 00000000000..4c367da1b4c --- /dev/null +++ b/libs/wire-subsystems/src/Wire/EmailSending/SES.hs @@ -0,0 +1,70 @@ +module Wire.EmailSending.SES where + +import Amazonka (Env) +import Amazonka.Data.Text as AWS +import Amazonka.SES qualified as SES +import Amazonka.SES.Lens qualified as SES +import Amazonka.Types qualified as AWS +import Control.Lens +import Control.Monad.Catch +import Control.Retry +import Data.ByteString.Lazy qualified as BL +import Data.Text qualified as Text +import Imports +import Network.HTTP.Types +import Network.Mail.Mime (Mail, addressEmail, mailFrom, mailTo, renderMail') +import Polysemy +import Polysemy.Input +import Wire.AWS +import Wire.EmailSending + +emailViaSESInterpreter :: + (Member (Embed IO) r) => + Amazonka.Env -> + InterpreterFor EmailSending r +emailViaSESInterpreter env = + interpret $ + runInputConst env . \case + SendMail mail -> sendMailAWSImpl mail + +sendMailAWSImpl :: + ( Member (Input Amazonka.Env) r, + Member (Embed IO) r + ) => + Mail -> + Sem r () +sendMailAWSImpl m = do + body <- liftIO $ BL.toStrict <$> renderMail' m + let raw = + SES.newSendRawEmail (SES.newRawMessage body) + & SES.sendRawEmail_destinations ?~ fmap addressEmail (mailTo m) + & SES.sendRawEmail_source ?~ addressEmail (mailFrom m) + resp <- retrying retry5x (\_ -> pure . canRetry) $ const (sendCatch raw) + void . embed $ either check pure resp + where + check x = case x of + -- To map rejected domain names by SES to 400 responses, in order + -- not to trigger false 5xx alerts. Upfront domain name validation + -- is only according to the syntax rules of RFC5322 but additional + -- constraints may be applied by email servers (in this case SES). + -- Since such additional constraints are neither standardised nor + -- documented in the cases of SES, we can only handle the errors + -- after the fact. + AWS.ServiceError se + | (se ^. AWS.serviceError_status == status400) + && ("Invalid domain name" `Text.isPrefixOf` AWS.toText (se ^. AWS.serviceError_code)) -> + throwM SESInvalidDomain + _ -> throwM (EmailSendingAWSGeneralError x) + +data EmailSendingAWSError where + SESInvalidDomain :: EmailSendingAWSError + EmailSendingAWSGeneralError :: (Show e, AWS.AsError e) => e -> EmailSendingAWSError + +deriving instance Show EmailSendingAWSError + +deriving instance Typeable EmailSendingAWSError + +instance Exception EmailSendingAWSError + +retry5x :: (Monad m) => RetryPolicyM m +retry5x = limitRetries 5 <> exponentialBackoff 100000 diff --git a/services/brig/src/Brig/SMTP.hs b/libs/wire-subsystems/src/Wire/EmailSending/SMTP.hs similarity index 90% rename from services/brig/src/Brig/SMTP.hs rename to libs/wire-subsystems/src/Wire/EmailSending/SMTP.hs index 75694ee3c11..5c71f8a2c84 100644 --- a/services/brig/src/Brig/SMTP.hs +++ b/libs/wire-subsystems/src/Wire/EmailSending/SMTP.hs @@ -17,10 +17,10 @@ -- You should have received a copy of the GNU Affero General Public License along -- with this program. If not, see . -module Brig.SMTP - ( sendMail, - initSMTP, - sendMail', +module Wire.EmailSending.SMTP + ( initSMTP, + emailViaSMTPInterpreter, + sendMailWithDuration, initSMTP', SMTPConnType (..), SMTP (..), @@ -32,7 +32,6 @@ where import Control.Concurrent.Async (wait, withAsyncWithUnmask) import Control.Exception qualified as CE (throw) -import Control.Lens import Control.Monad.Catch import Control.Timeout (timeout) import Data.Aeson @@ -45,16 +44,20 @@ import Network.HaskellNet.SMTP qualified as SMTP import Network.HaskellNet.SMTP.SSL qualified as SMTP import Network.Mail.Mime import Network.Socket (PortNumber) +import Polysemy import System.Logger qualified as Logger import System.Logger.Class hiding (create) +import Wire.EmailSending + +emailViaSMTPInterpreter :: (Member (Embed IO) r) => Logger -> SMTP -> InterpreterFor EmailSending r +emailViaSMTPInterpreter logger smtp = interpret \case + SendMail mail -> sendMailImpl logger smtp mail newtype Username = Username Text newtype Password = Password Text -data SMTP = SMTP - { _pool :: !(Pool SMTP.SMTPConnection) - } +data SMTP = SMTP {pool :: !(Pool SMTP.SMTPConnection)} data SMTPConnType = Plain @@ -62,10 +65,6 @@ data SMTPConnType | SSL deriving (Eq, Show) -deriveJSON defaultOptions {constructorTagModifier = map toLower} ''SMTPConnType - -makeLenses ''SMTP - data SMTPPoolException = SMTPUnauthorized | SMTPConnectionTimeout deriving (Eq, Show) @@ -221,17 +220,19 @@ ensureSMTPConnectionTimeout timeoutDuration action = -- a timeout happens and on every other network failure. -- -- `defaultTimeoutDuration` is used as timeout duration for all actions. -sendMail :: (MonadIO m) => Logger -> SMTP -> Mail -> m () -sendMail = sendMail' defaultTimeoutDuration +sendMailImpl :: (MonadIO m) => Logger -> SMTP -> Mail -> m () +sendMailImpl = sendMailWithDuration defaultTimeoutDuration -- | `sendMail` with configurable timeout duration -- -- This is mostly useful for testing. (We don't want to waste the amount of -- `defaultTimeoutDuration` in tests with waiting.) -sendMail' :: forall t m. (MonadIO m, TimeUnit t) => t -> Logger -> SMTP -> Mail -> m () -sendMail' timeoutDuration lg s m = liftIO $ withResource (s ^. pool) sendMail'' +sendMailWithDuration :: forall t m. (MonadIO m, TimeUnit t) => t -> Logger -> SMTP -> Mail -> m () +sendMailWithDuration timeoutDuration lg smtp m = liftIO $ withResource smtp.pool sendMailWithConn where - sendMail'' :: SMTP.SMTPConnection -> IO () - sendMail'' c = + sendMailWithConn :: SMTP.SMTPConnection -> IO () + sendMailWithConn c = logExceptionOrResult lg "Sending mail via SMTP" $ ensureSMTPConnectionTimeout timeoutDuration (SMTP.sendMail m c) + +deriveJSON defaultOptions {constructorTagModifier = map toLower} ''SMTPConnType diff --git a/libs/wire-subsystems/src/Wire/EmailSmsSubsystem.hs b/libs/wire-subsystems/src/Wire/EmailSmsSubsystem.hs new file mode 100644 index 00000000000..6ec9a7c3ca9 --- /dev/null +++ b/libs/wire-subsystems/src/Wire/EmailSmsSubsystem.hs @@ -0,0 +1,26 @@ +{-# LANGUAGE TemplateHaskell #-} + +module Wire.EmailSmsSubsystem where + +import Data.Code qualified as Code +import Imports +import Polysemy +import Wire.API.Locale +import Wire.API.User +import Wire.API.User.Activation (ActivationCode, ActivationKey) +import Wire.API.User.Client (Client (..)) + +data EmailSmsSubsystem m a where + SendPasswordResetMail :: Email -> PasswordResetPair -> Maybe Locale -> EmailSmsSubsystem m () + SendPasswordResetSms :: Phone -> PasswordResetPair -> Maybe Locale -> EmailSmsSubsystem m () + SendVerificationMail :: Email -> ActivationKey -> ActivationCode -> Maybe Locale -> EmailSmsSubsystem m () + SendCreateScimTokenVerificationMail :: Email -> Code.Value -> Maybe Locale -> EmailSmsSubsystem m () + SendLoginVerificationMail :: Email -> Code.Value -> Maybe Locale -> EmailSmsSubsystem m () + SendActivationMail :: Email -> Name -> ActivationKey -> ActivationCode -> Maybe Locale -> EmailSmsSubsystem m () + SendEmailAddressUpdateMail :: Email -> Name -> ActivationKey -> ActivationCode -> Maybe Locale -> EmailSmsSubsystem m () + SendNewClientEmail :: Email -> Name -> Client -> Locale -> EmailSmsSubsystem m () + SendAccountDeletionEmail :: Email -> Name -> Code.Key -> Code.Value -> Locale -> EmailSmsSubsystem m () + SendTeamActivationMail :: Email -> Name -> ActivationKey -> ActivationCode -> Maybe Locale -> Text -> EmailSmsSubsystem m () + SendTeamDeletionVerificationMail :: Email -> Code.Value -> Maybe Locale -> EmailSmsSubsystem m () + +makeSem ''EmailSmsSubsystem diff --git a/libs/wire-subsystems/src/Wire/EmailSmsSubsystem/Interpreter.hs b/libs/wire-subsystems/src/Wire/EmailSmsSubsystem/Interpreter.hs new file mode 100644 index 00000000000..ec891d2a6cc --- /dev/null +++ b/libs/wire-subsystems/src/Wire/EmailSmsSubsystem/Interpreter.hs @@ -0,0 +1,393 @@ +{-# LANGUAGE RecordWildCards #-} + +module Wire.EmailSmsSubsystem.Interpreter where + +import Data.Code qualified as Code +import Data.Json.Util +import Data.Range (fromRange) +import Data.Text qualified as Text +import Data.Text.Ascii qualified as Ascii +import Data.Text.Lazy (toStrict) +import Imports +import Network.Mail.Mime +import Polysemy +import Wire.API.Locale +import Wire.API.User +import Wire.API.User.Activation +import Wire.API.User.Client (Client (..)) +import Wire.API.User.Password +import Wire.EmailSending (EmailSending, sendMail) +import Wire.EmailSmsSubsystem.Template + +------------------------------------------------------------------------------- +-- Verification Email for +-- - Login +-- - Creation of ScimToken +-- - Team Deletion + +sendTeamDeletionVerificationMailImpl :: + (Member EmailSending r) => + Localised UserTemplates -> + TemplateBranding -> + Email -> + Code.Value -> + Maybe Locale -> + Sem r () +sendTeamDeletionVerificationMailImpl userTemplates branding email code mLocale = do + let tpl = verificationTeamDeletionEmail . snd $ forLocale mLocale userTemplates + sendMail $ renderSecondFactorVerificationEmail email code tpl branding + +sendCreateScimTokenVerificationMailImpl :: + (Member EmailSending r) => + Localised UserTemplates -> + TemplateBranding -> + Email -> + Code.Value -> + Maybe Locale -> + Sem r () +sendCreateScimTokenVerificationMailImpl userTemplates branding email code mLocale = do + let tpl = verificationScimTokenEmail . snd $ forLocale mLocale userTemplates + sendMail $ renderSecondFactorVerificationEmail email code tpl branding + +sendLoginVerificationMailImpl :: + (Member EmailSending r) => + Localised UserTemplates -> + TemplateBranding -> + Email -> + Code.Value -> + Maybe Locale -> + Sem r () +sendLoginVerificationMailImpl userTemplates branding email code mLocale = do + let tpl = verificationLoginEmail . snd $ forLocale mLocale userTemplates + sendMail $ renderSecondFactorVerificationEmail email code tpl branding + +renderSecondFactorVerificationEmail :: + Email -> + Code.Value -> + SecondFactorVerificationEmailTemplate -> + TemplateBranding -> + Mail +renderSecondFactorVerificationEmail email codeValue SecondFactorVerificationEmailTemplate {..} branding = + (emptyMail from) + { mailTo = [to], + mailHeaders = + [ ("Subject", toStrict subj), + ("X-Zeta-Purpose", "SecondFactorVerification"), + ("X-Zeta-Code", code) + ], + mailParts = [[plainPart txt, htmlPart html]] + } + where + from = Address (Just sndFactorVerificationEmailSenderName) (fromEmail sndFactorVerificationEmailSender) + to = Address Nothing (fromEmail email) + txt = renderTextWithBranding sndFactorVerificationEmailBodyText replace branding + html = renderHtmlWithBranding sndFactorVerificationEmailBodyHtml replace branding + subj = renderTextWithBranding sndFactorVerificationEmailSubject replace branding + code = Ascii.toText (fromRange codeValue.asciiValue) + replace :: Text -> Text + replace "email" = fromEmail email + replace "code" = code + replace x = x + +------------------------------------------------------------------------------- +-- Activation Email + +sendActivationMailImpl :: + (Member EmailSending r) => + Localised UserTemplates -> + TemplateBranding -> + Email -> + Name -> + ActivationKey -> + ActivationCode -> + Maybe Locale -> + Sem r () +sendActivationMailImpl userTemplates branding email name akey acode mLocale = do + let tpl = activationEmail . snd $ forLocale mLocale userTemplates + sendMail $ renderActivationMail email name akey acode tpl branding + +sendEmailAddressUpdateMailImpl :: + (Member EmailSending r) => + Localised UserTemplates -> + TemplateBranding -> + Email -> + Name -> + ActivationKey -> + ActivationCode -> + Maybe Locale -> + Sem r () +sendEmailAddressUpdateMailImpl userTemplates branding email name akey acode mLocale = do + let tpl = activationEmailUpdate . snd $ forLocale mLocale userTemplates + sendMail $ renderActivationMail email name akey acode tpl branding + +renderActivationMail :: Email -> Name -> ActivationKey -> ActivationCode -> ActivationEmailTemplate -> TemplateBranding -> Mail +renderActivationMail email name akey@(ActivationKey key) acode@(ActivationCode code) ActivationEmailTemplate {..} branding = + (emptyMail from) + { mailTo = [to], + -- To make automated processing possible, the activation code is also added to + -- headers. {#RefActivationEmailHeaders} + mailHeaders = + [ ("Subject", toStrict subj), + ("X-Zeta-Purpose", "Activation"), + ("X-Zeta-Key", Ascii.toText key), + ("X-Zeta-Code", Ascii.toText code) + ], + mailParts = [[plainPart txt, htmlPart html]] + } + where + from, to :: Address + from = Address (Just activationEmailSenderName) (fromEmail activationEmailSender) + to = mkMimeAddress name email + + txt, html, subj :: LText + txt = renderTextWithBranding activationEmailBodyText replace branding + html = renderHtmlWithBranding activationEmailBodyHtml replace branding + subj = renderTextWithBranding activationEmailSubject replace branding + + replace :: Text -> Text + replace "url" = renderActivationUrl activationEmailUrl akey acode branding + replace "email" = fromEmail email + replace "name" = fromName name + replace x = x + +renderActivationUrl :: Template -> ActivationKey -> ActivationCode -> TemplateBranding -> Text +renderActivationUrl t (ActivationKey k) (ActivationCode c) branding = + toStrict $ renderTextWithBranding t replace branding + where + replace :: Text -> Text + replace "key" = Ascii.toText k + replace "code" = Ascii.toText c + replace x = x + +------------------------------------------------------------------------------- +-- Team Activation Email + +sendTeamActivationMailImpl :: + (Member EmailSending r) => + Localised UserTemplates -> + TemplateBranding -> + Email -> + Name -> + ActivationKey -> + ActivationCode -> + Maybe Locale -> + Text -> + Sem r () +sendTeamActivationMailImpl userTemplates branding email name akey acode mLocale teamName = do + let tpl = teamActivationEmail . snd $ forLocale mLocale userTemplates + sendMail $ renderTeamActivationMail email name teamName akey acode tpl branding + +renderTeamActivationMail :: Email -> Name -> Text -> ActivationKey -> ActivationCode -> TeamActivationEmailTemplate -> TemplateBranding -> Mail +renderTeamActivationMail email name teamName akey@(ActivationKey key) acode@(ActivationCode code) TeamActivationEmailTemplate {..} branding = + (emptyMail from) + { mailTo = [to], + mailHeaders = + [ ("Subject", toStrict subj), + ("X-Zeta-Purpose", "Activation"), + ("X-Zeta-Key", Ascii.toText key), + ("X-Zeta-Code", Ascii.toText code) + ], + mailParts = [[plainPart txt, htmlPart html]] + } + where + from, to :: Address + from = Address (Just teamActivationEmailSenderName) (fromEmail teamActivationEmailSender) + to = mkMimeAddress name email + txt, html, subj :: LText + txt = renderTextWithBranding teamActivationEmailBodyText replace branding + html = renderHtmlWithBranding teamActivationEmailBodyHtml replace branding + subj = renderTextWithBranding teamActivationEmailSubject replace branding + replace :: Text -> Text + replace "url" = renderActivationUrl teamActivationEmailUrl akey acode branding + replace "email" = fromEmail email + replace "name" = fromName name + replace "team" = teamName + replace x = x + +------------------------------------------------------------------------------- +-- Verification Email + +sendVerificationMailImpl :: + (Member EmailSending r) => + Localised UserTemplates -> + TemplateBranding -> + Email -> + ActivationKey -> + ActivationCode -> + Maybe Locale -> + Sem r () +sendVerificationMailImpl userTemplates branding email akey acode mLocale = do + let tpl = verificationEmail . snd $ forLocale mLocale userTemplates + sendMail $ renderVerificationMail email akey acode tpl branding + +renderVerificationMail :: Email -> ActivationKey -> ActivationCode -> VerificationEmailTemplate -> TemplateBranding -> Mail +renderVerificationMail email akey acode VerificationEmailTemplate {..} branding = + (emptyMail from) + { mailTo = [to], + -- To make automated processing possible, the activation code is also added to + -- headers. {#RefActivationEmailHeaders} + mailHeaders = + [ ("Subject", toStrict subj), + ("X-Zeta-Purpose", "Verification"), + ("X-Zeta-Code", Ascii.toText code) + ], + mailParts = [[plainPart txt, htmlPart html]] + } + where + (ActivationKey _, ActivationCode code) = (akey, acode) + from = Address (Just verificationEmailSenderName) (fromEmail verificationEmailSender) + to = Address Nothing (fromEmail email) + txt = renderTextWithBranding verificationEmailBodyText replace branding + html = renderHtmlWithBranding verificationEmailBodyHtml replace branding + subj = renderTextWithBranding verificationEmailSubject replace branding + replace "code" = Ascii.toText code + replace "email" = fromEmail email + replace x = x + +------------------------------------------------------------------------------- +-- Password Reset Email + +sendPasswordResetMailImpl :: + (Member EmailSending r) => + Localised UserTemplates -> + TemplateBranding -> + Email -> + PasswordResetKey -> + PasswordResetCode -> + Maybe Locale -> + Sem r () +sendPasswordResetMailImpl userTemplates branding email pkey pcode mLocale = do + let tpl = passwordResetEmail . snd $ forLocale mLocale userTemplates + sendMail $ renderPwResetMail email pkey pcode tpl branding + +renderPwResetMail :: Email -> PasswordResetKey -> PasswordResetCode -> PasswordResetEmailTemplate -> TemplateBranding -> Mail +renderPwResetMail email pkey pcode PasswordResetEmailTemplate {..} branding = + (emptyMail from) + { mailTo = [to], + mailHeaders = + [ ("Subject", toStrict subj), + ("X-Zeta-Purpose", "PasswordReset"), + ("X-Zeta-Key", Ascii.toText key), + ("X-Zeta-Code", Ascii.toText code) + ], + mailParts = [[plainPart txt, htmlPart html]] + } + where + (PasswordResetKey key, PasswordResetCode code) = (pkey, pcode) + from = Address (Just passwordResetEmailSenderName) (fromEmail passwordResetEmailSender) + to = Address Nothing (fromEmail email) + txt = renderTextWithBranding passwordResetEmailBodyText replace branding + html = renderHtmlWithBranding passwordResetEmailBodyHtml replace branding + subj = renderTextWithBranding passwordResetEmailSubject replace branding + replace "url" = renderPwResetUrl passwordResetEmailUrl (pkey, pcode) branding + replace x = x + +renderPwResetUrl :: Template -> PasswordResetPair -> TemplateBranding -> Text +renderPwResetUrl t (PasswordResetKey k, PasswordResetCode c) branding = + toStrict $ renderTextWithBranding t replace branding + where + replace "key" = Ascii.toText k + replace "code" = Ascii.toText c + replace x = x + +------------------------------------------------------------------------------- +-- New Client Email + +sendNewClientEmailImpl :: + (Member EmailSending r) => + Localised UserTemplates -> + TemplateBranding -> + Email -> + Name -> + Client -> + Locale -> + Sem r () +sendNewClientEmailImpl userTemplates branding email name client locale = do + let tpl = newClientEmail . snd $ forLocale (Just locale) userTemplates + sendMail $ renderNewClientEmail email name locale client tpl branding + +renderNewClientEmail :: Email -> Name -> Locale -> Client -> NewClientEmailTemplate -> TemplateBranding -> Mail +renderNewClientEmail email name locale Client {..} NewClientEmailTemplate {..} branding = + (emptyMail from) + { mailTo = [to], + mailHeaders = + [ ("Subject", toStrict subj), + ("X-Zeta-Purpose", "NewDevice") + ], + mailParts = [[plainPart txt, htmlPart html]] + } + where + from = Address (Just newClientEmailSenderName) (fromEmail newClientEmailSender) + to = mkMimeAddress name email + txt = renderTextWithBranding newClientEmailBodyText replace branding + html = renderHtmlWithBranding newClientEmailBodyHtml replace branding + subj = renderTextWithBranding newClientEmailSubject replace branding + replace "name" = fromName name + replace "label" = fromMaybe "N/A" clientLabel + replace "model" = fromMaybe "N/A" clientModel + replace "date" = + formatDateTime + "%A %e %B %Y, %H:%M - %Z" + (timeLocale locale) + (fromUTCTimeMillis clientTime) + replace x = x + +------------------------------------------------------------------------------- +-- Deletion Email + +sendAccountDeletionEmailImpl :: + (Member EmailSending r) => + Localised UserTemplates -> + TemplateBranding -> + Email -> + Name -> + Code.Key -> + Code.Value -> + Locale -> + Sem r () +sendAccountDeletionEmailImpl userTemplates branding email name key code locale = do + let tpl = deletionEmail . snd $ forLocale (Just locale) userTemplates + sendMail $ renderDeletionEmail email name key code tpl branding + +renderDeletionEmail :: Email -> Name -> Code.Key -> Code.Value -> DeletionEmailTemplate -> TemplateBranding -> Mail +renderDeletionEmail email name cKey cValue DeletionEmailTemplate {..} branding = + (emptyMail from) + { mailTo = [to], + mailHeaders = + [ ("Subject", toStrict subj), + ("X-Zeta-Purpose", "Delete"), + ("X-Zeta-Key", key), + ("X-Zeta-Code", code) + ], + mailParts = [[plainPart txt, htmlPart html]] + } + where + from = Address (Just deletionEmailSenderName) (fromEmail deletionEmailSender) + to = mkMimeAddress name email + txt = renderTextWithBranding deletionEmailBodyText replace1 branding + html = renderHtmlWithBranding deletionEmailBodyHtml replace1 branding + subj = renderTextWithBranding deletionEmailSubject replace1 branding + key = Ascii.toText (fromRange (Code.asciiKey cKey)) + code = Ascii.toText (fromRange (Code.asciiValue cValue)) + replace1 "url" = toStrict (renderTextWithBranding deletionEmailUrl replace2 branding) + replace1 "email" = fromEmail email + replace1 "name" = fromName name + replace1 x = x + replace2 "key" = key + replace2 "code" = code + replace2 x = x + +------------------------------------------------------------------------------- +-- MIME Conversions + +-- | Construct a MIME 'Address' from the given display 'Name' and 'Email' +-- address that does not exceed 320 bytes in length when rendered for use +-- in SMTP, which is a safe limit for most mail servers (including those of +-- Amazon SES). The display name is only included if it fits within that +-- limit, otherwise it is dropped. +mkMimeAddress :: Name -> Email -> Address +mkMimeAddress name email = + let addr = Address (Just (fromName name)) (fromEmail email) + in if Text.compareLength (renderAddress addr) 320 == GT + then Address Nothing (fromEmail email) + else addr diff --git a/libs/wire-subsystems/src/Wire/EmailSmsSubsystem/Template.hs b/libs/wire-subsystems/src/Wire/EmailSmsSubsystem/Template.hs new file mode 100644 index 00000000000..60327d0d9c1 --- /dev/null +++ b/libs/wire-subsystems/src/Wire/EmailSmsSubsystem/Template.hs @@ -0,0 +1,204 @@ +{-# LANGUAGE StrictData #-} + +-- This file is part of the Wire Server implementation. +-- +-- Copyright (C) 2022 Wire Swiss GmbH +-- +-- This program is free software: you can redistribute it and/or modify it under +-- the terms of the GNU Affero General Public License as published by the Free +-- Software Foundation, either version 3 of the License, or (at your option) any +-- later version. +-- +-- This program is distributed in the hope that it will be useful, but WITHOUT +-- ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS +-- FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for more +-- details. +-- +-- You should have received a copy of the GNU Affero General Public License along +-- with this program. If not, see . + +module Wire.EmailSmsSubsystem.Template + ( Localised (..), + TemplateBranding, + forLocale, + + -- * templates + UserTemplates (..), + ActivationSmsTemplate (..), + VerificationEmailTemplate (..), + ActivationEmailTemplate (..), + TeamActivationEmailTemplate (..), + ActivationCallTemplate (..), + PasswordResetSmsTemplate (..), + PasswordResetEmailTemplate (..), + LoginSmsTemplate (..), + LoginCallTemplate (..), + DeletionSmsTemplate (..), + DeletionEmailTemplate (..), + NewClientEmailTemplate (..), + SecondFactorVerificationEmailTemplate (..), + + -- * Re-exports + Template, + renderTextWithBranding, + renderHtmlWithBranding, + ) +where + +import Data.Map qualified as Map +import Data.Text.Lazy qualified as Lazy +import Data.Text.Template +import HTMLEntities.Text qualified as HTML +import Imports +import Wire.API.Locale +import Wire.API.User + +-- | Lookup a localised item from a 'Localised' structure. +forLocale :: + -- | 'Just' the preferred locale or 'Nothing' for + -- the default locale. + Maybe Locale -> + -- | The 'Localised' structure. + Localised a -> + -- | Pair of the effectively chosen locale and the + -- associated value. + (Locale, a) +forLocale pref t = case pref of + Just l -> fromMaybe (locDefault t) (select l) + Nothing -> locDefault t + where + select l = + let l' = l {lCountry = Nothing} + loc = Map.lookup l (locOther t) + lan = Map.lookup l' (locOther t) + in (l,) <$> loc <|> (l',) <$> lan + +-- | See 'genTemplateBranding'. +type TemplateBranding = Text -> Text + +-- | Localised templates. +data Localised a = Localised + { locDefault :: (Locale, a), + locOther :: (Map Locale a) + } + +-- | Uses a replace and a branding function, to replaces all placeholders from the +-- given template to produce a Text. To be used on plain text templates +renderTextWithBranding :: Template -> (Text -> Text) -> TemplateBranding -> Lazy.Text +renderTextWithBranding tpl replace branding = render tpl (replace . branding) + +-- | Uses a replace and a branding function to replace all placeholders from the +-- given template to produce a Text. To be used on HTML templates +renderHtmlWithBranding :: Template -> (Text -> Text) -> TemplateBranding -> Lazy.Text +renderHtmlWithBranding tpl replace branding = render tpl (HTML.text . replace . branding) + +data UserTemplates = UserTemplates + { activationSms :: ActivationSmsTemplate, + activationCall :: ActivationCallTemplate, + verificationEmail :: VerificationEmailTemplate, + activationEmail :: ActivationEmailTemplate, + activationEmailUpdate :: ActivationEmailTemplate, + teamActivationEmail :: TeamActivationEmailTemplate, + passwordResetSms :: PasswordResetSmsTemplate, + passwordResetEmail :: PasswordResetEmailTemplate, + loginSms :: LoginSmsTemplate, + loginCall :: LoginCallTemplate, + deletionSms :: DeletionSmsTemplate, + deletionEmail :: DeletionEmailTemplate, + newClientEmail :: NewClientEmailTemplate, + verificationLoginEmail :: SecondFactorVerificationEmailTemplate, + verificationScimTokenEmail :: SecondFactorVerificationEmailTemplate, + verificationTeamDeletionEmail :: SecondFactorVerificationEmailTemplate + } + +data ActivationSmsTemplate = ActivationSmsTemplate + { activationSmslUrl :: Template, + activationSmsText :: Template, + activationSmsSender :: Text + } + +data ActivationCallTemplate = ActivationCallTemplate + { activationCallText :: Template + } + +data VerificationEmailTemplate = VerificationEmailTemplate + { verificationEmailUrl :: Template, + verificationEmailSubject :: Template, + verificationEmailBodyText :: Template, + verificationEmailBodyHtml :: Template, + verificationEmailSender :: Email, + verificationEmailSenderName :: Text + } + +data ActivationEmailTemplate = ActivationEmailTemplate + { activationEmailUrl :: Template, + activationEmailSubject :: Template, + activationEmailBodyText :: Template, + activationEmailBodyHtml :: Template, + activationEmailSender :: Email, + activationEmailSenderName :: Text + } + +data TeamActivationEmailTemplate = TeamActivationEmailTemplate + { teamActivationEmailUrl :: Template, + teamActivationEmailSubject :: Template, + teamActivationEmailBodyText :: Template, + teamActivationEmailBodyHtml :: Template, + teamActivationEmailSender :: Email, + teamActivationEmailSenderName :: Text + } + +data DeletionEmailTemplate = DeletionEmailTemplate + { deletionEmailUrl :: Template, + deletionEmailSubject :: Template, + deletionEmailBodyText :: Template, + deletionEmailBodyHtml :: Template, + deletionEmailSender :: Email, + deletionEmailSenderName :: Text + } + +data PasswordResetEmailTemplate = PasswordResetEmailTemplate + { passwordResetEmailUrl :: Template, + passwordResetEmailSubject :: Template, + passwordResetEmailBodyText :: Template, + passwordResetEmailBodyHtml :: Template, + passwordResetEmailSender :: Email, + passwordResetEmailSenderName :: Text + } + +data PasswordResetSmsTemplate = PasswordResetSmsTemplate + { passwordResetSmsText :: Template, + passwordResetSmsSender :: Text + } + +data LoginSmsTemplate = LoginSmsTemplate + { loginSmsUrl :: Template, + loginSmsText :: Template, + loginSmsSender :: Text + } + +data LoginCallTemplate = LoginCallTemplate + { loginCallText :: Template + } + +data DeletionSmsTemplate = DeletionSmsTemplate + { deletionSmsUrl :: Template, + deletionSmsText :: Template, + deletionSmsSender :: Text + } + +data NewClientEmailTemplate = NewClientEmailTemplate + { newClientEmailSubject :: Template, + newClientEmailBodyText :: Template, + newClientEmailBodyHtml :: Template, + newClientEmailSender :: Email, + newClientEmailSenderName :: Text + } + +data SecondFactorVerificationEmailTemplate = SecondFactorVerificationEmailTemplate + { sndFactorVerificationEmailSubject :: Template, + sndFactorVerificationEmailBodyText :: Template, + sndFactorVerificationEmailBodyHtml :: Template, + sndFactorVerificationEmailSender :: Email, + sndFactorVerificationEmailSenderName :: Text + } diff --git a/libs/wire-subsystems/src/Wire/StoredUser.hs b/libs/wire-subsystems/src/Wire/StoredUser.hs index 62dd77bfcf1..31a2373f6b3 100644 --- a/libs/wire-subsystems/src/Wire/StoredUser.hs +++ b/libs/wire-subsystems/src/Wire/StoredUser.hs @@ -11,6 +11,7 @@ import Data.Set qualified as S import Database.CQL.Protocol (Record (..), TupleType, recordInstance) import GHC.Records import Imports +import Wire.API.Locale import Wire.API.Provider.Service import Wire.API.User import Wire.Arbitrary diff --git a/libs/wire-subsystems/src/Wire/UserStore.hs b/libs/wire-subsystems/src/Wire/UserStore.hs index 9fc5581f047..fc4260a5a3d 100644 --- a/libs/wire-subsystems/src/Wire/UserStore.hs +++ b/libs/wire-subsystems/src/Wire/UserStore.hs @@ -61,6 +61,7 @@ data UserStore m a where -- | Whether the account has been activated by verifying -- an email address or phone number. IsActivated :: UserId -> UserStore m Bool + LookupLocale :: UserId -> UserStore m (Maybe (Maybe Language, Maybe Country)) makeSem ''UserStore diff --git a/libs/wire-subsystems/src/Wire/UserStore/Cassandra.hs b/libs/wire-subsystems/src/Wire/UserStore/Cassandra.hs index bff332252f1..cba7356f22e 100644 --- a/libs/wire-subsystems/src/Wire/UserStore/Cassandra.hs +++ b/libs/wire-subsystems/src/Wire/UserStore/Cassandra.hs @@ -25,6 +25,7 @@ interpretUserStoreCassandra casClient = GlimpseHandle hdl -> embed $ lookupHandleImpl One hdl LookupStatus uid -> embed $ lookupStatusImpl uid IsActivated uid -> embed $ isActivatedImpl uid + LookupLocale uid -> embed $ lookupLocaleImpl uid getUserImpl :: (Member (Embed Client) r) => UserId -> Sem r (Maybe StoredUser) getUserImpl uid = embed $ do @@ -117,6 +118,10 @@ isActivatedImpl uid = (== Just (Identity True)) <$> retry x1 (query1 activatedSelect (params LocalQuorum (Identity uid))) +lookupLocaleImpl :: UserId -> Client (Maybe (Maybe Language, Maybe Country)) +lookupLocaleImpl u = do + retry x1 (query1 localeSelect (params LocalQuorum (Identity u))) + -------------------------------------------------------------------------------- -- Queries @@ -168,3 +173,6 @@ statusSelect = "SELECT status FROM user WHERE id = ?" activatedSelect :: PrepQuery R (Identity UserId) (Identity Bool) activatedSelect = "SELECT activated FROM user WHERE id = ?" + +localeSelect :: PrepQuery R (Identity UserId) (Maybe Language, Maybe Country) +localeSelect = "SELECT language, country FROM user WHERE id = ?" diff --git a/libs/wire-subsystems/src/Wire/UserSubsystem.hs b/libs/wire-subsystems/src/Wire/UserSubsystem.hs index 9b41d1b25dd..186dc05985c 100644 --- a/libs/wire-subsystems/src/Wire/UserSubsystem.hs +++ b/libs/wire-subsystems/src/Wire/UserSubsystem.hs @@ -99,6 +99,8 @@ data UserSubsystem m a where -- | parses a handle, this may fail so it's effectful UpdateHandle :: Local UserId -> Maybe ConnId -> UpdateOriginType -> Text {- use Handle here? -} -> UserSubsystem m () GetLocalUserAccountByUserKey :: Local UserKey -> UserSubsystem m (Maybe UserAccount) + -- | returns the user's locale or the default locale if the users exists + LookupLocaleWithDefault :: Local UserId -> UserSubsystem m (Maybe Locale) -- | the return type of 'CheckHandle' data CheckHandleResp diff --git a/libs/wire-subsystems/src/Wire/UserSubsystem/Interpreter.hs b/libs/wire-subsystems/src/Wire/UserSubsystem/Interpreter.hs index 3d6d35463d9..6146125ce4b 100644 --- a/libs/wire-subsystems/src/Wire/UserSubsystem/Interpreter.hs +++ b/libs/wire-subsystems/src/Wire/UserSubsystem/Interpreter.hs @@ -96,6 +96,13 @@ interpretUserSubsystem = interpret \case CheckHandles hdls cnt -> checkHandlesImpl hdls cnt UpdateHandle uid mconn mb uhandle -> updateHandleImpl uid mconn mb uhandle GetLocalUserAccountByUserKey userKey -> getLocalUserAccountByUserKeyImpl userKey + LookupLocaleWithDefault luid -> lookupLocaleOrDefaultImpl luid + +lookupLocaleOrDefaultImpl :: (Member UserStore r, Member (Input UserSubsystemConfig) r) => Local UserId -> Sem r (Maybe Locale) +lookupLocaleOrDefaultImpl luid = do + mLangCountry <- UserStore.lookupLocale (tUnqualified luid) + defLocale <- inputs defaultLocale + pure (toLocale defLocale <$> mLangCountry) -- | Obtain user profiles for a list of users as they can be seen by -- a given user 'self'. If 'self' is an unknown 'UserId', return '[]'. diff --git a/libs/wire-subsystems/test/unit/Wire/AuthenticationSubsystem/InterpreterSpec.hs b/libs/wire-subsystems/test/unit/Wire/AuthenticationSubsystem/InterpreterSpec.hs index e66b231cefe..e943e066d4f 100644 --- a/libs/wire-subsystems/test/unit/Wire/AuthenticationSubsystem/InterpreterSpec.hs +++ b/libs/wire-subsystems/test/unit/Wire/AuthenticationSubsystem/InterpreterSpec.hs @@ -24,6 +24,7 @@ import Wire.API.User.Auth import Wire.API.User.Password import Wire.AuthenticationSubsystem import Wire.AuthenticationSubsystem.Interpreter +import Wire.EmailSmsSubsystem import Wire.HashPassword import Wire.MockInterpreters import Wire.PasswordResetCodeStore @@ -49,6 +50,8 @@ type AllEffects = PasswordResetCodeStore, State (Map PasswordResetKey (PRQueryData Identity)), TinyLog, + EmailSmsSubsystem, + State (Map Email [SentMail]), UserSubsystem ] @@ -56,6 +59,8 @@ interpretDependencies :: Domain -> [UserAccount] -> Map UserId Password -> Maybe interpretDependencies localDomain preexistingUsers preexistingPasswords mAllowedEmailDomains = run . userSubsystemTestInterpreter preexistingUsers + . evalState mempty + . emailSmsSubsystemInterpreter . discardTinyLogs . evalState mempty . inMemoryPasswordResetCodeStore @@ -89,7 +94,8 @@ spec = describe "AuthenticationSubsystem.Interpreter" do forM_ mPreviousPassword (hashPassword >=> upsertHashedPassword uid) mapM_ (uncurry (insertCookie uid)) cookiesWithTTL - (_, (_, code)) <- createPasswordResetCode (userEmailKey email) + createPasswordResetCode (userEmailKey email) + (_, code) <- expect1ResetPasswordEmail email resetPassword (PasswordResetEmailIdentity email) code newPassword (,) <$> lookupHashedPassword uid <*> listCookies uid @@ -109,7 +115,8 @@ spec = describe "AuthenticationSubsystem.Interpreter" do forM_ mPreviousPassword (hashPassword >=> upsertHashedPassword uid) mapM_ (uncurry (insertCookie uid)) cookiesWithTTL - (_, (passwordResetKey, code)) <- createPasswordResetCode (userEmailKey email) + createPasswordResetCode (userEmailKey email) + (passwordResetKey, code) <- expect1ResetPasswordEmail email resetPassword (PasswordResetIdentityKey passwordResetKey) code newPassword (,) <$> lookupHashedPassword uid <*> listCookies uid @@ -165,11 +172,12 @@ spec = describe "AuthenticationSubsystem.Interpreter" do interpretDependencies localDomain [UserAccount user Active] mempty Nothing . interpretAuthenticationSubsystem $ do - (_, (_, code)) <- createPasswordResetCode (userEmailKey email) + createPasswordResetCode (userEmailKey email) + (_, code) <- expect1ResetPasswordEmail email mCaughtExc <- catchExpectedError $ createPasswordResetCode (userEmailKey email) - -- Reset passwrod still works with previously generated reset code + -- Reset password still works with previously generated reset code resetPassword (PasswordResetEmailIdentity email) code newPassword (,mCaughtExc) <$> lookupHashedPassword uid @@ -186,7 +194,8 @@ spec = describe "AuthenticationSubsystem.Interpreter" do . interpretAuthenticationSubsystem $ do upsertHashedPassword uid =<< hashPassword oldPassword - (_, (_, code)) <- createPasswordResetCode (userEmailKey email) + createPasswordResetCode (userEmailKey email) + (_, code) <- expect1ResetPasswordEmail email passTime (passwordResetCodeTtl + 1) @@ -236,7 +245,8 @@ spec = describe "AuthenticationSubsystem.Interpreter" do . interpretAuthenticationSubsystem $ do upsertHashedPassword uid =<< hashPassword oldPassword - (_, (_, generatedResetCode)) <- createPasswordResetCode (userEmailKey email) + createPasswordResetCode (userEmailKey email) + (_, generatedResetCode) <- expect1ResetPasswordEmail email wrongResetErrs <- replicateM wrongResetAttempts $ @@ -288,3 +298,11 @@ verifyPasswordProp plainTextPassword passwordHash = hashAndUpsertPassword :: (Member PasswordStore r, Member HashPassword r) => UserId -> PlainTextPassword8 -> Sem r () hashAndUpsertPassword uid password = upsertHashedPassword uid =<< hashPassword password + +expect1ResetPasswordEmail :: (Member (State (Map Email [SentMail])) r) => Email -> Sem r PasswordResetPair +expect1ResetPasswordEmail email = + getEmailsSentTo email + <&> \case + [] -> error "no emails sent" + [SentMail _ (PasswordResetMail resetPair)] -> resetPair + wrongEmails -> error $ "Wrong emails sent: " <> show wrongEmails diff --git a/libs/wire-subsystems/test/unit/Wire/MockInterpreters.hs b/libs/wire-subsystems/test/unit/Wire/MockInterpreters.hs index 51016fddd9d..5e1c0ffc1ed 100644 --- a/libs/wire-subsystems/test/unit/Wire/MockInterpreters.hs +++ b/libs/wire-subsystems/test/unit/Wire/MockInterpreters.hs @@ -3,6 +3,7 @@ module Wire.MockInterpreters (module MockInterpreters) where -- Run this from project root to generate the imports: -- ls libs/wire-subsystems/test/unit/Wire/MockInterpreters | sed 's|\(.*\)\.hs|import Wire.MockInterpreters.\1 as MockInterpreters|' +import Wire.MockInterpreters.EmailSmsSubsystem as MockInterpreters import Wire.MockInterpreters.Error as MockInterpreters import Wire.MockInterpreters.GalleyAPIAccess as MockInterpreters import Wire.MockInterpreters.HashPassword as MockInterpreters diff --git a/libs/wire-subsystems/test/unit/Wire/MockInterpreters/EmailSmsSubsystem.hs b/libs/wire-subsystems/test/unit/Wire/MockInterpreters/EmailSmsSubsystem.hs new file mode 100644 index 00000000000..af38731ed23 --- /dev/null +++ b/libs/wire-subsystems/test/unit/Wire/MockInterpreters/EmailSmsSubsystem.hs @@ -0,0 +1,25 @@ +module Wire.MockInterpreters.EmailSmsSubsystem where + +import Data.Map qualified as Map +import Imports +import Polysemy +import Polysemy.State +import Wire.API.User +import Wire.EmailSmsSubsystem + +data SentMail = SentMail + { locale :: Maybe Locale, + content :: SentMailContent + } + deriving (Show, Eq) + +data SentMailContent = PasswordResetMail PasswordResetPair + deriving (Show, Eq) + +emailSmsSubsystemInterpreter :: (Member (State (Map Email [SentMail])) r) => InterpreterFor EmailSmsSubsystem r +emailSmsSubsystemInterpreter = interpret \case + SendPasswordResetMail email keyCodePair mLocale -> modify $ Map.insertWith (<>) email [SentMail mLocale $ PasswordResetMail keyCodePair] + _ -> error "emailSmsSubsystemInterpreter: implement on demand" + +getEmailsSentTo :: (Member (State (Map Email [SentMail])) r) => Email -> Sem r [SentMail] +getEmailsSentTo email = gets $ Map.findWithDefault [] email diff --git a/libs/wire-subsystems/test/unit/Wire/MockInterpreters/UserStore.hs b/libs/wire-subsystems/test/unit/Wire/MockInterpreters/UserStore.hs index 1669ac292ea..563b91f4bd1 100644 --- a/libs/wire-subsystems/test/unit/Wire/MockInterpreters/UserStore.hs +++ b/libs/wire-subsystems/test/unit/Wire/MockInterpreters/UserStore.hs @@ -52,27 +52,34 @@ inMemoryUserStoreInterpreter = interpret $ \case us' <- f us put us' DeleteUser user -> modify $ filter (\u -> u.id /= User.userId user) - LookupHandle h -> miniBackendLookupHandle h - GlimpseHandle h -> miniBackendLookupHandle h - LookupStatus uid -> miniBackendLookupStatus uid - IsActivated uid -> miniBackendIsActivated uid + LookupHandle h -> lookupHandleImpl h + GlimpseHandle h -> lookupHandleImpl h + LookupStatus uid -> lookupStatusImpl uid + IsActivated uid -> isActivatedImpl uid + LookupLocale uid -> lookupLocaleImpl uid -miniBackendIsActivated :: (Member (State [StoredUser]) r) => UserId -> Sem r Bool -miniBackendIsActivated uid = do +lookupLocaleImpl :: (Member (State [StoredUser]) r) => UserId -> Sem r (Maybe ((Maybe Language, Maybe Country))) +lookupLocaleImpl uid = do + users <- get + let mUser = find ((== uid) . (.id)) users + pure $ (\u -> (u.language, u.country)) <$> mUser + +isActivatedImpl :: (Member (State [StoredUser]) r) => UserId -> Sem r Bool +isActivatedImpl uid = do gets $ maybe False (.activated) . find ((== uid) . (.id)) -miniBackendLookupStatus :: (Member (State [StoredUser]) r) => UserId -> Sem r (Maybe AccountStatus) -miniBackendLookupStatus uid = do +lookupStatusImpl :: (Member (State [StoredUser]) r) => UserId -> Sem r (Maybe AccountStatus) +lookupStatusImpl uid = do users <- get pure $ (.status) =<< (find ((== uid) . (.id)) users) -miniBackendLookupHandle :: +lookupHandleImpl :: (Member (State [StoredUser]) r) => Handle -> Sem r (Maybe UserId) -miniBackendLookupHandle h = do +lookupHandleImpl h = do gets $ fmap (.id) . find ((== Just h) . (.handle)) diff --git a/libs/wire-subsystems/wire-subsystems.cabal b/libs/wire-subsystems/wire-subsystems.cabal index 7825a0a5eaa..f5208751e20 100644 --- a/libs/wire-subsystems/wire-subsystems.cabal +++ b/libs/wire-subsystems/wire-subsystems.cabal @@ -72,8 +72,15 @@ library Wire.AuthenticationSubsystem Wire.AuthenticationSubsystem.Error Wire.AuthenticationSubsystem.Interpreter + Wire.AWS Wire.DeleteQueue Wire.DeleteQueue.InMemory + Wire.EmailSending + Wire.EmailSending.SES + Wire.EmailSending.SMTP + Wire.EmailSmsSubsystem + Wire.EmailSmsSubsystem.Interpreter + Wire.EmailSmsSubsystem.Template Wire.FederationAPIAccess Wire.FederationAPIAccess.Interpreter Wire.GalleyAPIAccess @@ -108,7 +115,7 @@ library , aeson , amazonka , amazonka-core - , amazonka-sqs + , amazonka-ses , async , base , base16-bytestring @@ -126,8 +133,11 @@ library , extended , extra , gundeck-types + , HaskellNet + , HaskellNet-SSL , HsOpenSSL , hspec + , html-entities , http-client , http-types , http2-manager @@ -136,19 +146,24 @@ library , lens , mime , mime-mail + , network , network-conduit-tls , polysemy , polysemy-plugin , polysemy-time , polysemy-wire-zoo , QuickCheck + , resource-pool , resourcet , retry , servant , servant-client-core , stomp-queue + , template , text , time + , time-out + , time-units , tinylog , transformers , transitive-anns @@ -176,6 +191,7 @@ test-suite wire-subsystems-tests Wire.AuthenticationSubsystem.InterpreterSpec Wire.MiniBackend Wire.MockInterpreters + Wire.MockInterpreters.EmailSmsSubsystem Wire.MockInterpreters.Error Wire.MockInterpreters.GalleyAPIAccess Wire.MockInterpreters.HashPassword @@ -208,13 +224,18 @@ test-suite wire-subsystems-tests , imports , iso639 , lens + , mime-mail + , network + , pipes , polysemy , polysemy-plugin , polysemy-time , polysemy-wire-zoo + , postie , QuickCheck , quickcheck-instances , servant-client-core + , streaming-commons , string-conversions , text , time diff --git a/services/brig/brig.cabal b/services/brig/brig.cabal index d80738ecaab..626d1f677c5 100644 --- a/services/brig/brig.cabal +++ b/services/brig/brig.cabal @@ -129,7 +129,6 @@ library Brig.Effects.SFT Brig.Effects.UserPendingActivationStore Brig.Effects.UserPendingActivationStore.Cassandra - Brig.Email Brig.Federation.Client Brig.Index.Eval Brig.Index.Migrations @@ -141,7 +140,6 @@ library Brig.IO.Intra Brig.IO.Journal Brig.IO.Logging - Brig.Locale Brig.Options Brig.Phone Brig.Provider.API @@ -195,7 +193,6 @@ library Brig.Schema.V80_KeyPackageCiphersuite Brig.Schema.V81_AddFederationRemoteTeams Brig.Schema.V_FUTUREWORK - Brig.SMTP Brig.Team.API Brig.Team.DB Brig.Team.Email @@ -208,7 +205,6 @@ library Brig.User.Auth.Cookie Brig.User.Auth.Cookie.Limit Brig.User.EJPD - Brig.User.Email Brig.User.Phone Brig.User.Search.Index Brig.User.Search.Index.Types @@ -268,10 +264,7 @@ library , galley-types >=0.75.3 , gundeck-types >=1.32.1 , hashable >=1.2 - , HaskellNet >=0.3 - , HaskellNet-SSL , HsOpenSSL >=0.10 - , html-entities >=1.1 , http-client >=0.7 , http-client-openssl >=0.2 , http-media @@ -306,7 +299,6 @@ library , proto-lens >=0.1 , random-shuffle >=0.0.3 , raw-strings-qq - , resource-pool >=0.2 , resourcet >=1.1 , retry >=0.7 , ropes >=0.4.20 diff --git a/services/brig/default.nix b/services/brig/default.nix index 49fdb470ae6..4ebaeb98fc2 100644 --- a/services/brig/default.nix +++ b/services/brig/default.nix @@ -51,11 +51,8 @@ , gitignoreSource , gundeck-types , hashable -, HaskellNet -, HaskellNet-SSL , hscim , HsOpenSSL -, html-entities , http-api-data , http-client , http-client-openssl @@ -101,7 +98,6 @@ , random , random-shuffle , raw-strings-qq -, resource-pool , resourcet , retry , ropes @@ -210,10 +206,7 @@ mkDerivation { galley-types gundeck-types hashable - HaskellNet - HaskellNet-SSL HsOpenSSL - html-entities http-client http-client-openssl http-media @@ -248,7 +241,6 @@ mkDerivation { proto-lens random-shuffle raw-strings-qq - resource-pool resourcet retry ropes diff --git a/services/brig/src/Brig/API/Auth.hs b/services/brig/src/Brig/API/Auth.hs index 218a1cbd990..92dc20a9cc3 100644 --- a/services/brig/src/Brig/API/Auth.hs +++ b/services/brig/src/Brig/API/Auth.hs @@ -51,6 +51,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.EmailSmsSubsystem (EmailSmsSubsystem) import Wire.GalleyAPIAccess import Wire.NotificationSubsystem import Wire.PasswordStore (PasswordStore) @@ -94,7 +95,15 @@ access mcid t mt = traverse mkUserTokenCookie =<< Auth.renewAccess (List1 t) mt mcid !>> zauthError -sendLoginCode :: (Member TinyLog r, Member UserKeyStore r, Member PasswordStore r) => SendLoginCode -> Handler r LoginCodeTimeout +sendLoginCode :: + ( Member TinyLog r, + Member UserKeyStore r, + Member PasswordStore r, + Member (Input (Local ())) r, + Member UserSubsystem r + ) => + SendLoginCode -> + Handler r LoginCodeTimeout sendLoginCode (SendLoginCode phone call force) = do checkAllowlist (Right phone) c <- Auth.sendLoginCode phone call force !>> sendLoginCodeError @@ -136,7 +145,8 @@ logout uts (Just at) = Auth.logout (List1 uts) at !>> zauthError changeSelfEmailH :: ( Member BlacklistStore r, - Member UserKeyStore r + Member UserKeyStore r, + Member EmailSmsSubsystem r ) => [Either Text SomeUserToken] -> Maybe (Either Text SomeAccessToken) -> diff --git a/services/brig/src/Brig/API/Client.hs b/services/brig/src/Brig/API/Client.hs index bfc18a1121b..8ce2c06251e 100644 --- a/services/brig/src/Brig/API/Client.hs +++ b/services/brig/src/Brig/API/Client.hs @@ -67,7 +67,6 @@ import Brig.Types.Intra import Brig.Types.Team.LegalHold (LegalHoldClientRequest (..)) import Brig.User.Auth qualified as UserAuth import Brig.User.Auth.Cookie qualified as Auth -import Brig.User.Email import Cassandra (MonadClient) import Control.Error import Control.Lens (view) @@ -109,6 +108,7 @@ import Wire.API.User.Client.Prekey import Wire.API.UserEvent import Wire.API.UserMap (QualifiedUserMap (QualifiedUserMap, qualifiedUserMap), UserMap (userMap)) import Wire.DeleteQueue +import Wire.EmailSmsSubsystem (EmailSmsSubsystem, sendNewClientEmail) import Wire.GalleyAPIAccess (GalleyAPIAccess) import Wire.GalleyAPIAccess qualified as GalleyAPIAccess import Wire.NotificationSubsystem @@ -168,7 +168,8 @@ addClient :: Member DeleteQueue r, Member (Input (Local ())) r, Member (Input UTCTime) r, - Member (ConnectionStore InternalPaging) r + Member (ConnectionStore InternalPaging) r, + Member EmailSmsSubsystem r ) => UserId -> Maybe ConnId -> @@ -187,7 +188,8 @@ addClientWithReAuthPolicy :: Member (Input (Local ())) r, Member (Input UTCTime) r, Member DeleteQueue r, - Member (ConnectionStore InternalPaging) r + Member (ConnectionStore InternalPaging) r, + Member EmailSmsSubsystem r ) => Data.ReAuthPolicy -> UserId -> @@ -220,7 +222,7 @@ addClientWithReAuthPolicy policy u con new = do when (count > 1) $ for_ (userEmail usr) $ \email -> - sendNewClientEmail (userDisplayName usr) email clt (userLocale usr) + liftSem $ sendNewClientEmail email (userDisplayName usr) clt (userLocale usr) pure clt where clientId' = clientIdFromPrekey (unpackLastPrekey $ newClientLastKey new) diff --git a/services/brig/src/Brig/API/Handler.hs b/services/brig/src/Brig/API/Handler.hs index ebe7ac1ac0b..93909286021 100644 --- a/services/brig/src/Brig/API/Handler.hs +++ b/services/brig/src/Brig/API/Handler.hs @@ -34,7 +34,6 @@ import Brig.API.Error import Brig.AWS qualified as AWS import Brig.App import Brig.CanonicalInterpreter (BrigCanonicalEffects, runBrigToIO) -import Brig.Email (Email) import Brig.Options (setAllowlistEmailDomains, setAllowlistPhonePrefixes) import Brig.Phone (Phone, PhoneException (..)) import Control.Error @@ -60,6 +59,7 @@ import System.Logger.Class (Logger) import Wire.API.Allowlists qualified as Allowlists import Wire.API.Error import Wire.API.Error.Brig +import Wire.API.User (Email) ------------------------------------------------------------------------------- -- HTTP Handler Monad diff --git a/services/brig/src/Brig/API/Internal.hs b/services/brig/src/Brig/API/Internal.hs index be734c5e76d..35ada792c93 100644 --- a/services/brig/src/Brig/API/Internal.hs +++ b/services/brig/src/Brig/API/Internal.hs @@ -50,7 +50,7 @@ import Brig.Effects.FederationConfigStore import Brig.Effects.FederationConfigStore qualified as E import Brig.Effects.UserPendingActivationStore (UserPendingActivationStore) import Brig.IO.Intra qualified as Intra -import Brig.Options hiding (internalEvents, sesQueue) +import Brig.Options hiding (internalEvents) import Brig.Provider.API qualified as Provider import Brig.Team.API qualified as Team import Brig.Team.DB (lookupInvitationByEmail) @@ -103,6 +103,8 @@ import Wire.API.User.RichInfo import Wire.API.UserEvent import Wire.AuthenticationSubsystem (AuthenticationSubsystem) import Wire.DeleteQueue +import Wire.EmailSending (EmailSending) +import Wire.EmailSmsSubsystem (EmailSmsSubsystem) import Wire.GalleyAPIAccess (GalleyAPIAccess, ShowOrHideInvitationUrl (..)) import Wire.NotificationSubsystem import Wire.Rpc @@ -132,7 +134,9 @@ servantSitemap :: Member UserKeyStore r, Member Rpc r, Member TinyLog r, - Member (UserPendingActivationStore p) r + Member (UserPendingActivationStore p) r, + Member EmailSending r, + Member EmailSmsSubsystem r ) => ServerT BrigIRoutes.API (Handler r) servantSitemap = @@ -181,7 +185,8 @@ accountAPI :: Member TinyLog r, Member (Input (Local ())) r, Member (Input UTCTime) r, - Member (ConnectionStore InternalPaging) r + Member (ConnectionStore InternalPaging) r, + Member EmailSmsSubsystem r ) => ServerT BrigIRoutes.AccountAPI (Handler r) accountAPI = @@ -234,7 +239,8 @@ teamsAPI :: Member TinyLog r, Member (Input (Local ())) r, Member (Input UTCTime) r, - Member (ConnectionStore InternalPaging) r + Member (ConnectionStore InternalPaging) r, + Member EmailSending r ) => ServerT BrigIRoutes.TeamsAPI (Handler r) teamsAPI = @@ -401,7 +407,8 @@ addClientInternalH :: Member TinyLog r, Member (Input (Local ())) r, Member (Input UTCTime) r, - Member (ConnectionStore InternalPaging) r + Member (ConnectionStore InternalPaging) r, + Member EmailSmsSubsystem r ) => UserId -> Maybe Bool -> @@ -523,14 +530,14 @@ deleteUserNoAuthH uid = do AccountAlreadyDeleted -> pure UserResponseAccountAlreadyDeleted AccountDeleted -> pure UserResponseAccountDeleted -changeSelfEmailMaybeSendH :: (Member BlacklistStore r, Member UserKeyStore r) => UserId -> EmailUpdate -> Maybe Bool -> (Handler r) ChangeEmailResponse +changeSelfEmailMaybeSendH :: (Member BlacklistStore r, Member UserKeyStore r, Member EmailSmsSubsystem r) => UserId -> EmailUpdate -> Maybe Bool -> (Handler r) ChangeEmailResponse changeSelfEmailMaybeSendH u body (fromMaybe False -> validate) = do let email = euEmail body changeSelfEmailMaybeSend u (if validate then ActuallySendEmail else DoNotSendEmail) email UpdateOriginScim data MaybeSendEmail = ActuallySendEmail | DoNotSendEmail -changeSelfEmailMaybeSend :: (Member BlacklistStore r, Member UserKeyStore r) => UserId -> MaybeSendEmail -> Email -> UpdateOriginType -> (Handler r) ChangeEmailResponse +changeSelfEmailMaybeSend :: (Member BlacklistStore r, Member UserKeyStore r, Member EmailSmsSubsystem r) => UserId -> MaybeSendEmail -> Email -> UpdateOriginType -> (Handler r) ChangeEmailResponse changeSelfEmailMaybeSend u ActuallySendEmail email allowScim = do API.changeSelfEmail u email allowScim changeSelfEmailMaybeSend u DoNotSendEmail email allowScim = do diff --git a/services/brig/src/Brig/API/Public.hs b/services/brig/src/Brig/API/Public.hs index fe2ca44c642..f363f7f1e9a 100644 --- a/services/brig/src/Brig/API/Public.hs +++ b/services/brig/src/Brig/API/Public.hs @@ -51,7 +51,7 @@ import Brig.Effects.JwtTools (JwtTools) import Brig.Effects.PublicKeyBundle (PublicKeyBundle) import Brig.Effects.SFT import Brig.Effects.UserPendingActivationStore (UserPendingActivationStore) -import Brig.Options hiding (internalEvents, sesQueue) +import Brig.Options hiding (internalEvents) import Brig.Provider.API import Brig.Team.API qualified as Team import Brig.Team.Email qualified as Team @@ -62,7 +62,6 @@ import Brig.User.API.Handle qualified as Handle import Brig.User.API.Search (teamUserSearch) import Brig.User.API.Search qualified as Search import Brig.User.Auth.Cookie qualified as Auth -import Brig.User.Email import Brig.User.Phone import Cassandra qualified as C import Cassandra qualified as Data @@ -156,6 +155,8 @@ import Wire.API.UserMap qualified as Public import Wire.API.Wrapped qualified as Public import Wire.AuthenticationSubsystem (AuthenticationSubsystem, createPasswordResetCode, resetPassword) import Wire.DeleteQueue +import Wire.EmailSending (EmailSending) +import Wire.EmailSmsSubsystem import Wire.GalleyAPIAccess (GalleyAPIAccess) import Wire.GalleyAPIAccess qualified as GalleyAPIAccess import Wire.NotificationSubsystem @@ -302,7 +303,9 @@ servantSitemap :: Member PublicKeyBundle r, Member SFT r, Member TinyLog r, - Member (UserPendingActivationStore p) r + Member (UserPendingActivationStore p) r, + Member EmailSmsSubsystem r, + Member EmailSending r ) => ServerT BrigAPI (Handler r) servantSitemap = @@ -612,7 +615,8 @@ addClient :: Member TinyLog r, Member (Input (Local ())) r, Member (Input UTCTime) r, - Member (ConnectionStore InternalPaging) r + Member (ConnectionStore InternalPaging) r, + Member EmailSmsSubsystem r ) => UserId -> ConnId -> @@ -741,7 +745,9 @@ createUser :: Member UserKeyStore r, Member (Input (Local ())) r, Member (Input UTCTime) r, - Member (ConnectionStore InternalPaging) r + Member (ConnectionStore InternalPaging) r, + Member EmailSmsSubsystem r, + Member EmailSending r ) => Public.NewUserPublic -> (Handler r) (Either Public.RegisterError Public.RegisterSuccess) @@ -795,16 +801,16 @@ createUser (Public.NewUserPublic new) = lift . runExceptT $ do -- pure $ CreateUserResponse cok userId (Public.SelfProfile usr) pure $ Public.RegisterSuccess cok (Public.SelfProfile usr) where - sendActivationEmail :: Public.Email -> Public.Name -> ActivationPair -> Maybe Public.Locale -> Maybe Public.NewTeamUser -> (AppT r) () - sendActivationEmail e u p l mTeamUser + sendActivationEmail :: (Member EmailSmsSubsystem r) => Public.Email -> Public.Name -> ActivationPair -> Maybe Public.Locale -> Maybe Public.NewTeamUser -> (AppT r) () + sendActivationEmail email name (key, code) locale mTeamUser | Just teamUser <- mTeamUser, Public.NewTeamCreator creator <- teamUser, let Public.BindingNewTeamUser (Public.BindingNewTeam team) _ = creator = - sendTeamActivationMail e u p l (fromRange $ team ^. Public.newTeamName) + liftSem $ sendTeamActivationMail email name key code locale (fromRange $ team ^. Public.newTeamName) | otherwise = - sendActivationMail e u p l Nothing + liftSem $ sendActivationMail email name key code locale - sendWelcomeEmail :: Public.Email -> CreateUserTeam -> Public.NewTeamUser -> Maybe Public.Locale -> (AppT r) () + sendWelcomeEmail :: (Member EmailSending r) => Public.Email -> CreateUserTeam -> Public.NewTeamUser -> Maybe Public.Locale -> (AppT r) () -- NOTE: Welcome e-mails for the team creator are not dealt by brig anymore sendWelcomeEmail e (CreateUserTeam t n) newUser l = case newUser of Public.NewTeamCreator _ -> @@ -948,7 +954,9 @@ updateUser uid conn uu = do changePhone :: ( Member BlacklistStore r, Member UserKeyStore r, - Member BlacklistPhonePrefixStore r + Member BlacklistPhonePrefixStore r, + Member (Input (Local ())) r, + Member UserSubsystem r ) => UserId -> ConnId -> @@ -956,7 +964,7 @@ changePhone :: (Handler r) (Maybe Public.ChangePhoneError) changePhone u _ (Public.puPhone -> phone) = lift . exceptTToMaybe $ do (adata, pn) <- API.changePhone u phone - loc <- lift $ wrapClient $ API.lookupLocale u + loc <- lift $ liftSem $ qualifyLocal' u >>= lookupLocaleWithDefault let apair = (activationKey adata, activationCode adata) lift . wrapHttp $ sendActivationSms pn apair loc @@ -1063,12 +1071,8 @@ beginPasswordReset :: (Member AuthenticationSubsystem r) => Public.NewPasswordReset -> Handler r () -beginPasswordReset (Public.NewPasswordReset target) = do - (u, pair) <- lift (liftSem $ createPasswordResetCode (fromEither target)) !>> pwResetError - loc <- lift $ wrapClient $ API.lookupLocale u - lift $ case target of - Left email -> sendPasswordResetMail email pair loc - Right phone -> wrapHttp $ sendPasswordResetSms phone pair loc +beginPasswordReset (Public.NewPasswordReset target) = + lift (liftSem $ createPasswordResetCode (fromEither target)) completePasswordReset :: ( Member AuthenticationSubsystem r @@ -1088,7 +1092,8 @@ sendActivationCode :: ( Member BlacklistStore r, Member BlacklistPhonePrefixStore r, Member UserKeyStore r, - Member GalleyAPIAccess r + Member GalleyAPIAccess r, + Member EmailSmsSubsystem r ) => Public.SendActivationCode -> (Handler r) () @@ -1247,7 +1252,8 @@ deleteSelfUser :: Member PasswordStore r, Member (Input (Local ())) r, Member (Input UTCTime) r, - Member (ConnectionStore InternalPaging) r + Member (ConnectionStore InternalPaging) r, + Member EmailSmsSubsystem r ) => UserId -> Public.DeleteUser -> @@ -1273,7 +1279,8 @@ updateUserEmail :: forall r. ( Member BlacklistStore r, Member UserKeyStore r, - Member GalleyAPIAccess r + Member GalleyAPIAccess r, + Member EmailSmsSubsystem r ) => UserId -> UserId -> @@ -1344,7 +1351,10 @@ activateKey (Public.Activate tgt code dryrun) sendVerificationCode :: forall r. - (Member GalleyAPIAccess r, Member UserKeyStore r) => + ( Member GalleyAPIAccess r, + Member UserKeyStore r, + Member EmailSmsSubsystem r + ) => Public.SendVerificationCode -> (Handler r) () sendVerificationCode req = do @@ -1374,7 +1384,7 @@ sendVerificationCode req = do sendMail :: Public.Email -> Code.Value -> Maybe Public.Locale -> Public.VerificationAction -> (Handler r) () sendMail email value mbLocale = - lift . \case + lift . liftSem . \case Public.CreateScimToken -> sendCreateScimTokenVerificationMail email value mbLocale Public.Login -> sendLoginVerificationMail email value mbLocale Public.DeleteTeam -> sendTeamDeletionVerificationMail email value mbLocale diff --git a/services/brig/src/Brig/API/User.hs b/services/brig/src/Brig/API/User.hs index 086cebebeb6..27c9940dc03 100644 --- a/services/brig/src/Brig/API/User.hs +++ b/services/brig/src/Brig/API/User.hs @@ -39,7 +39,6 @@ module Brig.API.User lookupProfilesV3, getLegalHoldStatus, Data.lookupName, - Data.lookupLocale, Data.lookupUser, Data.lookupRichInfo, Data.lookupRichInfoMultiUsers, @@ -109,7 +108,6 @@ import Brig.Types.Activation (ActivationPair) import Brig.Types.Connection import Brig.Types.Intra import Brig.User.Auth.Cookie qualified as Auth -import Brig.User.Email import Brig.User.Phone import Brig.User.Search.Index (reindex) import Brig.User.Search.TeamSize qualified as TeamSize @@ -160,6 +158,7 @@ import Wire.API.User.RichInfo import Wire.API.UserEvent import Wire.AuthenticationSubsystem (AuthenticationSubsystem, internalLookupPasswordResetCode) import Wire.DeleteQueue +import Wire.EmailSmsSubsystem import Wire.GalleyAPIAccess as GalleyAPIAccess import Wire.NotificationSubsystem import Wire.PasswordStore (PasswordStore, lookupHashedPassword, upsertHashedPassword) @@ -594,24 +593,24 @@ changeManagedBy uid conn (ManagedByUpdate mb) = do -- | Call 'changeEmail' and process result: if email changes to itself, succeed, if not, send -- validation email. -changeSelfEmail :: (Member BlacklistStore r, Member UserKeyStore r) => UserId -> Email -> UpdateOriginType -> ExceptT Error.Error (AppT r) ChangeEmailResponse +changeSelfEmail :: (Member BlacklistStore r, Member UserKeyStore r, Member EmailSmsSubsystem r) => UserId -> Email -> UpdateOriginType -> ExceptT Error.Error (AppT r) ChangeEmailResponse changeSelfEmail u email allowScim = do changeEmail u email allowScim !>> Error.changeEmailError >>= \case ChangeEmailIdempotent -> pure ChangeEmailResponseIdempotent ChangeEmailNeedsActivation (usr, adata, en) -> lift $ do - sendOutEmail usr adata en + liftSem $ sendOutEmail usr adata en wrapClient $ Data.updateEmailUnvalidated u email wrapClient $ reindex u pure ChangeEmailResponseNeedsActivation where sendOutEmail usr adata en = do - sendActivationMail + (maybe sendActivationMail (const sendEmailAddressUpdateMail) usr.userIdentity) en (userDisplayName usr) - (activationKey adata, activationCode adata) + (activationKey adata) + (activationCode adata) (Just (userLocale usr)) - (userIdentity usr) -- | Prepare changing the email (checking a number of invariants). changeEmail :: (Member BlacklistStore r, Member UserKeyStore r) => UserId -> Email -> UpdateOriginType -> ExceptT ChangeEmailError (AppT r) ChangeEmailResult @@ -929,7 +928,8 @@ sendActivationCode :: ( Member BlacklistStore r, Member BlacklistPhonePrefixStore r, Member UserKeyStore r, - Member GalleyAPIAccess r + Member GalleyAPIAccess r, + Member EmailSmsSubsystem r ) => Either Email Phone -> Maybe Locale -> @@ -989,15 +989,16 @@ sendActivationCode emailOrPhone loc call = case emailOrPhone of dat <- Data.newActivation k timeout u pure (activationKey dat, activationCode dat) sendVerificationEmail ek uc = do - p <- wrapClientE $ mkPair ek uc Nothing + (key, code) <- wrapClientE $ mkPair ek uc Nothing void . forEmailKey ek $ \em -> lift $ - sendVerificationMail em p loc + liftSem $ + sendVerificationMail em key code loc sendActivationEmail ek uc uid = do -- FUTUREWORK(fisx): we allow for 'PendingInvitations' here, but I'm not sure this -- top-level function isn't another piece of a deprecated onboarding flow? u <- maybe (notFound uid) pure =<< lift (wrapClient $ Data.lookupUser WithPendingInvitations uid) - p <- wrapClientE $ mkPair ek (Just uc) (Just uid) + (aKey, aCode) <- wrapClientE $ mkPair ek (Just uc) (Just uid) let ident = userIdentity u name = userDisplayName u loc' = loc <|> Just (userLocale u) @@ -1011,9 +1012,9 @@ sendActivationCode emailOrPhone loc call = case emailOrPhone of case mbTeam of Just team | team ^. teamCreator == uid -> - sendTeamActivationMail em name p loc' (team ^. teamName) + liftSem $ sendTeamActivationMail em name aKey aCode loc' (team ^. teamName) _otherwise -> - sendActivationMail em name p loc' ident + liftSem $ (maybe sendActivationMail (const sendEmailAddressUpdateMail) ident) em name aKey aCode loc' mkActivationKey :: (MonadClient m, MonadReader Env m) => ActivationTarget -> ExceptT ActivationError m ActivationKey mkActivationKey (ActivateKey k) = pure k @@ -1079,7 +1080,8 @@ deleteSelfUser :: Member PasswordStore r, Member UserStore r, Member (Input UTCTime) r, - Member (ConnectionStore InternalPaging) r + Member (ConnectionStore InternalPaging) r, + Member EmailSmsSubsystem r ) => UserId -> Maybe PlainTextPassword6 -> @@ -1149,7 +1151,7 @@ deleteSelfUser uid pwd = do let l = userLocale (accountUser a) let n = userDisplayName (accountUser a) either - (\e -> lift $ sendDeletionEmail n e k v l) + (\e -> lift $ liftSem $ sendAccountDeletionEmail e n k v l) (\p -> lift $ wrapHttp $ sendDeletionSms p k v l) target `onException` wrapClientE (Code.delete k Code.AccountDeletion) diff --git a/services/brig/src/Brig/AWS.hs b/services/brig/src/Brig/AWS.hs index dddf1f36e77..48e927124be 100644 --- a/services/brig/src/Brig/AWS.hs +++ b/services/brig/src/Brig/AWS.hs @@ -30,9 +30,6 @@ module Brig.AWS prekeyTable, Error (..), - -- * SES - sendMail, - -- * SQS listen, enqueueFIFO, @@ -47,10 +44,8 @@ where import Amazonka (AWSRequest, AWSResponse) import Amazonka qualified as AWS -import Amazonka.Data.Text qualified as AWS import Amazonka.DynamoDB qualified as DDB import Amazonka.SES qualified as SES -import Amazonka.SES.Lens qualified as SES import Amazonka.SQS qualified as SQS import Amazonka.SQS.Lens qualified as SQS import Brig.Options qualified as Opt @@ -61,18 +56,18 @@ import Control.Retry import Data.Aeson hiding ((.=)) import Data.ByteString.Builder (toLazyByteString) import Data.ByteString.Lazy qualified as BL -import Data.Text qualified as Text import Data.Text.Encoding qualified as Text import Data.UUID hiding (null) import Imports hiding (group) -import Network.HTTP.Client (HttpException (..), HttpExceptionContent (..), Manager) -import Network.HTTP.Types.Status (status400) -import Network.Mail.Mime +import Network.HTTP.Client (Manager) +import Polysemy (runM) +import Polysemy.Input (runInputConst) import System.Logger qualified as Logger import System.Logger.Class import UnliftIO.Async import UnliftIO.Exception import Util.Options +import Wire.AWS data Env = Env { _logger :: !Logger, @@ -190,61 +185,33 @@ listen throttleMillis url callback = forever . handleAny unexpectedError $ do threadDelay 3000000 enqueueStandard :: Text -> BL.ByteString -> Amazon SQS.SendMessageResponse -enqueueStandard url m = retrying retry5x (const canRetry) (const (sendCatch req)) >>= throwA +enqueueStandard url m = retrying retry5x (const $ pure . canRetry) (const (sendCatchAmazon req)) >>= throwA where req = SQS.newSendMessage url $ Text.decodeLatin1 (BL.toStrict m) enqueueFIFO :: Text -> Text -> UUID -> BL.ByteString -> Amazon SQS.SendMessageResponse -enqueueFIFO url group dedup m = retrying retry5x (const canRetry) (const (sendCatch req)) >>= throwA +enqueueFIFO url group dedup m = retrying retry5x (const $ pure . canRetry) (const (sendCatchAmazon req)) >>= throwA where req = SQS.newSendMessage url (Text.decodeLatin1 (BL.toStrict m)) & SQS.sendMessage_messageGroupId ?~ group & SQS.sendMessage_messageDeduplicationId ?~ toText dedup -------------------------------------------------------------------------------- --- SES - -sendMail :: Mail -> Amazon () -sendMail m = do - body <- liftIO $ BL.toStrict <$> renderMail' m - let raw = - SES.newSendRawEmail (SES.newRawMessage body) - & SES.sendRawEmail_destinations ?~ fmap addressEmail (mailTo m) - & SES.sendRawEmail_source ?~ addressEmail (mailFrom m) - resp <- retrying retry5x (const canRetry) $ const (sendCatch raw) - void $ either check pure resp - where - check x = case x of - -- To map rejected domain names by SES to 400 responses, in order - -- not to trigger false 5xx alerts. Upfront domain name validation - -- is only according to the syntax rules of RFC5322 but additional - -- constraints may be applied by email servers (in this case SES). - -- Since such additional constraints are neither standardised nor - -- documented in the cases of SES, we can only handle the errors - -- after the fact. - AWS.ServiceError se - | se - ^. AWS.serviceError_status - == status400 - && "Invalid domain name" - `Text.isPrefixOf` AWS.toText (se ^. AWS.serviceError_code) -> - throwM SESInvalidDomain - _ -> throwM (GeneralError x) - -------------------------------------------------------------------------------- -- Utilities -sendCatch :: (AWSRequest r, Typeable r, Typeable (AWSResponse r)) => r -> Amazon (Either AWS.Error (AWSResponse r)) -sendCatch req = do - env <- view amazonkaEnv - AWS.trying AWS._Error . AWS.send env $ req - send :: (AWSRequest r, Typeable r, Typeable (AWSResponse r)) => r -> Amazon (AWSResponse r) -send r = throwA =<< sendCatch r +send r = throwA =<< sendCatchAmazon r + +-- | Temporary helper to translate polysemy to Amazon monad, it should go away +-- with more polysemisation +sendCatchAmazon :: (AWSRequest req, Typeable req, Typeable (AWSResponse req)) => req -> Amazon (Either AWS.Error (AWS.AWSResponse req)) +sendCatchAmazon req = do + env <- view amazonkaEnv + liftIO . runM . runInputConst env $ sendCatch req throwA :: Either AWS.Error a -> Amazon a throwA = either (throwM . GeneralError) pure @@ -276,12 +243,5 @@ exec :: m (AWSResponse a) exec e cmd = liftIO (execCatch e cmd) >>= either (throwM . GeneralError) pure -canRetry :: (MonadIO m) => Either AWS.Error a -> m Bool -canRetry (Right _) = pure False -canRetry (Left e) = case e of - AWS.TransportError (HttpExceptionRequest _ ResponseTimeout) -> pure True - AWS.ServiceError se | se ^. AWS.serviceError_code == AWS.ErrorCode "RequestThrottled" -> pure True - _ -> pure False - retry5x :: (Monad m) => RetryPolicyM m retry5x = limitRetries 5 <> exponentialBackoff 100000 diff --git a/services/brig/src/Brig/App.hs b/services/brig/src/Brig/App.hs index eee95801d55..f1f522b5e33 100644 --- a/services/brig/src/Brig/App.hs +++ b/services/brig/src/Brig/App.hs @@ -40,6 +40,7 @@ module Brig.App federator, casClient, userTemplates, + usrTemplates, providerTemplates, teamTemplates, templateBranding, @@ -104,10 +105,9 @@ import Brig.Options qualified as Opt import Brig.Provider.Template import Brig.Queue.Stomp qualified as Stomp import Brig.Queue.Types -import Brig.SMTP qualified as SMTP import Brig.Schema.Run qualified as Migrations import Brig.Team.Template -import Brig.Template (Localised, TemplateBranding, forLocale, genTemplateBranding) +import Brig.Template (Localised, genTemplateBranding) import Brig.User.Search.Index (IndexEnv (..), MonadIndexIO (..), runIndexIO) import Brig.User.Template import Brig.ZAuth (MonadZAuth (..), runZAuth) @@ -153,9 +153,11 @@ import System.Logger.Class qualified as LC import System.Logger.Extended qualified as Log import Util.Options import Wire.API.Federation.Error (federationNotImplemented) +import Wire.API.Locale (Locale) import Wire.API.Routes.Version import Wire.API.User.Identity (Email) -import Wire.API.User.Profile (Locale) +import Wire.EmailSending.SMTP qualified as SMTP +import Wire.EmailSmsSubsystem.Template (TemplateBranding, forLocale) import Wire.SessionStore import Wire.SessionStore.Cassandra import Wire.UserKeyStore diff --git a/services/brig/src/Brig/CanonicalInterpreter.hs b/services/brig/src/Brig/CanonicalInterpreter.hs index e49bdd02edc..cbb2e26611d 100644 --- a/services/brig/src/Brig/CanonicalInterpreter.hs +++ b/services/brig/src/Brig/CanonicalInterpreter.hs @@ -1,5 +1,6 @@ module Brig.CanonicalInterpreter where +import Brig.AWS (amazonkaEnv) import Brig.App as App import Brig.DeleteQueue.Interpreter as DQ import Brig.Effects.BlacklistPhonePrefixStore (BlacklistPhonePrefixStore) @@ -18,6 +19,7 @@ import Brig.Effects.UserPendingActivationStore.Cassandra (userPendingActivationS import Brig.IO.Intra (runUserEvents) import Brig.Options (ImplicitNoFederationRestriction (federationDomainConfig), federationDomainConfigs, federationStrategy) import Brig.Options qualified as Opt +import Brig.User.Phone qualified as Brig import Cassandra qualified as Cas import Control.Exception (ErrorCall) import Control.Lens (to, (^.)) @@ -39,6 +41,12 @@ import Wire.API.Federation.Error import Wire.AuthenticationSubsystem import Wire.AuthenticationSubsystem.Interpreter import Wire.DeleteQueue +import Wire.EmailSending +import Wire.EmailSending.SES +import Wire.EmailSending.SMTP +import Wire.EmailSmsSubsystem +import Wire.EmailSmsSubsystem.Interpreter +import Wire.EmailSmsSubsystem.Template (Localised, TemplateBranding, UserTemplates) import Wire.FederationAPIAccess qualified import Wire.FederationAPIAccess.Interpreter (FederationAPIAccessConfig (..), interpretFederationAPIAccess) import Wire.GalleyAPIAccess (GalleyAPIAccess) @@ -74,6 +82,7 @@ import Wire.UserSubsystem.Interpreter type BrigCanonicalEffects = '[ AuthenticationSubsystem, UserSubsystem, + EmailSmsSubsystem, DeleteQueue, UserEvents, Error UserSubsystemError, @@ -105,6 +114,7 @@ type BrigCanonicalEffects = Delay, PasswordResetCodeStore, GalleyAPIAccess, + EmailSending, Rpc, Embed Cas.Client, Error ParseException, @@ -146,6 +156,7 @@ runBrigToIO e (AppT ma) = do . mapError @ParseException SomeException . interpretClientToIO (e ^. casClient) . runRpcWithHttp (e ^. httpManager) (e ^. App.requestId) + . emailSendingInterpreter e . interpretGalleyAPIAccessToRpc (e ^. disabledVersions) (e ^. galleyEndpoint) . passwordResetCodeStoreToCassandra @Cas.Client . runDelay @@ -177,6 +188,7 @@ runBrigToIO e (AppT ma) = do . mapError userSubsystemErrorToWai . runUserEvents . runDeleteQueue (e ^. internalEvents) + . emailSmsSubsystemInterpreter e (e ^. usrTemplates) (e ^. templateBranding) . runUserSubsystem userSubsystemConfig . interpretAuthenticationSubsystem ) @@ -189,3 +201,25 @@ rethrowWaiErrorIO act = do case eithError of Left err -> embedToFinal $ throwM $ err Right a -> pure a + +emailSendingInterpreter :: (Member (Embed IO) r) => Env -> InterpreterFor EmailSending r +emailSendingInterpreter e = do + case (e ^. smtpEnv) of + Just smtp -> emailViaSMTPInterpreter (e ^. applog) smtp + Nothing -> emailViaSESInterpreter (e ^. awsEnv . amazonkaEnv) + +-- FUTUREWORK: Env can be removed once phone users are removed, and then this interpreter should go to wire-subsystems +emailSmsSubsystemInterpreter :: (Member (Final IO) r, Member EmailSending r) => Env -> Localised UserTemplates -> TemplateBranding -> InterpreterFor EmailSmsSubsystem r +emailSmsSubsystemInterpreter e tpls branding = interpret \case + SendPasswordResetMail email (key, code) mLocale -> sendPasswordResetMailImpl tpls branding email key code mLocale + SendPasswordResetSms phone keyCodePair mLocale -> flip runReaderT e $ unAppT $ wrapHttp do + Brig.sendPasswordResetSms phone keyCodePair mLocale + SendVerificationMail email key code mLocale -> sendVerificationMailImpl tpls branding email key code mLocale + SendTeamDeletionVerificationMail email code mLocale -> sendTeamDeletionVerificationMailImpl tpls branding email code mLocale + SendCreateScimTokenVerificationMail email code mLocale -> sendCreateScimTokenVerificationMailImpl tpls branding email code mLocale + SendLoginVerificationMail email code mLocale -> sendLoginVerificationMailImpl tpls branding email code mLocale + SendActivationMail email name key code mLocale -> sendActivationMailImpl tpls branding email name key code mLocale + SendEmailAddressUpdateMail email name key code mLocale -> sendEmailAddressUpdateMailImpl tpls branding email name key code mLocale + SendTeamActivationMail email name key code mLocale teamName -> sendTeamActivationMailImpl tpls branding email name key code mLocale teamName + SendNewClientEmail email name client locale -> sendNewClientEmailImpl tpls branding email name client locale + SendAccountDeletionEmail email name key code locale -> sendAccountDeletionEmailImpl tpls branding email name key code locale diff --git a/services/brig/src/Brig/Code.hs b/services/brig/src/Brig/Code.hs index 7e4aefff3c6..0ceed992ff4 100644 --- a/services/brig/src/Brig/Code.hs +++ b/services/brig/src/Brig/Code.hs @@ -60,8 +60,6 @@ module Brig.Code ) where -import Brig.Email (emailKeyUniq, mkEmailKey) -import Brig.Phone (mkPhoneKey, phoneKeyUniq) import Cassandra hiding (Value) import Data.ByteString qualified as BS import Data.Code @@ -78,6 +76,7 @@ import OpenSSL.Random (randBytes) import Text.Printf (printf) import Wire.API.User qualified as User import Wire.API.User.Identity +import Wire.UserKeyStore -------------------------------------------------------------------------------- -- Code diff --git a/services/brig/src/Brig/Data/User.hs b/services/brig/src/Brig/Data/User.hs index fa25cbebb51..27987c5ce5d 100644 --- a/services/brig/src/Brig/Data/User.hs +++ b/services/brig/src/Brig/Data/User.hs @@ -37,7 +37,6 @@ module Brig.Data.User lookupUser, lookupUsers, lookupName, - lookupLocale, lookupRichInfo, lookupRichInfoMultiUsers, lookupUserTeam, @@ -372,11 +371,6 @@ deactivateUser :: (MonadClient m) => UserId -> m () deactivateUser u = retry x5 $ write userDeactivatedUpdate (params LocalQuorum (Identity u)) -lookupLocale :: (MonadClient m, MonadReader Env m) => UserId -> m (Maybe Locale) -lookupLocale u = do - defLoc <- setDefaultUserLocale <$> view settings - fmap (toLocale defLoc) <$> retry x1 (query1 localeSelect (params LocalQuorum (Identity u))) - lookupName :: (MonadClient m) => UserId -> m (Maybe Name) lookupName u = fmap runIdentity @@ -539,9 +533,6 @@ idSelect = "SELECT id FROM user WHERE id = ?" nameSelect :: PrepQuery R (Identity UserId) (Identity Name) nameSelect = "SELECT name FROM user WHERE id = ?" -localeSelect :: PrepQuery R (Identity UserId) (Maybe Language, Maybe Country) -localeSelect = "SELECT language, country FROM user WHERE id = ?" - authSelect :: PrepQuery R (Identity UserId) (Maybe Password, Maybe AccountStatus) authSelect = "SELECT password, status FROM user WHERE id = ?" diff --git a/services/brig/src/Brig/Email.hs b/services/brig/src/Brig/Email.hs deleted file mode 100644 index d4ec3f4f0f8..00000000000 --- a/services/brig/src/Brig/Email.hs +++ /dev/null @@ -1,72 +0,0 @@ --- This file is part of the Wire Server implementation. --- --- Copyright (C) 2022 Wire Swiss GmbH --- --- This program is free software: you can redistribute it and/or modify it under --- the terms of the GNU Affero General Public License as published by the Free --- Software Foundation, either version 3 of the License, or (at your option) any --- later version. --- --- This program is distributed in the hope that it will be useful, but WITHOUT --- ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS --- FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for more --- details. --- --- You should have received a copy of the GNU Affero General Public License along --- with this program. If not, see . - -module Brig.Email - ( -- * Validation - validateEmail, - - -- * Unique Keys - EmailKey, - mkEmailKey, - emailKeyUniq, - emailKeyOrig, - - -- * Re-exports - Email (..), - - -- * MIME Re-exports - Mail (..), - emptyMail, - plainPart, - htmlPart, - Address (..), - mkMimeAddress, - sendMail, - ) -where - -import Brig.AWS qualified as AWS -import Brig.App (Env, applog, awsEnv, smtpEnv) -import Brig.SMTP qualified as SMTP -import Control.Lens (view) -import Data.Text qualified as Text -import Imports -import Network.Mail.Mime -import Wire.API.User -import Wire.UserKeyStore - -------------------------------------------------------------------------------- -sendMail :: (MonadIO m, MonadReader Env m) => Mail -> m () -sendMail m = - view smtpEnv >>= \case - Just smtp -> view applog >>= \logger -> SMTP.sendMail logger smtp m - Nothing -> view awsEnv >>= \e -> AWS.execute e $ AWS.sendMail m - -------------------------------------------------------------------------------- --- MIME Conversions - --- | Construct a MIME 'Address' from the given display 'Name' and 'Email' --- address that does not exceed 320 bytes in length when rendered for use --- in SMTP, which is a safe limit for most mail servers (including those of --- Amazon SES). The display name is only included if it fits within that --- limit, otherwise it is dropped. -mkMimeAddress :: Name -> Email -> Address -mkMimeAddress name email = - let addr = Address (Just (fromName name)) (fromEmail email) - in if Text.compareLength (renderAddress addr) 320 == GT - then Address Nothing (fromEmail email) - else addr diff --git a/services/brig/src/Brig/Locale.hs b/services/brig/src/Brig/Locale.hs deleted file mode 100644 index 6339895fa2d..00000000000 --- a/services/brig/src/Brig/Locale.hs +++ /dev/null @@ -1,115 +0,0 @@ --- This file is part of the Wire Server implementation. --- --- Copyright (C) 2022 Wire Swiss GmbH --- --- This program is free software: you can redistribute it and/or modify it under --- the terms of the GNU Affero General Public License as published by the Free --- Software Foundation, either version 3 of the License, or (at your option) any --- later version. --- --- This program is distributed in the hope that it will be useful, but WITHOUT --- ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS --- FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for more --- details. --- --- You should have received a copy of the GNU Affero General Public License along --- with this program. If not, see . - -module Brig.Locale - ( timeLocale, - formatDateTime, - deDe, - frFr, - ) -where - -import Data.LanguageCodes (ISO639_1 (DE, FR)) -import Data.Time.Clock (UTCTime) -import Data.Time.Format -import Data.Time.LocalTime (TimeZone (..), utc) -import Imports -import Wire.API.User - -timeLocale :: Locale -> TimeLocale -timeLocale (Locale (Language DE) _) = deDe -timeLocale (Locale (Language FR) _) = frFr -timeLocale _ = defaultTimeLocale - -formatDateTime :: String -> TimeLocale -> UTCTime -> Text -formatDateTime s l = fromString . formatTime l s - -deDe :: TimeLocale -deDe = - TimeLocale - { wDays = - [ ("Sonntag", "Son"), - ("Montag", "Mon"), - ("Dienstag", "Die"), - ("Mittwoch", "Mit"), - ("Donnerstag", "Don"), - ("Freitag", "Fre"), - ("Samstag", "Sam") - ], - months = - [ ("Januar", "Jan"), - ("Februar", "Feb"), - ("März", "Mär"), - ("April", "Apr"), - ("Mai", "Mai"), - ("Juni", "Jun"), - ("Juli", "Jul"), - ("August", "Aug"), - ("September", "Sep"), - ("Oktober", "Okt"), - ("November", "Nov"), - ("Dezember", "Dez") - ], - amPm = ("", ""), - dateTimeFmt = "%d. %B %Y %H:%M:%S %Z", - dateFmt = "%d.%m.%Y", - timeFmt = "%H:%M:%S", - time12Fmt = "%H:%M:%S", - knownTimeZones = - [ utc, - TimeZone 60 False "MEZ", - TimeZone 120 True "MESZ" - ] - } - -frFr :: TimeLocale -frFr = - TimeLocale - { wDays = - [ ("dimanche", "dim"), - ("lundi", "lun"), - ("mardi", "mar"), - ("mercredi", "mer"), - ("jeudi", "jeu"), - ("vendredi", "ven"), - ("samedi", "sam") - ], - months = - [ ("janvier", "jan"), - ("février", "fév"), - ("mars", "mar"), - ("avril", "avr"), - ("mai", "mai"), - ("juin", "jun"), - ("juillet", "jul"), - ("août", "aoû"), - ("septembre", "sep"), - ("octobre", "oct"), - ("novembre", "nov"), - ("décembre", "déc") - ], - amPm = ("", ""), - dateTimeFmt = "%d %B %Y %H h %M %Z", - dateFmt = "%d/%m/%Y", - timeFmt = "%H h %M", - time12Fmt = "%H h %M", - knownTimeZones = - [ utc, - TimeZone 60 False "HNEC", - TimeZone 120 True "HAEC" - ] - } diff --git a/services/brig/src/Brig/Options.hs b/services/brig/src/Brig/Options.hs index 32935e4eb07..b82865c42ad 100644 --- a/services/brig/src/Brig/Options.hs +++ b/services/brig/src/Brig/Options.hs @@ -24,7 +24,6 @@ module Brig.Options where import Brig.Queue.Types (QueueOpts (..)) -import Brig.SMTP (SMTPConnType (..)) import Brig.User.Auth.Cookie.Limit import Brig.ZAuth qualified as ZAuth import Control.Applicative @@ -61,6 +60,7 @@ import Wire.API.Routes.Version import Wire.API.Team.Feature qualified as Public import Wire.API.User import Wire.Arbitrary (Arbitrary, arbitrary) +import Wire.EmailSending.SMTP (SMTPConnType (..)) newtype Timeout = Timeout { timeoutDiff :: NominalDiffTime diff --git a/services/brig/src/Brig/Phone.hs b/services/brig/src/Brig/Phone.hs index 37d874a8552..6f7e79d9265 100644 --- a/services/brig/src/Brig/Phone.hs +++ b/services/brig/src/Brig/Phone.hs @@ -46,7 +46,7 @@ import Control.Monad.Catch import Control.Retry import Data.LanguageCodes import Data.Text qualified as Text -import Data.Time.Clock +import Data.Time.Clock (NominalDiffTime) import Imports import Network.HTTP.Client (HttpException, Manager) import Prometheus qualified as Prom diff --git a/services/brig/src/Brig/Provider/API.hs b/services/brig/src/Brig/Provider/API.hs index f226c052043..66297e3c000 100644 --- a/services/brig/src/Brig/Provider/API.hs +++ b/services/brig/src/Brig/Provider/API.hs @@ -38,7 +38,6 @@ import Brig.App import Brig.Code qualified as Code import Brig.Data.Client qualified as User import Brig.Data.User qualified as User -import Brig.Email (mkEmailKey) import Brig.Options (Settings (..)) import Brig.Options qualified as Opt import Brig.Provider.DB (ServiceConn (..)) @@ -120,9 +119,11 @@ import Wire.API.User.Client qualified as Public (Client, ClientCapability (Clien import Wire.API.User.Client.Prekey qualified as Public (PrekeyId) import Wire.API.User.Identity qualified as Public (Email) import Wire.DeleteQueue +import Wire.EmailSending (EmailSending) import Wire.GalleyAPIAccess (GalleyAPIAccess) import Wire.GalleyAPIAccess qualified as GalleyAPIAccess import Wire.Sem.Concurrency (Concurrency, ConcurrencySafety (Unsafe)) +import Wire.UserKeyStore (mkEmailKey) botAPI :: ( Member GalleyAPIAccess r, @@ -160,7 +161,7 @@ servicesAPI = :<|> Named @"get-whitelisted-services-by-team-id" searchTeamServiceProfiles :<|> Named @"post-team-whitelist-by-team-id" updateServiceWhitelist -providerAPI :: (Member GalleyAPIAccess r) => ServerT ProviderAPI (Handler r) +providerAPI :: (Member GalleyAPIAccess r, Member EmailSending r) => ServerT ProviderAPI (Handler r) providerAPI = Named @"provider-register" newAccount :<|> Named @"provider-activate" activateAccountKey @@ -180,7 +181,7 @@ internalProviderAPI = Named @"get-provider-activation-code" getActivationCodeH -------------------------------------------------------------------------------- -- Public API (Unauthenticated) -newAccount :: (Member GalleyAPIAccess r) => Public.NewProvider -> (Handler r) Public.NewProviderResponse +newAccount :: (Member GalleyAPIAccess r, Member EmailSending r) => Public.NewProvider -> (Handler r) Public.NewProviderResponse newAccount new = do guardSecondFactorDisabled Nothing email <- case validateEmail (Public.newProviderEmail new) of @@ -213,7 +214,7 @@ newAccount new = do lift $ sendActivationMail name email key val False pure $ Public.NewProviderResponse pid newPass -activateAccountKey :: (Member GalleyAPIAccess r) => Code.Key -> Code.Value -> (Handler r) (Maybe Public.ProviderActivationResponse) +activateAccountKey :: (Member GalleyAPIAccess r, Member EmailSending r) => Code.Key -> Code.Value -> (Handler r) (Maybe Public.ProviderActivationResponse) activateAccountKey key val = do guardSecondFactorDisabled Nothing c <- wrapClientE (Code.verify key Code.IdentityVerification val) >>= maybeInvalidCode @@ -257,7 +258,7 @@ login l = do s <- view settings pure $ ProviderTokenCookie (ProviderToken token) (not (setCookieInsecure s)) -beginPasswordReset :: (Member GalleyAPIAccess r) => Public.PasswordReset -> (Handler r) () +beginPasswordReset :: (Member GalleyAPIAccess r, Member EmailSending r) => Public.PasswordReset -> (Handler r) () beginPasswordReset (Public.PasswordReset target) = do guardSecondFactorDisabled Nothing pid <- wrapClientE (DB.lookupKey (mkEmailKey target)) >>= maybeBadCredentials @@ -308,7 +309,7 @@ updateAccountProfile pid upd = do (updateProviderUrl upd) (updateProviderDescr upd) -updateAccountEmail :: (Member GalleyAPIAccess r) => ProviderId -> Public.EmailUpdate -> (Handler r) () +updateAccountEmail :: (Member GalleyAPIAccess r, Member EmailSending r) => ProviderId -> Public.EmailUpdate -> (Handler r) () updateAccountEmail pid (Public.EmailUpdate new) = do guardSecondFactorDisabled Nothing email <- case validateEmail new of diff --git a/services/brig/src/Brig/Provider/DB.hs b/services/brig/src/Brig/Provider/DB.hs index 0ef612f5a1b..98d237c9565 100644 --- a/services/brig/src/Brig/Provider/DB.hs +++ b/services/brig/src/Brig/Provider/DB.hs @@ -17,7 +17,6 @@ module Brig.Provider.DB where -import Brig.Email (EmailKey, emailKeyOrig, emailKeyUniq) import Brig.Types.Instances () import Brig.Types.Provider.Tag import Cassandra as C @@ -35,6 +34,7 @@ import Wire.API.Provider import Wire.API.Provider.Service hiding (updateServiceTags) import Wire.API.Provider.Service.Tag import Wire.API.User +import Wire.UserKeyStore type RangedServiceTags = Range 0 3 (Set.Set ServiceTag) diff --git a/services/brig/src/Brig/Provider/Email.hs b/services/brig/src/Brig/Provider/Email.hs index fcf526b35a8..0f0097bf0b2 100644 --- a/services/brig/src/Brig/Provider/Email.hs +++ b/services/brig/src/Brig/Provider/Email.hs @@ -26,9 +26,7 @@ module Brig.Provider.Email where import Brig.App -import Brig.Email import Brig.Provider.Template -import Brig.Template import Control.Lens (view) import Data.ByteString.Conversion import Data.Code qualified as Code @@ -38,18 +36,23 @@ import Data.Text.Ascii qualified as Ascii import Data.Text.Encoding qualified as Text import Data.Text.Lazy qualified as LT import Imports +import Network.Mail.Mime +import Polysemy import Wire.API.Provider import Wire.API.User +import Wire.EmailSending +import Wire.EmailSmsSubsystem.Interpreter (mkMimeAddress) +import Wire.EmailSmsSubsystem.Template (TemplateBranding, renderHtmlWithBranding, renderTextWithBranding) ------------------------------------------------------------------------------- -- Activation Email -sendActivationMail :: Name -> Email -> Code.Key -> Code.Value -> Bool -> (AppT r) () +sendActivationMail :: (Member EmailSending r) => Name -> Email -> Code.Key -> Code.Value -> Bool -> (AppT r) () sendActivationMail name email key code update = do tpl <- selectTemplate update . snd <$> providerTemplates Nothing branding <- view templateBranding let mail = ActivationEmail email name key code - sendMail $ renderActivationMail mail tpl branding + liftSem $ sendMail $ renderActivationMail mail tpl branding where selectTemplate True = activationEmailUpdate selectTemplate False = activationEmail @@ -96,12 +99,12 @@ renderActivationUrl t (Code.Key k) (Code.Value v) branding = -------------------------------------------------------------------------------- -- Approval Request Email -sendApprovalRequestMail :: Name -> Email -> HttpsUrl -> Text -> Code.Key -> Code.Value -> (AppT r) () +sendApprovalRequestMail :: (Member EmailSending r) => Name -> Email -> HttpsUrl -> Text -> Code.Key -> Code.Value -> (AppT r) () sendApprovalRequestMail name email url descr key val = do tpl <- approvalRequestEmail . snd <$> providerTemplates Nothing branding <- view templateBranding let mail = ApprovalRequestEmail email name url descr key val - sendMail $ renderApprovalRequestMail mail tpl branding + liftSem $ sendMail $ renderApprovalRequestMail mail tpl branding data ApprovalRequestEmail = ApprovalRequestEmail { aprTo :: !Email, @@ -147,12 +150,12 @@ renderApprovalUrl t (Code.Key k) (Code.Value v) branding = -------------------------------------------------------------------------------- -- Approval Confirmation Email -sendApprovalConfirmMail :: Name -> Email -> (AppT r) () +sendApprovalConfirmMail :: (Member EmailSending r) => Name -> Email -> (AppT r) () sendApprovalConfirmMail name email = do tpl <- approvalConfirmEmail . snd <$> providerTemplates Nothing branding <- view templateBranding let mail = ApprovalConfirmEmail email name - sendMail $ renderApprovalConfirmMail mail tpl branding + liftSem $ sendMail $ renderApprovalConfirmMail mail tpl branding data ApprovalConfirmEmail = ApprovalConfirmEmail { apcTo :: !Email, @@ -183,12 +186,12 @@ renderApprovalConfirmMail ApprovalConfirmEmail {..} ApprovalConfirmEmailTemplate -------------------------------------------------------------------------------- -- Password Reset Email -sendPasswordResetMail :: Email -> Code.Key -> Code.Value -> (AppT r) () +sendPasswordResetMail :: (Member EmailSending r) => Email -> Code.Key -> Code.Value -> (AppT r) () sendPasswordResetMail to key code = do tpl <- passwordResetEmail . snd <$> providerTemplates Nothing branding <- view templateBranding let mail = PasswordResetEmail to key code - sendMail $ renderPwResetMail mail tpl branding + liftSem $ sendMail $ renderPwResetMail mail tpl branding data PasswordResetEmail = PasswordResetEmail { pwrTo :: !Email, diff --git a/services/brig/src/Brig/Provider/Template.hs b/services/brig/src/Brig/Provider/Template.hs index e8d56929300..5de44d0a77c 100644 --- a/services/brig/src/Brig/Provider/Template.hs +++ b/services/brig/src/Brig/Provider/Template.hs @@ -26,8 +26,6 @@ module Brig.Provider.Template -- * Re-exports Template, - renderText, - renderHtml, ) where @@ -38,6 +36,7 @@ import Data.Misc (HttpsUrl) import Data.Text.Encoding (encodeUtf8) import Imports import Wire.API.User.Identity +import Wire.EmailSmsSubsystem.Template data ProviderTemplates = ProviderTemplates { activationEmail :: !ActivationEmailTemplate, @@ -47,15 +46,6 @@ data ProviderTemplates = ProviderTemplates passwordResetEmail :: !PasswordResetEmailTemplate } -data ActivationEmailTemplate = ActivationEmailTemplate - { activationEmailUrl :: !Template, - activationEmailSubject :: !Template, - activationEmailBodyText :: !Template, - activationEmailBodyHtml :: !Template, - activationEmailSender :: !Email, - activationEmailSenderName :: !Text - } - data ApprovalRequestEmailTemplate = ApprovalRequestEmailTemplate { approvalRequestEmailUrl :: !Template, approvalRequestEmailSubject :: !Template, @@ -75,15 +65,6 @@ data ApprovalConfirmEmailTemplate = ApprovalConfirmEmailTemplate approvalConfirmEmailHomeUrl :: !HttpsUrl } -data PasswordResetEmailTemplate = PasswordResetEmailTemplate - { passwordResetEmailUrl :: !Template, - passwordResetEmailSubject :: !Template, - passwordResetEmailBodyText :: !Template, - passwordResetEmailBodyHtml :: !Template, - passwordResetEmailSender :: !Email, - passwordResetEmailSenderName :: !Text - } - -- TODO -- data NewServiceEmailTemplate = NewServiceEmailTemplate -- { newServiceEmailSubject :: !Template diff --git a/services/brig/src/Brig/Team/API.hs b/services/brig/src/Brig/Team/API.hs index e5d6133664a..3b342f233c2 100644 --- a/services/brig/src/Brig/Team/API.hs +++ b/services/brig/src/Brig/Team/API.hs @@ -36,7 +36,6 @@ import Brig.Effects.BlacklistStore (BlacklistStore) import Brig.Effects.BlacklistStore qualified as BlacklistStore import Brig.Effects.ConnectionStore (ConnectionStore) import Brig.Effects.UserPendingActivationStore (UserPendingActivationStore) -import Brig.Email qualified as Email import Brig.Options (setMaxTeamSize, setTeamInvitationTimeout) import Brig.Phone qualified as Phone import Brig.Team.DB qualified as DB @@ -78,6 +77,8 @@ import Wire.API.Team.Role import Wire.API.Team.Role qualified as Public import Wire.API.User hiding (fromEmail) import Wire.API.User qualified as Public +import Wire.API.User.Identity qualified as Email +import Wire.EmailSending (EmailSending) import Wire.GalleyAPIAccess (GalleyAPIAccess, ShowOrHideInvitationUrl (..)) import Wire.GalleyAPIAccess qualified as GalleyAPIAccess import Wire.NotificationSubsystem @@ -90,7 +91,8 @@ servantAPI :: ( Member BlacklistStore r, Member GalleyAPIAccess r, Member UserKeyStore r, - Member UserSubsystem r + Member UserSubsystem r, + Member EmailSending r ) => ServerT TeamsAPI (Handler r) servantAPI = @@ -119,7 +121,8 @@ createInvitationPublicH :: ( Member BlacklistStore r, Member GalleyAPIAccess r, Member UserKeyStore r, - Member UserSubsystem r + Member UserSubsystem r, + Member EmailSending r ) => UserId -> TeamId -> @@ -143,7 +146,8 @@ createInvitationPublic :: ( Member BlacklistStore r, Member GalleyAPIAccess r, Member UserKeyStore r, - Member UserSubsystem r + Member UserSubsystem r, + Member EmailSending r ) => UserId -> TeamId -> @@ -173,7 +177,8 @@ createInvitationViaScim :: Member GalleyAPIAccess r, Member UserKeyStore r, Member (UserPendingActivationStore p) r, - Member TinyLog r + Member TinyLog r, + Member EmailSending r ) => TeamId -> NewUserScimInvitation -> @@ -222,7 +227,8 @@ logInvitationRequest context action = createInvitation' :: ( Member BlacklistStore r, Member GalleyAPIAccess r, - Member UserKeyStore r + Member UserKeyStore r, + Member EmailSending r ) => TeamId -> Maybe UserId -> diff --git a/services/brig/src/Brig/Team/DB.hs b/services/brig/src/Brig/Team/DB.hs index b848464e30d..b4129349417 100644 --- a/services/brig/src/Brig/Team/DB.hs +++ b/services/brig/src/Brig/Team/DB.hs @@ -41,7 +41,6 @@ import Brig.App as App import Brig.Data.Types as T import Brig.Options import Brig.Team.Template -import Brig.Template (renderTextWithBranding) import Cassandra as C import Control.Lens (view) import Data.Conduit (runConduit, (.|)) @@ -62,6 +61,7 @@ import UnliftIO.Async (pooledMapConcurrentlyN_) import Wire.API.Team.Invitation hiding (HeadInvitationByEmailResult (..)) import Wire.API.Team.Role import Wire.API.User +import Wire.EmailSmsSubsystem.Template (renderTextWithBranding) import Wire.GalleyAPIAccess (ShowOrHideInvitationUrl (..)) mkInvitationCode :: IO InvitationCode diff --git a/services/brig/src/Brig/Team/Email.hs b/services/brig/src/Brig/Team/Email.hs index a58429f5c5f..837dfa5108a 100644 --- a/services/brig/src/Brig/Team/Email.hs +++ b/services/brig/src/Brig/Team/Email.hs @@ -28,40 +28,41 @@ module Brig.Team.Email where import Brig.App -import Brig.Email -import Brig.Email qualified as Email import Brig.Team.Template -import Brig.Template import Control.Lens (view) import Data.Id (TeamId, idToText) import Data.Text.Ascii qualified as Ascii import Data.Text.Lazy (toStrict) import Imports +import Network.Mail.Mime +import Polysemy import Wire.API.User +import Wire.EmailSending +import Wire.EmailSmsSubsystem.Template (TemplateBranding, renderHtmlWithBranding, renderTextWithBranding) ------------------------------------------------------------------------------- -- Invitation Email -sendInvitationMail :: Email -> TeamId -> Email -> InvitationCode -> Maybe Locale -> (AppT r) () +sendInvitationMail :: (Member EmailSending r) => Email -> TeamId -> Email -> InvitationCode -> Maybe Locale -> (AppT r) () sendInvitationMail to tid from code loc = do tpl <- invitationEmail . snd <$> teamTemplates loc branding <- view templateBranding let mail = InvitationEmail to tid code from - Email.sendMail $ renderInvitationEmail mail tpl branding + liftSem $ sendMail $ renderInvitationEmail mail tpl branding -sendCreatorWelcomeMail :: Email -> TeamId -> Text -> Maybe Locale -> (AppT r) () +sendCreatorWelcomeMail :: (Member EmailSending r) => Email -> TeamId -> Text -> Maybe Locale -> (AppT r) () sendCreatorWelcomeMail to tid teamName loc = do tpl <- creatorWelcomeEmail . snd <$> teamTemplates loc branding <- view templateBranding let mail = CreatorWelcomeEmail to tid teamName - Email.sendMail $ renderCreatorWelcomeMail mail tpl branding + liftSem $ sendMail $ renderCreatorWelcomeMail mail tpl branding -sendMemberWelcomeMail :: Email -> TeamId -> Text -> Maybe Locale -> (AppT r) () +sendMemberWelcomeMail :: (Member EmailSending r) => Email -> TeamId -> Text -> Maybe Locale -> (AppT r) () sendMemberWelcomeMail to tid teamName loc = do tpl <- memberWelcomeEmail . snd <$> teamTemplates loc branding <- view templateBranding let mail = MemberWelcomeEmail to tid teamName - Email.sendMail $ renderMemberWelcomeMail mail tpl branding + liftSem $ sendMail $ renderMemberWelcomeMail mail tpl branding ------------------------------------------------------------------------------- -- Invitation Email diff --git a/services/brig/src/Brig/Team/Template.hs b/services/brig/src/Brig/Team/Template.hs index 568707df45e..32f6f803ad4 100644 --- a/services/brig/src/Brig/Team/Template.hs +++ b/services/brig/src/Brig/Team/Template.hs @@ -24,8 +24,6 @@ module Brig.Team.Template -- * Re-exports Template, - renderText, - renderHtml, ) where diff --git a/services/brig/src/Brig/Template.hs b/services/brig/src/Brig/Template.hs index d66ba6edbfb..4295aa5c709 100644 --- a/services/brig/src/Brig/Template.hs +++ b/services/brig/src/Brig/Template.hs @@ -21,18 +21,12 @@ module Brig.Template ( -- * Reading templates Localised, - forLocale, readLocalesDir, readTemplateWithDefault, readTextWithDefault, -- * Rendering templates - renderText, - renderHtml, - renderTextWithBranding, - renderHtmlWithBranding, genTemplateBranding, - TemplateBranding, -- * Re-exports Template, @@ -46,23 +40,15 @@ import Data.ByteString qualified as BS import Data.Map.Strict qualified as Map import Data.Text (pack, unpack) import Data.Text.Encoding qualified as T -import Data.Text.Lazy qualified as Lazy import Data.Text.Template (Template, template) -import Data.Text.Template qualified as Template -import HTMLEntities.Text qualified as HTML import Imports hiding (readFile) import System.IO.Error (isDoesNotExistError) import Wire.API.User +import Wire.EmailSmsSubsystem.Template (Localised (Localised)) -- | See 'genTemplateBranding'. type TemplateBranding = Text -> Text --- | Localised templates. -data Localised a = Localised - { locDefault :: !(Locale, a), - locOther :: !(Map Locale a) - } - readLocalesDir :: -- | Default locale. Locale -> @@ -92,26 +78,6 @@ readLocalesDir defLocale base typ load = do fromMaybe (error ("Invalid locale: " ++ show l)) $ parseLocale (pack l) --- | Lookup a localised item from a 'Localised' structure. -forLocale :: - -- | 'Just' the preferred locale or 'Nothing' for - -- the default locale. - Maybe Locale -> - -- | The 'Localised' structure. - Localised a -> - -- | Pair of the effectively chosen locale and the - -- associated value. - (Locale, a) -forLocale pref t = case pref of - Just l -> fromMaybe (locDefault t) (select l) - Nothing -> locDefault t - where - select l = - let l' = l {lCountry = Nothing} - loc = Map.lookup l (locOther t) - lan = Map.lookup l' (locOther t) - in (l,) <$> loc <|> (l',) <$> lan - readTemplateWithDefault :: FilePath -> Locale -> @@ -143,24 +109,6 @@ readText f = (readFile f) (\_ -> error $ "Missing file: '" ++ f) --- | Uses a replace and a branding function, to replaces all placeholders from the --- given template to produce a Text. To be used on plain text templates -renderTextWithBranding :: Template -> (Text -> Text) -> TemplateBranding -> Lazy.Text -renderTextWithBranding tpl replace branding = renderText tpl (replace . branding) - --- | Uses a replace and a branding function to replace all placeholders from the --- given template to produce a Text. To be used on HTML templates -renderHtmlWithBranding :: Template -> (Text -> Text) -> TemplateBranding -> Lazy.Text -renderHtmlWithBranding tpl replace branding = renderHtml tpl (replace . branding) - --- TODO: Do not export this function -renderText :: Template -> (Text -> Text) -> Lazy.Text -renderText = Template.render - --- TODO: Do not export this function -renderHtml :: Template -> (Text -> Text) -> Lazy.Text -renderHtml tpl replace = renderText tpl (HTML.text . replace) - readWithDefault :: (String -> IO a) -> FilePath -> diff --git a/services/brig/src/Brig/User/Auth.hs b/services/brig/src/Brig/User/Auth.hs index d2b00159d12..7f0a6c26e8d 100644 --- a/services/brig/src/Brig/User/Auth.hs +++ b/services/brig/src/Brig/User/Auth.hs @@ -46,7 +46,6 @@ import Brig.Data.Client import Brig.Data.LoginCode qualified as Data import Brig.Data.User qualified as Data import Brig.Effects.ConnectionStore (ConnectionStore) -import Brig.Email import Brig.Options qualified as Opt import Brig.Phone import Brig.Types.Intra @@ -86,11 +85,14 @@ import Wire.PasswordStore (PasswordStore, lookupHashedPassword) import Wire.Sem.Paging.Cassandra (InternalPaging) import Wire.UserKeyStore import Wire.UserStore +import Wire.UserSubsystem (UserSubsystem, lookupLocaleWithDefault) sendLoginCode :: ( Member TinyLog r, Member UserKeyStore r, - Member PasswordStore r + Member PasswordStore r, + Member (Input (Local ())) r, + Member UserSubsystem r ) => Phone -> Bool -> @@ -110,8 +112,8 @@ sendLoginCode phone call force = do pw <- lift $ liftSem $ lookupHashedPassword u unless (isNothing pw || force) $ throwE SendLoginPasswordExists + l <- lift $ liftSem $ qualifyLocal' u >>= lookupLocaleWithDefault lift $ wrapHttpClient $ do - l <- Data.lookupLocale u c <- Data.createLoginCode u void . forPhoneKey pk $ \ph -> if call diff --git a/services/brig/src/Brig/User/Email.hs b/services/brig/src/Brig/User/Email.hs deleted file mode 100644 index 0a4a0a92c11..00000000000 --- a/services/brig/src/Brig/User/Email.hs +++ /dev/null @@ -1,438 +0,0 @@ -{-# LANGUAGE RecordWildCards #-} - --- This file is part of the Wire Server implementation. --- --- Copyright (C) 2022 Wire Swiss GmbH --- --- This program is free software: you can redistribute it and/or modify it under --- the terms of the GNU Affero General Public License as published by the Free --- Software Foundation, either version 3 of the License, or (at your option) any --- later version. --- --- This program is distributed in the hope that it will be useful, but WITHOUT --- ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS --- FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for more --- details. --- --- You should have received a copy of the GNU Affero General Public License along --- with this program. If not, see . - -module Brig.User.Email - ( sendActivationMail, - sendVerificationMail, - sendTeamActivationMail, - sendPasswordResetMail, - sendDeletionEmail, - sendNewClientEmail, - sendLoginVerificationMail, - sendCreateScimTokenVerificationMail, - sendTeamDeletionVerificationMail, - - -- * Re-exports - validateEmail, - ) -where - -import Brig.App -import Brig.Email -import Brig.Email qualified as Email -import Brig.Locale (formatDateTime, timeLocale) -import Brig.Template -import Brig.Types.Activation (ActivationPair) -import Brig.User.Template -import Control.Lens (view) -import Data.Code qualified as Code -import Data.Json.Util (fromUTCTimeMillis) -import Data.Range -import Data.Text.Ascii qualified as Ascii -import Data.Text.Lazy (toStrict) -import Imports -import Wire.API.User -import Wire.API.User.Activation -import Wire.API.User.Client -import Wire.API.User.Password - -sendVerificationMail :: - ( MonadIO m, - MonadReader Env m - ) => - Email -> - ActivationPair -> - Maybe Locale -> - m () -sendVerificationMail to pair loc = do - tpl <- verificationEmail . snd <$> userTemplates loc - branding <- view templateBranding - let mail = VerificationEmail to pair - Email.sendMail $ renderVerificationMail mail tpl branding - -sendLoginVerificationMail :: - ( MonadReader Env m, - MonadIO m - ) => - Email -> - Code.Value -> - Maybe Locale -> - m () -sendLoginVerificationMail email code mbLocale = do - tpl <- verificationLoginEmail . snd <$> userTemplates mbLocale - branding <- view templateBranding - Email.sendMail $ renderSecondFactorVerificationEmail tpl email code branding - -sendCreateScimTokenVerificationMail :: - ( MonadIO m, - MonadReader Env m - ) => - Email -> - Code.Value -> - Maybe Locale -> - m () -sendCreateScimTokenVerificationMail email code mbLocale = do - tpl <- verificationScimTokenEmail . snd <$> userTemplates mbLocale - branding <- view templateBranding - Email.sendMail $ renderSecondFactorVerificationEmail tpl email code branding - -sendTeamDeletionVerificationMail :: - ( MonadIO m, - MonadReader Env m - ) => - Email -> - Code.Value -> - Maybe Locale -> - m () -sendTeamDeletionVerificationMail email code mbLocale = do - tpl <- verificationTeamDeletionEmail . snd <$> userTemplates mbLocale - branding <- view templateBranding - Email.sendMail $ renderSecondFactorVerificationEmail tpl email code branding - -sendActivationMail :: - ( MonadIO m, - MonadReader Env m - ) => - Email -> - Name -> - ActivationPair -> - Maybe Locale -> - Maybe UserIdentity -> - m () -sendActivationMail to name pair loc ident = do - tpl <- selectTemplate . snd <$> userTemplates loc - branding <- view templateBranding - let mail = ActivationEmail to name pair - Email.sendMail $ renderActivationMail mail tpl branding - where - selectTemplate = - if isNothing ident - then activationEmail - else activationEmailUpdate - -sendPasswordResetMail :: - ( MonadIO m, - MonadReader Env m - ) => - Email -> - PasswordResetPair -> - Maybe Locale -> - m () -sendPasswordResetMail to pair loc = do - tpl <- passwordResetEmail . snd <$> userTemplates loc - branding <- view templateBranding - let mail = PasswordResetEmail to pair - Email.sendMail $ renderPwResetMail mail tpl branding - -sendDeletionEmail :: - ( MonadIO m, - MonadReader Env m - ) => - Name -> - Email -> - Code.Key -> - Code.Value -> - Locale -> - m () -sendDeletionEmail name email key code locale = do - tpl <- deletionEmail . snd <$> userTemplates (Just locale) - branding <- view templateBranding - Email.sendMail $ renderDeletionEmail tpl (DeletionEmail email name key code) branding - -sendNewClientEmail :: - ( MonadIO m, - MonadReader Env m - ) => - Name -> - Email -> - Client -> - Locale -> - m () -sendNewClientEmail name email client locale = do - tpl <- newClientEmail . snd <$> userTemplates (Just locale) - branding <- view templateBranding - Email.sendMail $ renderNewClientEmail tpl (NewClientEmail locale email name client) branding - -sendTeamActivationMail :: - ( MonadIO m, - MonadReader Env m - ) => - Email -> - Name -> - ActivationPair -> - Maybe Locale -> - Text -> - m () -sendTeamActivationMail to name pair loc team = do - tpl <- teamActivationEmail . snd <$> userTemplates loc - let mail = TeamActivationEmail to name team pair - branding <- view templateBranding - Email.sendMail $ renderTeamActivationMail mail tpl branding - -------------------------------------------------------------------------------- --- New Client Email - -data NewClientEmail = NewClientEmail - { nclLocale :: !Locale, - nclTo :: !Email, - nclName :: !Name, - nclClient :: !Client - } - -renderNewClientEmail :: NewClientEmailTemplate -> NewClientEmail -> TemplateBranding -> Mail -renderNewClientEmail NewClientEmailTemplate {..} NewClientEmail {..} branding = - (emptyMail from) - { mailTo = [to], - mailHeaders = - [ ("Subject", toStrict subj), - ("X-Zeta-Purpose", "NewDevice") - ], - mailParts = [[plainPart txt, htmlPart html]] - } - where - from = Address (Just newClientEmailSenderName) (fromEmail newClientEmailSender) - to = mkMimeAddress nclName nclTo - txt = renderTextWithBranding newClientEmailBodyText replace branding - html = renderHtmlWithBranding newClientEmailBodyHtml replace branding - subj = renderTextWithBranding newClientEmailSubject replace branding - replace "name" = fromName nclName - replace "label" = fromMaybe "N/A" (clientLabel nclClient) - replace "model" = fromMaybe "N/A" (clientModel nclClient) - replace "date" = - formatDateTime - "%A %e %B %Y, %H:%M - %Z" - (timeLocale nclLocale) - (fromUTCTimeMillis $ clientTime nclClient) - replace x = x - -------------------------------------------------------------------------------- --- Deletion Email - -data DeletionEmail = DeletionEmail - { delTo :: !Email, - delName :: !Name, - delKey :: !Code.Key, - delCode :: !Code.Value - } - -renderDeletionEmail :: DeletionEmailTemplate -> DeletionEmail -> TemplateBranding -> Mail -renderDeletionEmail DeletionEmailTemplate {..} DeletionEmail {..} branding = - (emptyMail from) - { mailTo = [to], - mailHeaders = - [ ("Subject", toStrict subj), - ("X-Zeta-Purpose", "Delete"), - ("X-Zeta-Key", key), - ("X-Zeta-Code", code) - ], - mailParts = [[plainPart txt, htmlPart html]] - } - where - from = Address (Just deletionEmailSenderName) (fromEmail deletionEmailSender) - to = mkMimeAddress delName delTo - txt = renderTextWithBranding deletionEmailBodyText replace1 branding - html = renderHtmlWithBranding deletionEmailBodyHtml replace1 branding - subj = renderTextWithBranding deletionEmailSubject replace1 branding - key = Ascii.toText (fromRange (Code.asciiKey delKey)) - code = Ascii.toText (fromRange (Code.asciiValue delCode)) - replace1 "url" = toStrict (renderTextWithBranding deletionEmailUrl replace2 branding) - replace1 "email" = fromEmail delTo - replace1 "name" = fromName delName - replace1 x = x - replace2 "key" = key - replace2 "code" = code - replace2 x = x - -------------------------------------------------------------------------------- --- Verification Email - -data VerificationEmail = VerificationEmail - { vfTo :: !Email, - vfPair :: !ActivationPair - } - -renderVerificationMail :: VerificationEmail -> VerificationEmailTemplate -> TemplateBranding -> Mail -renderVerificationMail VerificationEmail {..} VerificationEmailTemplate {..} branding = - (emptyMail from) - { mailTo = [to], - -- To make automated processing possible, the activation code is also added to - -- headers. {#RefActivationEmailHeaders} - mailHeaders = - [ ("Subject", toStrict subj), - ("X-Zeta-Purpose", "Verification"), - ("X-Zeta-Code", Ascii.toText code) - ], - mailParts = [[plainPart txt, htmlPart html]] - } - where - (ActivationKey _, ActivationCode code) = vfPair - from = Address (Just verificationEmailSenderName) (fromEmail verificationEmailSender) - to = Address Nothing (fromEmail vfTo) - txt = renderTextWithBranding verificationEmailBodyText replace branding - html = renderHtmlWithBranding verificationEmailBodyHtml replace branding - subj = renderTextWithBranding verificationEmailSubject replace branding - replace "code" = Ascii.toText code - replace "email" = fromEmail vfTo - replace x = x - -------------------------------------------------------------------------------- --- Activation Email - -data ActivationEmail = ActivationEmail - { acmTo :: !Email, - acmName :: !Name, - acmPair :: !ActivationPair - } - -renderActivationMail :: ActivationEmail -> ActivationEmailTemplate -> TemplateBranding -> Mail -renderActivationMail ActivationEmail {..} ActivationEmailTemplate {..} branding = - (emptyMail from) - { mailTo = [to], - -- To make automated processing possible, the activation code is also added to - -- headers. {#RefActivationEmailHeaders} - mailHeaders = - [ ("Subject", toStrict subj), - ("X-Zeta-Purpose", "Activation"), - ("X-Zeta-Key", Ascii.toText key), - ("X-Zeta-Code", Ascii.toText code) - ], - mailParts = [[plainPart txt, htmlPart html]] - } - where - (ActivationKey key, ActivationCode code) = acmPair - from = Address (Just activationEmailSenderName) (fromEmail activationEmailSender) - to = mkMimeAddress acmName acmTo - txt = renderTextWithBranding activationEmailBodyText replace branding - html = renderHtmlWithBranding activationEmailBodyHtml replace branding - subj = renderTextWithBranding activationEmailSubject replace branding - replace "url" = renderActivationUrl activationEmailUrl acmPair branding - replace "email" = fromEmail acmTo - replace "name" = fromName acmName - replace x = x - -renderActivationUrl :: Template -> ActivationPair -> TemplateBranding -> Text -renderActivationUrl t (ActivationKey k, ActivationCode c) branding = - toStrict $ renderTextWithBranding t replace branding - where - replace "key" = Ascii.toText k - replace "code" = Ascii.toText c - replace x = x - -------------------------------------------------------------------------------- --- Team Activation Email - -data TeamActivationEmail = TeamActivationEmail - { tacmTo :: !Email, - tacmName :: !Name, - tacmTeamName :: !Text, - tacmPair :: !ActivationPair - } - -renderTeamActivationMail :: TeamActivationEmail -> TeamActivationEmailTemplate -> TemplateBranding -> Mail -renderTeamActivationMail TeamActivationEmail {..} TeamActivationEmailTemplate {..} branding = - (emptyMail from) - { mailTo = [to], - mailHeaders = - [ ("Subject", toStrict subj), - ("X-Zeta-Purpose", "Activation"), - ("X-Zeta-Key", Ascii.toText key), - ("X-Zeta-Code", Ascii.toText code) - ], - mailParts = [[plainPart txt, htmlPart html]] - } - where - (ActivationKey key, ActivationCode code) = tacmPair - from = Address (Just teamActivationEmailSenderName) (fromEmail teamActivationEmailSender) - to = mkMimeAddress tacmName tacmTo - txt = renderTextWithBranding teamActivationEmailBodyText replace branding - html = renderHtmlWithBranding teamActivationEmailBodyHtml replace branding - subj = renderTextWithBranding teamActivationEmailSubject replace branding - replace "url" = renderActivationUrl teamActivationEmailUrl tacmPair branding - replace "email" = fromEmail tacmTo - replace "name" = fromName tacmName - replace "team" = tacmTeamName - replace x = x - -------------------------------------------------------------------------------- --- Password Reset Email - -data PasswordResetEmail = PasswordResetEmail - { pwrTo :: !Email, - pwrPair :: !PasswordResetPair - } - -renderPwResetMail :: PasswordResetEmail -> PasswordResetEmailTemplate -> TemplateBranding -> Mail -renderPwResetMail PasswordResetEmail {..} PasswordResetEmailTemplate {..} branding = - (emptyMail from) - { mailTo = [to], - mailHeaders = - [ ("Subject", toStrict subj), - ("X-Zeta-Purpose", "PasswordReset"), - ("X-Zeta-Key", Ascii.toText key), - ("X-Zeta-Code", Ascii.toText code) - ], - mailParts = [[plainPart txt, htmlPart html]] - } - where - (PasswordResetKey key, PasswordResetCode code) = pwrPair - from = Address (Just passwordResetEmailSenderName) (fromEmail passwordResetEmailSender) - to = Address Nothing (fromEmail pwrTo) - txt = renderTextWithBranding passwordResetEmailBodyText replace branding - html = renderHtmlWithBranding passwordResetEmailBodyHtml replace branding - subj = renderTextWithBranding passwordResetEmailSubject replace branding - replace "url" = renderPwResetUrl passwordResetEmailUrl pwrPair branding - replace x = x - -renderPwResetUrl :: Template -> PasswordResetPair -> TemplateBranding -> Text -renderPwResetUrl t (PasswordResetKey k, PasswordResetCode c) branding = - toStrict $ renderTextWithBranding t replace branding - where - replace "key" = Ascii.toText k - replace "code" = Ascii.toText c - replace x = x - -------------------------------------------------------------------------------- --- Second Factor Verification Code Email - -renderSecondFactorVerificationEmail :: - SecondFactorVerificationEmailTemplate -> - Email -> - Code.Value -> - TemplateBranding -> - Mail -renderSecondFactorVerificationEmail SecondFactorVerificationEmailTemplate {..} email codeValue branding = - (emptyMail from) - { mailTo = [to], - mailHeaders = - [ ("Subject", toStrict subj), - ("X-Zeta-Purpose", "SecondFactorVerification"), - ("X-Zeta-Code", code) - ], - mailParts = [[plainPart txt, htmlPart html]] - } - where - from = Address (Just sndFactorVerificationEmailSenderName) (fromEmail sndFactorVerificationEmailSender) - to = Address Nothing (fromEmail email) - txt = renderTextWithBranding sndFactorVerificationEmailBodyText replace branding - html = renderHtmlWithBranding sndFactorVerificationEmailBodyHtml replace branding - subj = renderTextWithBranding sndFactorVerificationEmailSubject replace branding - code = Ascii.toText (fromRange (Code.asciiValue codeValue)) - replace "email" = fromEmail email - replace "code" = code - replace x = x diff --git a/services/brig/src/Brig/User/Phone.hs b/services/brig/src/Brig/User/Phone.hs index f05880eeae5..8616c000ea2 100644 --- a/services/brig/src/Brig/User/Phone.hs +++ b/services/brig/src/Brig/User/Phone.hs @@ -50,6 +50,7 @@ import Data.Range import Data.Text qualified as Text import Data.Text.Ascii qualified as Ascii import Data.Text.Lazy (toStrict) +import Data.Text.Template (render) import Imports import Prometheus (MonadMonitor) import Ropes.Nexmo qualified as Nexmo @@ -58,6 +59,7 @@ import Wire.API.User import Wire.API.User.Activation import Wire.API.User.Auth import Wire.API.User.Password +import Wire.EmailSmsSubsystem.Template (TemplateBranding, renderTextWithBranding) sendActivationSms :: ( MonadClient m, @@ -216,7 +218,7 @@ renderDeletionSms DeletionSms {..} (DeletionSmsTemplate url txt from) branding = SMSMessage from (fromPhone delSmsTo) (toStrict $ renderTextWithBranding txt replace1 branding) where replace1 "code" = Ascii.toText (fromRange (Code.asciiValue delSmsCode)) - replace1 "url" = toStrict (renderText url replace2) + replace1 "url" = toStrict (render url replace2) replace1 x = x replace2 "key" = Ascii.toText (fromRange (Code.asciiKey delSmsKey)) replace2 "code" = Ascii.toText (fromRange (Code.asciiValue delSmsCode)) @@ -271,7 +273,7 @@ toPinPrompt = Text.intercalate "" . Text.chunksOf 1 renderSmsActivationUrl :: Template -> Text -> Text renderSmsActivationUrl t c = - toStrict $ renderText t replace + toStrict $ render t replace where replace "code" = c replace x = x diff --git a/services/brig/src/Brig/User/Template.hs b/services/brig/src/Brig/User/Template.hs index 0acc0fe5c40..fb035d90339 100644 --- a/services/brig/src/Brig/User/Template.hs +++ b/services/brig/src/Brig/User/Template.hs @@ -34,126 +34,13 @@ module Brig.User.Template -- * Re-exports Template, - renderText, - renderHtml, ) where import Brig.Options qualified as Opt import Brig.Template import Imports -import Wire.API.User.Identity - -data UserTemplates = UserTemplates - { activationSms :: !ActivationSmsTemplate, - activationCall :: !ActivationCallTemplate, - verificationEmail :: !VerificationEmailTemplate, - activationEmail :: !ActivationEmailTemplate, - activationEmailUpdate :: !ActivationEmailTemplate, - teamActivationEmail :: !TeamActivationEmailTemplate, - passwordResetSms :: !PasswordResetSmsTemplate, - passwordResetEmail :: !PasswordResetEmailTemplate, - loginSms :: !LoginSmsTemplate, - loginCall :: !LoginCallTemplate, - deletionSms :: !DeletionSmsTemplate, - deletionEmail :: !DeletionEmailTemplate, - newClientEmail :: !NewClientEmailTemplate, - verificationLoginEmail :: !SecondFactorVerificationEmailTemplate, - verificationScimTokenEmail :: !SecondFactorVerificationEmailTemplate, - verificationTeamDeletionEmail :: !SecondFactorVerificationEmailTemplate - } - -data ActivationSmsTemplate = ActivationSmsTemplate - { activationSmslUrl :: !Template, - activationSmsText :: !Template, - activationSmsSender :: !Text - } - -data ActivationCallTemplate = ActivationCallTemplate - { activationCallText :: !Template - } - -data VerificationEmailTemplate = VerificationEmailTemplate - { verificationEmailUrl :: !Template, - verificationEmailSubject :: !Template, - verificationEmailBodyText :: !Template, - verificationEmailBodyHtml :: !Template, - verificationEmailSender :: !Email, - verificationEmailSenderName :: !Text - } - -data ActivationEmailTemplate = ActivationEmailTemplate - { activationEmailUrl :: !Template, - activationEmailSubject :: !Template, - activationEmailBodyText :: !Template, - activationEmailBodyHtml :: !Template, - activationEmailSender :: !Email, - activationEmailSenderName :: !Text - } - -data TeamActivationEmailTemplate = TeamActivationEmailTemplate - { teamActivationEmailUrl :: !Template, - teamActivationEmailSubject :: !Template, - teamActivationEmailBodyText :: !Template, - teamActivationEmailBodyHtml :: !Template, - teamActivationEmailSender :: !Email, - teamActivationEmailSenderName :: !Text - } - -data DeletionEmailTemplate = DeletionEmailTemplate - { deletionEmailUrl :: !Template, - deletionEmailSubject :: !Template, - deletionEmailBodyText :: !Template, - deletionEmailBodyHtml :: !Template, - deletionEmailSender :: !Email, - deletionEmailSenderName :: !Text - } - -data PasswordResetEmailTemplate = PasswordResetEmailTemplate - { passwordResetEmailUrl :: !Template, - passwordResetEmailSubject :: !Template, - passwordResetEmailBodyText :: !Template, - passwordResetEmailBodyHtml :: !Template, - passwordResetEmailSender :: !Email, - passwordResetEmailSenderName :: !Text - } - -data PasswordResetSmsTemplate = PasswordResetSmsTemplate - { passwordResetSmsText :: !Template, - passwordResetSmsSender :: !Text - } - -data LoginSmsTemplate = LoginSmsTemplate - { loginSmsUrl :: !Template, - loginSmsText :: !Template, - loginSmsSender :: !Text - } - -data LoginCallTemplate = LoginCallTemplate - { loginCallText :: !Template - } - -data DeletionSmsTemplate = DeletionSmsTemplate - { deletionSmsUrl :: !Template, - deletionSmsText :: !Template, - deletionSmsSender :: !Text - } - -data NewClientEmailTemplate = NewClientEmailTemplate - { newClientEmailSubject :: !Template, - newClientEmailBodyText :: !Template, - newClientEmailBodyHtml :: !Template, - newClientEmailSender :: !Email, - newClientEmailSenderName :: !Text - } - -data SecondFactorVerificationEmailTemplate = SecondFactorVerificationEmailTemplate - { sndFactorVerificationEmailSubject :: !Template, - sndFactorVerificationEmailBodyText :: !Template, - sndFactorVerificationEmailBodyHtml :: !Template, - sndFactorVerificationEmailSender :: !Email, - sndFactorVerificationEmailSenderName :: !Text - } +import Wire.EmailSmsSubsystem.Template loadUserTemplates :: Opt.Opts -> IO (Localised UserTemplates) loadUserTemplates o = readLocalesDir defLocale templateDir "user" $ \fp -> diff --git a/services/brig/test/integration/SMTP.hs b/services/brig/test/integration/SMTP.hs index 4b77600a328..4911ffbcebc 100644 --- a/services/brig/test/integration/SMTP.hs +++ b/services/brig/test/integration/SMTP.hs @@ -1,11 +1,8 @@ {-# OPTIONS_GHC -Wno-deferred-out-of-scope-variables #-} --- Disabling to stop warnings on HasCallStack -{-# OPTIONS_GHC -Wno-redundant-constraints #-} module SMTP where import Bilge qualified -import Brig.SMTP import Control.Exception import Data.Bifunctor import Data.ByteString qualified as B @@ -20,11 +17,15 @@ import Network.Mail.Mime import Network.Mail.Postie qualified as Postie import Network.Socket import Pipes.Prelude qualified +import Polysemy import System.Logger qualified as Logger import Test.Tasty import Test.Tasty.HUnit import Util +import Wire.EmailSending +import Wire.EmailSending.SMTP +-- FUTUREWORK: Move all these tests to unit tests for the emailViaSMTPInterpreter tests :: Bilge.Manager -> Logger.Logger -> TestTree tests m lg = testGroup @@ -47,7 +48,7 @@ testSendMail lg = do withMailServer sock (mailStoringApp receivedMailRef) $ do conPool <- initSMTP lg "localhost" (Just port) Nothing Plain - sendMail lg conPool someTestMail + _ <- runM . emailViaSMTPInterpreter lg conPool $ sendMail someTestMail mbMail <- retryWhileN 3 isJust $ do readIORef receivedMailRef @@ -84,7 +85,7 @@ testSendMailNoReceiver lg = do caughtException <- handle @SomeException (const (pure True)) - (sendMail' @Second 1 lg conPool (emptyMail (Address Nothing "foo@example.com")) >> pure False) + (sendMailWithDuration @Second 1 lg conPool (emptyMail (Address Nothing "foo@example.com")) >> pure False) caughtException @? "Expected exception due to missing mail receiver." testSendMailTransactionFailed :: Logger.Logger -> Bilge.Http () @@ -98,7 +99,7 @@ testSendMailTransactionFailed lg = do caughtException <- handle @SomeException (const (pure True)) - (sendMail lg conPool someTestMail >> pure False) + (runM . emailViaSMTPInterpreter lg conPool $ sendMail someTestMail >> pure False) caughtException @? "Expected exception due to missing mail receiver." testSendMailFailingConnectionOnStartup :: Logger.Logger -> Bilge.Http () @@ -127,7 +128,7 @@ testSendMailFailingConnectionOnSend lg = do liftIO $ handle @SomeException (const (pure True)) - (sendMail lg conPool someTestMail >> pure False) + (runM . emailViaSMTPInterpreter lg conPool $ sendMail someTestMail >> pure False) liftIO $ caughtException @? "Expected exception (SMTP server unreachable.)" mbMail <- liftIO $ readIORef receivedMailRef liftIO $ isNothing mbMail @? "No mail expected (if there is one, the test setup is broken.)" @@ -143,7 +144,7 @@ testSendMailTimeout lg = do conPool <- initSMTP lg "localhost" (Just port) Nothing Plain handle @SMTPPoolException (\e -> pure (Just e)) - (sendMail' (500 :: Millisecond) lg conPool someTestMail >> pure Nothing) + (sendMailWithDuration (500 :: Millisecond) lg conPool someTestMail >> pure Nothing) liftIO $ isJust mbException @? "Expected exception (SMTP server action timed out.)" liftIO $ mbException @?= Just SMTPConnectionTimeout @@ -224,7 +225,7 @@ delayingApp delay = $> Postie.Accepted ) -everDelayingTCPServer :: (HasCallStack) => Socket -> IO a -> IO a +everDelayingTCPServer :: Socket -> IO a -> IO a everDelayingTCPServer sock action = listen sock 1024 >> action withRandomPortAndSocket :: (MonadIO m) => ((PortNumber, Socket) -> IO a) -> m a diff --git a/services/spar/src/Spar/Intra/Brig.hs b/services/spar/src/Spar/Intra/Brig.hs index c98333d8a4d..aaac39be64b 100644 --- a/services/spar/src/Spar/Intra/Brig.hs +++ b/services/spar/src/Spar/Intra/Brig.hs @@ -62,6 +62,7 @@ import qualified SAML2.WebSSO as SAML import Spar.Error import qualified System.Logger.Class as Log import Web.Cookie +import Wire.API.Locale import Wire.API.Team.Role (Role) import Wire.API.User import Wire.API.User.Auth.ReAuth diff --git a/services/spar/src/Spar/Sem/BrigAccess.hs b/services/spar/src/Spar/Sem/BrigAccess.hs index 450edf7564e..1936116030f 100644 --- a/services/spar/src/Spar/Sem/BrigAccess.hs +++ b/services/spar/src/Spar/Sem/BrigAccess.hs @@ -53,6 +53,7 @@ import Imports import Polysemy import qualified SAML2.WebSSO as SAML import Web.Cookie +import Wire.API.Locale import Wire.API.Team.Role import Wire.API.User (AccountStatus (..), DeleteUserResult, VerificationAction) import Wire.API.User.Identity diff --git a/tools/db/inconsistencies/default.nix b/tools/db/inconsistencies/default.nix index 2f99a6c37ed..9e1586be4a8 100644 --- a/tools/db/inconsistencies/default.nix +++ b/tools/db/inconsistencies/default.nix @@ -5,7 +5,6 @@ { mkDerivation , aeson , base -, brig , bytestring , cassandra-util , conduit @@ -31,7 +30,6 @@ mkDerivation { executableHaskellDepends = [ aeson base - brig bytestring cassandra-util conduit diff --git a/tools/db/inconsistencies/inconsistencies.cabal b/tools/db/inconsistencies/inconsistencies.cabal index cb12446f727..bbc9a5c8f1f 100644 --- a/tools/db/inconsistencies/inconsistencies.cabal +++ b/tools/db/inconsistencies/inconsistencies.cabal @@ -71,7 +71,6 @@ executable inconsistencies build-depends: aeson , base - , brig , bytestring , cassandra-util , conduit diff --git a/tools/db/inconsistencies/src/EmailLessUsers.hs b/tools/db/inconsistencies/src/EmailLessUsers.hs index 1fba919d813..1c4e73f11b6 100644 --- a/tools/db/inconsistencies/src/EmailLessUsers.hs +++ b/tools/db/inconsistencies/src/EmailLessUsers.hs @@ -21,7 +21,6 @@ module EmailLessUsers where -import Brig.Email import Cassandra import Cassandra.Util import Conduit From 67a5f680fc46f58ecdfaad0291eab3c2ef9fbd35 Mon Sep 17 00:00:00 2001 From: Leif Battermann Date: Tue, 2 Jul 2024 16:56:21 +0200 Subject: [PATCH 54/64] WPB-5491 Log password reset errors instead of propagating them (#4114) --- changelog.d/3-bug-fixes/WPB-5491 | 1 + .../src/Wire/API/Routes/Public/Brig.hs | 2 - .../src/Wire/AuthenticationSubsystem/Error.hs | 4 -- .../AuthenticationSubsystem/Interpreter.hs | 71 ++++++++++++------- .../InterpreterSpec.hs | 22 ++++-- .../integration/API/User/PasswordReset.hs | 9 ++- 6 files changed, 68 insertions(+), 41 deletions(-) create mode 100644 changelog.d/3-bug-fixes/WPB-5491 diff --git a/changelog.d/3-bug-fixes/WPB-5491 b/changelog.d/3-bug-fixes/WPB-5491 new file mode 100644 index 00000000000..4e1a919a248 --- /dev/null +++ b/changelog.d/3-bug-fixes/WPB-5491 @@ -0,0 +1 @@ +Log password reset errors instead of propagating them diff --git a/libs/wire-api/src/Wire/API/Routes/Public/Brig.hs b/libs/wire-api/src/Wire/API/Routes/Public/Brig.hs index b90650fe891..998c882eebd 100644 --- a/libs/wire-api/src/Wire/API/Routes/Public/Brig.hs +++ b/libs/wire-api/src/Wire/API/Routes/Public/Brig.hs @@ -565,8 +565,6 @@ type AccountAPI = :<|> Named "post-password-reset" ( Summary "Initiate a password reset." - :> CanThrow 'PasswordResetInProgress - :> CanThrow 'InvalidPasswordResetKey :> "password-reset" :> ReqBody '[JSON] NewPasswordReset :> MultiVerb 'POST '[JSON] '[RespondEmpty 201 "Password reset code created and sent by email."] () diff --git a/libs/wire-subsystems/src/Wire/AuthenticationSubsystem/Error.hs b/libs/wire-subsystems/src/Wire/AuthenticationSubsystem/Error.hs index 739cd8c25f8..455f1563a44 100644 --- a/libs/wire-subsystems/src/Wire/AuthenticationSubsystem/Error.hs +++ b/libs/wire-subsystems/src/Wire/AuthenticationSubsystem/Error.hs @@ -27,10 +27,8 @@ import Wire.API.Error.Brig qualified as E data AuthenticationSubsystemError = AuthenticationSubsystemInvalidPasswordResetKey - | AuthenticationSubsystemPasswordResetInProgress | AuthenticationSubsystemResetPasswordMustDiffer | AuthenticationSubsystemInvalidPasswordResetCode - | AuthenticationSubsystemAllowListError deriving (Eq, Show) instance Exception AuthenticationSubsystemError @@ -39,7 +37,5 @@ authenticationSubsystemErrorToWai :: AuthenticationSubsystemError -> Wai.Error authenticationSubsystemErrorToWai = dynErrorToWai . \case AuthenticationSubsystemInvalidPasswordResetKey -> dynError @(MapError E.InvalidPasswordResetKey) - AuthenticationSubsystemPasswordResetInProgress -> dynError @(MapError E.PasswordResetInProgress) AuthenticationSubsystemInvalidPasswordResetCode -> dynError @(MapError E.InvalidPasswordResetCode) AuthenticationSubsystemResetPasswordMustDiffer -> dynError @(MapError E.ResetPasswordMustDiffer) - AuthenticationSubsystemAllowListError -> dynError @(MapError E.AllowlistError) diff --git a/libs/wire-subsystems/src/Wire/AuthenticationSubsystem/Interpreter.hs b/libs/wire-subsystems/src/Wire/AuthenticationSubsystem/Interpreter.hs index f71355610ad..dd2489ccd4a 100644 --- a/libs/wire-subsystems/src/Wire/AuthenticationSubsystem/Interpreter.hs +++ b/libs/wire-subsystems/src/Wire/AuthenticationSubsystem/Interpreter.hs @@ -78,42 +78,65 @@ maxAttempts = 3 passwordResetCodeTtl :: NominalDiffTime passwordResetCodeTtl = 3600 -- 60 minutes +-- This type is not exported and used for internal control flow only +data PasswordResetError + = AllowListError + | InvalidResetKey + | InProgress + deriving (Show) + +instance Exception PasswordResetError where + displayException AllowListError = "email domain is not allowed for password reset" + displayException InvalidResetKey = "invalid reset key for password reset" + displayException InProgress = "password reset already in progress" + createPasswordResetCodeImpl :: + forall r. ( Member PasswordResetCodeStore r, Member Now r, Member (Input (Local ())) r, Member (Input (Maybe AllowlistEmailDomains)) r, Member (Input (Maybe AllowlistPhonePrefixes)) r, - Member (Error AuthenticationSubsystemError) r, Member TinyLog r, Member UserSubsystem r, Member EmailSmsSubsystem r ) => UserKey -> Sem r () -createPasswordResetCodeImpl target = do - allowListOk <- (\e p -> AllowLists.verify e p (toEither target)) <$> input <*> input - unless allowListOk $ throw AuthenticationSubsystemAllowListError - user <- lookupActiveUserByUserKey target >>= maybe (throw AuthenticationSubsystemInvalidPasswordResetKey) pure - let uid = userId user - Log.debug $ field "user" (toByteString uid) . field "action" (val "User.beginPasswordReset") - - mExistingCode <- lookupPasswordResetCode uid - when (isJust mExistingCode) $ - throw AuthenticationSubsystemPasswordResetInProgress - - let key = mkPasswordResetKey uid - now <- Now.get - code <- foldKey (const generateEmailCode) (const generatePhoneCode) target - codeInsert - key - (PRQueryData code uid (Identity maxAttempts) (Identity (passwordResetCodeTtl `addUTCTime` now))) - (round passwordResetCodeTtl) - foldKey - (\email -> sendPasswordResetMail email (key, code) (Just user.userLocale)) - (\phone -> sendPasswordResetSms phone (key, code) (Just user.userLocale)) - target - pure () +createPasswordResetCodeImpl target = + logPasswordResetError =<< runError do + allowListOk <- (\e p -> AllowLists.verify e p (toEither target)) <$> input <*> input + unless allowListOk $ throw AllowListError + user <- lookupActiveUserByUserKey target >>= maybe (throw InvalidResetKey) pure + let uid = userId user + Log.debug $ field "user" (toByteString uid) . field "action" (val "User.beginPasswordReset") + + mExistingCode <- lookupPasswordResetCode uid + when (isJust mExistingCode) $ + throw InProgress + + let key = mkPasswordResetKey uid + now <- Now.get + code <- foldKey (const generateEmailCode) (const generatePhoneCode) target + codeInsert + key + (PRQueryData code uid (Identity maxAttempts) (Identity (passwordResetCodeTtl `addUTCTime` now))) + (round passwordResetCodeTtl) + foldKey + (\email -> sendPasswordResetMail email (key, code) (Just user.userLocale)) + (\phone -> sendPasswordResetSms phone (key, code) (Just user.userLocale)) + target + pure () + where + -- `PasswordResetError` are errors that we don't want to leak to the caller. + -- Therefore we handle them here and only log without propagating them. + logPasswordResetError :: Either PasswordResetError () -> Sem r () + logPasswordResetError = \case + Left e -> + Log.err $ + field "action" (val "User.beginPasswordReset") + . field "error" (displayException e) + Right v -> pure v lookupActiveUserIdByUserKey :: (Member UserSubsystem r, Member (Input (Local ())) r) => UserKey -> Sem r (Maybe UserId) lookupActiveUserIdByUserKey target = userId <$$> lookupActiveUserByUserKey target diff --git a/libs/wire-subsystems/test/unit/Wire/AuthenticationSubsystem/InterpreterSpec.hs b/libs/wire-subsystems/test/unit/Wire/AuthenticationSubsystem/InterpreterSpec.hs index e943e066d4f..3ffe1732d9e 100644 --- a/libs/wire-subsystems/test/unit/Wire/AuthenticationSubsystem/InterpreterSpec.hs +++ b/libs/wire-subsystems/test/unit/Wire/AuthenticationSubsystem/InterpreterSpec.hs @@ -30,7 +30,7 @@ import Wire.MockInterpreters import Wire.PasswordResetCodeStore import Wire.PasswordStore import Wire.Sem.Logger.TinyLog -import Wire.Sem.Now +import Wire.Sem.Now (Now) import Wire.SessionStore import Wire.UserKeyStore import Wire.UserSubsystem @@ -130,8 +130,9 @@ spec = describe "AuthenticationSubsystem.Interpreter" do interpretDependencies localDomain [] mempty (Just ["example.com"]) . interpretAuthenticationSubsystem $ createPasswordResetCode (userEmailKey email) - in emailDomain email /= "exmaple.com" ==> - createPasswordResetCodeResult === Left AuthenticationSubsystemAllowListError + <* expectNoEmailSent + in emailDomain email /= "example.com" ==> + createPasswordResetCodeResult === Right () prop "reset code is generated when email is in allow list" $ \email userNoEmail -> @@ -152,8 +153,9 @@ spec = describe "AuthenticationSubsystem.Interpreter" do interpretDependencies localDomain [UserAccount user status] mempty Nothing . interpretAuthenticationSubsystem $ createPasswordResetCode (userEmailKey email) + <* expectNoEmailSent in status /= Active ==> - createPasswordResetCodeResult === Left AuthenticationSubsystemInvalidPasswordResetKey + createPasswordResetCodeResult === Right () prop "reset code is not generated for when there is no user for the email" $ \email localDomain -> @@ -161,7 +163,8 @@ spec = describe "AuthenticationSubsystem.Interpreter" do interpretDependencies localDomain [] mempty Nothing . interpretAuthenticationSubsystem $ createPasswordResetCode (userEmailKey email) - in createPasswordResetCodeResult === Left AuthenticationSubsystemInvalidPasswordResetKey + <* expectNoEmailSent + in createPasswordResetCodeResult === Right () prop "reset code is only generated once" $ \email userNoEmail newPassword -> @@ -182,7 +185,7 @@ spec = describe "AuthenticationSubsystem.Interpreter" do (,mCaughtExc) <$> lookupHashedPassword uid in (fmap (verifyPassword newPassword) newPasswordHash === Just True) - .&&. (mCaughtException === Just AuthenticationSubsystemPasswordResetInProgress) + .&&. (mCaughtException === Nothing) prop "reset code is not accepted after expiry" $ \email userNoEmail oldPassword newPassword -> @@ -306,3 +309,10 @@ expect1ResetPasswordEmail email = [] -> error "no emails sent" [SentMail _ (PasswordResetMail resetPair)] -> resetPair wrongEmails -> error $ "Wrong emails sent: " <> show wrongEmails + +expectNoEmailSent :: (Member (State (Map Email [SentMail])) r) => Sem r () +expectNoEmailSent = do + emails <- get + if null emails + then pure () + else error $ "Expected no emails sent, got: " <> show emails diff --git a/services/brig/test/integration/API/User/PasswordReset.hs b/services/brig/test/integration/API/User/PasswordReset.hs index aa6c4d0ec80..b478af41749 100644 --- a/services/brig/test/integration/API/User/PasswordReset.hs +++ b/services/brig/test/integration/API/User/PasswordReset.hs @@ -31,7 +31,6 @@ import Data.Aeson as A import Data.Aeson.KeyMap qualified as KeyMap import Data.Misc import Imports -import Network.Wai.Utilities (Error (label)) import Test.Tasty hiding (Timeout) import Util import Wire.API.User @@ -64,10 +63,10 @@ testPasswordReset brig = do let newpw = plainTextPassword8Unsafe "newsecret" do initiatePasswordReset brig email !!! const 201 === statusCode - initiatePasswordReset brig email !!! do - const 409 === statusCode - const (Just "code-exists") === fmap label . responseJsonMaybe - const Nothing {- the "retry-after" header is only added for provider, not user, at the time of writing this test -} === getHeader "Retry-After" + -- even though a password reset is now in progress + -- we expect a successful response from a subsequent request to not leak any information + -- about the requested email + initiatePasswordReset brig email !!! const 201 === statusCode passwordResetData <- preparePasswordReset brig email uid newpw completePasswordReset brig passwordResetData !!! const 200 === statusCode From 8561a01ff337efa461be6e048684e57450cbca7a Mon Sep 17 00:00:00 2001 From: Leif Battermann Date: Tue, 2 Jul 2024 17:16:05 +0200 Subject: [PATCH 55/64] WPB-6954 Set SFT username's shared field according to team setting (#4117) --- changelog.d/2-features/WPB-6954 | 1 + charts/integration/templates/configmap.yaml | 2 +- integration/test/Testlib/ResourcePool.hs | 2 +- libs/extended/src/Network/AMQP/Extended.hs | 1 + libs/wire-api/src/Wire/API/Call/Config.hs | 8 ++--- .../Golden/Generated/RTCConfiguration_user.hs | 2 +- .../API/Golden/Generated/SFTServer_user.hs | 2 +- .../testObject_RTCConfiguration_user_7.json | 2 +- services/brig/src/Brig/Calling/API.hs | 35 ++++++++++++++----- services/brig/test/unit/Test/Brig/Calling.hs | 10 +++--- services/integration.yaml | 2 +- 11 files changed, 44 insertions(+), 23 deletions(-) create mode 100644 changelog.d/2-features/WPB-6954 diff --git a/changelog.d/2-features/WPB-6954 b/changelog.d/2-features/WPB-6954 new file mode 100644 index 00000000000..b2208e9d728 --- /dev/null +++ b/changelog.d/2-features/WPB-6954 @@ -0,0 +1 @@ +Set SFT usernames's `shared` field according to team settings diff --git a/charts/integration/templates/configmap.yaml b/charts/integration/templates/configmap.yaml index 2c2178dc14f..ca2d49f9bec 100644 --- a/charts/integration/templates/configmap.yaml +++ b/charts/integration/templates/configmap.yaml @@ -59,7 +59,7 @@ data: rabbitmq: host: rabbitmq - adminPort: 15672 + adminPort: 15671 backendTwo: diff --git a/integration/test/Testlib/ResourcePool.hs b/integration/test/Testlib/ResourcePool.hs index e2d843dc42f..c67b7031e43 100644 --- a/integration/test/Testlib/ResourcePool.hs +++ b/integration/test/Testlib/ResourcePool.hs @@ -85,7 +85,7 @@ deleteAllRabbitMQQueues rc resource = do port = 0, adminPort = fromIntegral rc.adminPort, vHost = T.pack resource.berVHost, - tls = Nothing + tls = Just $ RabbitMqTlsOpts Nothing True } client <- mkRabbitMqAdminClientEnv opts queues <- listQueuesByVHost client (T.pack resource.berVHost) diff --git a/libs/extended/src/Network/AMQP/Extended.hs b/libs/extended/src/Network/AMQP/Extended.hs index 43bdec456b9..b3131fce2af 100644 --- a/libs/extended/src/Network/AMQP/Extended.hs +++ b/libs/extended/src/Network/AMQP/Extended.hs @@ -8,6 +8,7 @@ module Network.AMQP.Extended mkRabbitMqAdminClientEnv, mkRabbitMqChannelMVar, demoteOpts, + RabbitMqTlsOpts (..), ) where diff --git a/libs/wire-api/src/Wire/API/Call/Config.hs b/libs/wire-api/src/Wire/API/Call/Config.hs index e28294c9652..b48d771e20d 100644 --- a/libs/wire-api/src/Wire/API/Call/Config.hs +++ b/libs/wire-api/src/Wire/API/Call/Config.hs @@ -49,7 +49,7 @@ module Wire.API.Call.Config isHostName, -- * SFTUsername - SFTUsername (SFTUsername), + SFTUsername, mkSFTUsername, suExpiresAt, suVersion, @@ -465,13 +465,13 @@ data SFTUsername = SFTUsername deriving (A.ToJSON, A.FromJSON, S.ToSchema) via (Schema SFTUsername) -- note that the random value is not checked for well-formedness -mkSFTUsername :: POSIXTime -> Text -> SFTUsername -mkSFTUsername expires rnd = +mkSFTUsername :: Bool -> POSIXTime -> Text -> SFTUsername +mkSFTUsername shared expires rnd = SFTUsername { _suExpiresAt = expires, _suVersion = 1, _suKeyindex = 0, - _suShared = True, + _suShared = shared, _suRandom = rnd } diff --git a/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated/RTCConfiguration_user.hs b/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated/RTCConfiguration_user.hs index 29c9555f4ba..19dc8b1c9f9 100644 --- a/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated/RTCConfiguration_user.hs +++ b/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated/RTCConfiguration_user.hs @@ -752,7 +752,7 @@ testObject_RTCConfiguration_user_7 = } ) ) - (mkSFTUsername (secondsToNominalDiffTime 12) "username") + (mkSFTUsername False (secondsToNominalDiffTime 12) "username") "credential" ] ) diff --git a/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated/SFTServer_user.hs b/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated/SFTServer_user.hs index b34fc94d32e..a109e29d241 100644 --- a/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated/SFTServer_user.hs +++ b/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated/SFTServer_user.hs @@ -47,5 +47,5 @@ testObject_SFTServer_user_1 = } ) ) - (mkSFTUsername (secondsToNominalDiffTime 12) "username") + (mkSFTUsername True (secondsToNominalDiffTime 12) "username") "credential" diff --git a/libs/wire-api/test/golden/testObject_RTCConfiguration_user_7.json b/libs/wire-api/test/golden/testObject_RTCConfiguration_user_7.json index bdd7b330834..6ea01e81710 100644 --- a/libs/wire-api/test/golden/testObject_RTCConfiguration_user_7.json +++ b/libs/wire-api/test/golden/testObject_RTCConfiguration_user_7.json @@ -17,7 +17,7 @@ "urls": [ "https://example.com" ], - "username": "d=12.v=1.k=0.s=1.r=username" + "username": "d=12.v=1.k=0.s=0.r=username" } ], "ttl": 2 diff --git a/services/brig/src/Brig/Calling/API.hs b/services/brig/src/Brig/Calling/API.hs index a02a18da9b9..f963925f821 100644 --- a/services/brig/src/Brig/Calling/API.hs +++ b/services/brig/src/Brig/Calling/API.hs @@ -57,29 +57,37 @@ import Polysemy.Error qualified as Polysemy import System.Logger.Class qualified as Log import System.Random.MWC qualified as MWC import Wire.API.Call.Config qualified as Public +import Wire.API.Team.Feature (AllFeatureConfigs (afcConferenceCalling), FeatureStatus (FeatureStatusDisabled, FeatureStatusEnabled), wsStatus) +import Wire.GalleyAPIAccess (GalleyAPIAccess, getAllFeatureConfigsForUser) import Wire.Network.DNS.SRV (srvTarget) -- | ('UserId', 'ConnId' are required as args here to make sure this is an authenticated end-point.) getCallsConfigV2 :: ( Member (Embed IO) r, - Member SFT r + Member SFT r, + Member GalleyAPIAccess r ) => UserId -> ConnId -> Maybe (Range 1 10 Int) -> (Handler r) Public.RTCConfiguration -getCallsConfigV2 _ _ limit = do +getCallsConfigV2 uid _ limit = do env <- view turnEnv staticUrl <- view $ settings . Opt.sftStaticUrl sftListAllServers <- fromMaybe Opt.HideAllSFTServers <$> view (settings . Opt.sftListAllServers) sftEnv' <- view sftEnv sftFederation <- view enableSFTFederation discoveredServers <- turnServersV2 (env ^. turnServers) + shared <- do + ccStatus <- lift $ liftSem $ (wsStatus . afcConferenceCalling <$> getAllFeatureConfigsForUser (Just uid)) + pure $ case ccStatus of + FeatureStatusEnabled -> True + FeatureStatusDisabled -> False eitherConfig <- lift . liftSem . Polysemy.runError - $ newConfig env discoveredServers staticUrl sftEnv' limit sftListAllServers (CallsConfigV2 sftFederation) + $ newConfig env discoveredServers staticUrl sftEnv' limit sftListAllServers (CallsConfigV2 sftFederation) shared handleNoTurnServers eitherConfig -- | Throws '500 Internal Server Error' when no turn servers are found. This is @@ -96,20 +104,26 @@ handleNoTurnServers (Left NoTurnServers) = do getCallsConfig :: ( Member (Embed IO) r, - Member SFT r + Member SFT r, + Member GalleyAPIAccess r ) => UserId -> ConnId -> (Handler r) Public.RTCConfiguration -getCallsConfig _ _ = do +getCallsConfig uid _ = do env <- view turnEnv discoveredServers <- turnServersV1 (env ^. turnServers) + shared <- do + ccStatus <- lift $ liftSem $ (wsStatus . afcConferenceCalling <$> getAllFeatureConfigsForUser (Just uid)) + pure $ case ccStatus of + FeatureStatusEnabled -> True + FeatureStatusDisabled -> False eitherConfig <- (dropTransport <$$>) . lift . liftSem . Polysemy.runError - $ newConfig env discoveredServers Nothing Nothing Nothing HideAllSFTServers CallsConfigDeprecated + $ newConfig env discoveredServers Nothing Nothing Nothing HideAllSFTServers CallsConfigDeprecated shared handleNoTurnServers eitherConfig where -- In order to avoid being backwards incompatible, remove the `transport` query param from the URIs @@ -145,8 +159,9 @@ newConfig :: Maybe (Range 1 10 Int) -> ListAllSFTServers -> CallsConfigVersion -> + Bool -> Sem r Public.RTCConfiguration -newConfig env discoveredServers sftStaticUrl mSftEnv limit listAllServers version = do +newConfig env discoveredServers sftStaticUrl mSftEnv limit listAllServers version shared = do -- randomize list of servers (before limiting the list, to ensure not always the same servers are chosen if limit is set) randomizedUris <- liftIO . randomize @@ -194,15 +209,19 @@ newConfig env discoveredServers sftStaticUrl mSftEnv limit listAllServers versio -- it should also be safe to assume the returning list has length >= 1 NonEmpty.nonEmpty (Public.limitServers (NonEmpty.toList uris) (fromRange lim)) & fromMaybe (error "newConfig:limitedList: empty list of servers") + genUsername :: Word32 -> MWC.GenIO -> IO (POSIXTime, Text) genUsername ttl prng = do rnd <- view (packedBytes . utf8) <$> replicateM 16 (MWC.uniformR (97, 122) prng) t <- fromIntegral . (+ ttl) . round <$> getPOSIXTime pure $ (t, rnd) + genTurnUsername :: Word32 -> MWC.GenIO -> IO Public.TurnUsername genTurnUsername = (fmap (uncurry Public.turnUsername) .) . genUsername + genSFTUsername :: Word32 -> MWC.GenIO -> IO Public.SFTUsername - genSFTUsername = (fmap (uncurry Public.mkSFTUsername) .) . genUsername + genSFTUsername = (fmap (uncurry (Public.mkSFTUsername shared)) .) . genUsername + computeCred :: (ToByteString a) => Digest -> ByteString -> a -> AsciiBase64 computeCred dig secret = encodeBase64 . hmacBS dig secret . toByteString' authenticate :: diff --git a/services/brig/test/unit/Test/Brig/Calling.hs b/services/brig/test/unit/Test/Brig/Calling.hs index 1531ca8eed6..3b22294d16c 100644 --- a/services/brig/test/unit/Test/Brig/Calling.hs +++ b/services/brig/test/unit/Test/Brig/Calling.hs @@ -296,7 +296,7 @@ testSFTStaticDeprecatedEndpoint = do . ignoreLogs . interpretSFTInMemory mempty . throwErrorInIO @_ @NoTurnServers - $ newConfig env (Discovered turnUri) Nothing Nothing Nothing HideAllSFTServers CallsConfigDeprecated + $ newConfig env (Discovered turnUri) Nothing Nothing Nothing HideAllSFTServers CallsConfigDeprecated True assertEqual "when SFT static URL is disabled, sft_servers should be empty." Set.empty @@ -323,7 +323,7 @@ testSFTStaticV2NoStaticUrl = do . ignoreLogs . interpretSFTInMemory mempty . throwErrorInIO @_ @NoTurnServers - $ newConfig env (Discovered turnUri) Nothing (Just sftEnv) (Just . unsafeRange $ 2) ListAllSFTServers (CallsConfigV2 Nothing) + $ newConfig env (Discovered turnUri) Nothing (Just sftEnv) (Just . unsafeRange $ 2) ListAllSFTServers (CallsConfigV2 Nothing) True assertEqual "when SFT static URL is disabled, sft_servers_all should be from SFT environment" (Just . fmap ((^. sftURL) . sftServerFromSrvTarget . srvTarget) . toList $ servers) @@ -339,7 +339,7 @@ testSFTStaticV2StaticUrlError = do . ignoreLogs . interpretSFTInMemory mempty -- an empty lookup map, meaning there was an error . throwErrorInIO @_ @NoTurnServers - $ newConfig env (Discovered turnUri) (Just staticUrl) Nothing (Just . unsafeRange $ 2) ListAllSFTServers (CallsConfigV2 Nothing) + $ newConfig env (Discovered turnUri) (Just staticUrl) Nothing (Just . unsafeRange $ 2) ListAllSFTServers (CallsConfigV2 Nothing) True assertEqual "when SFT static URL is enabled (and setSftListAllServers is enabled), but returns error, sft_servers_all should be omitted" Nothing @@ -358,7 +358,7 @@ testSFTStaticV2StaticUrlList = do . ignoreLogs . interpretSFTInMemory (Map.singleton staticUrl (SFTGetResponse $ Right servers)) . throwErrorInIO @_ @NoTurnServers - $ newConfig env (Discovered turnUri) (Just staticUrl) Nothing (Just . unsafeRange $ 3) ListAllSFTServers (CallsConfigV2 Nothing) + $ newConfig env (Discovered turnUri) (Just staticUrl) Nothing (Just . unsafeRange $ 3) ListAllSFTServers (CallsConfigV2 Nothing) True assertEqual "when SFT static URL and setSftListAllServers are enabled, sft_servers_all should be from /sft_servers_all.json" ((^. sftURL) <$$> Just servers) @@ -376,7 +376,7 @@ testSFTStaticV2ListAllServersDisabled = do . ignoreLogs . interpretSFTInMemory (Map.singleton staticUrl (SFTGetResponse . Right $ servers)) . throwErrorInIO @_ @NoTurnServers - $ newConfig env (Discovered turnUri) (Just staticUrl) Nothing (Just . unsafeRange $ 3) HideAllSFTServers (CallsConfigV2 Nothing) + $ newConfig env (Discovered turnUri) (Just staticUrl) Nothing (Just . unsafeRange $ 3) HideAllSFTServers (CallsConfigV2 Nothing) True assertEqual "when SFT static URL is enabled and setSftListAllServers is \"disabled\" then sft_servers_all is missing" Nothing diff --git a/services/integration.yaml b/services/integration.yaml index 70b0fe24e3d..b33259f873a 100644 --- a/services/integration.yaml +++ b/services/integration.yaml @@ -138,7 +138,7 @@ dynamicBackends: rabbitmq: host: localhost - adminPort: 15672 + adminPort: 15671 cassandra: host: 127.0.0.1 From 4cf631009c878df081f6c6c2ca977ff679957926 Mon Sep 17 00:00:00 2001 From: Paolo Capriotti Date: Wed, 3 Jul 2024 10:43:15 +0200 Subject: [PATCH 56/64] Fix repeated with-rtsopts option (#4118) * Fix repeated with-rtsopts option GHC does not support repeated `--with-rtsopts` options, and it simply applies the last one. This means many of the baked-in options were actually not being passed, including `-N` for some of the services and `-T` for cannon. * [chore] make federatore run with -N --------- Co-authored-by: Magnus Viernickel --- changelog.d/3-bug-fixes/repeated-rtsopts | 1 + services/background-worker/background-worker.cabal | 2 +- services/brig/brig.cabal | 4 ++-- services/cannon/cannon.cabal | 5 ++--- services/federator/federator.cabal | 4 ++-- services/spar/spar.cabal | 3 +-- tools/db/auto-whitelist/auto-whitelist.cabal | 4 ++-- tools/db/find-undead/find-undead.cabal | 4 ++-- tools/db/inconsistencies/inconsistencies.cabal | 4 ++-- .../migrate-sso-feature-flag.cabal | 4 ++-- tools/db/move-team/move-team.cabal | 12 ++++++------ .../repair-brig-clients-table.cabal | 4 ++-- tools/db/service-backfill/service-backfill.cabal | 4 ++-- tools/fedcalls/fedcalls.cabal | 4 ++-- 14 files changed, 29 insertions(+), 30 deletions(-) create mode 100644 changelog.d/3-bug-fixes/repeated-rtsopts diff --git a/changelog.d/3-bug-fixes/repeated-rtsopts b/changelog.d/3-bug-fixes/repeated-rtsopts new file mode 100644 index 00000000000..abd9caa6320 --- /dev/null +++ b/changelog.d/3-bug-fixes/repeated-rtsopts @@ -0,0 +1 @@ +GHC does not support repeated --with-rtsopts options, and it simply applies the last one. This means many of the baked-in options were actually not being passed, including -N for some of the services and -T for cannon. diff --git a/services/background-worker/background-worker.cabal b/services/background-worker/background-worker.cabal index 4807e863625..387971a5fc0 100644 --- a/services/background-worker/background-worker.cabal +++ b/services/background-worker/background-worker.cabal @@ -110,7 +110,7 @@ executable background-worker -O2 -Wall -Wincomplete-uni-patterns -Wincomplete-record-updates -Wpartial-fields -fwarn-tabs -optP-Wno-nonportable-include-path -funbox-strict-fields -Wredundant-constraints -Wunused-packages - -threaded -with-rtsopts=-N -with-rtsopts=-T -rtsopts + -threaded "-with-rtsopts=-N -T" -rtsopts default-extensions: AllowAmbiguousTypes diff --git a/services/brig/brig.cabal b/services/brig/brig.cabal index 626d1f677c5..f184c0715e1 100644 --- a/services/brig/brig.cabal +++ b/services/brig/brig.cabal @@ -349,8 +349,8 @@ executable brig main-is: exec/Main.hs other-modules: Paths_brig ghc-options: - -funbox-strict-fields -threaded -with-rtsopts=-N -with-rtsopts=-T - -rtsopts -Wredundant-constraints -Wunused-packages + -funbox-strict-fields -threaded "-with-rtsopts=-N -T" -rtsopts + -Wredundant-constraints -Wunused-packages build-depends: , base diff --git a/services/cannon/cannon.cabal b/services/cannon/cannon.cabal index 73ef7133bef..d0af6581163 100644 --- a/services/cannon/cannon.cabal +++ b/services/cannon/cannon.cabal @@ -166,9 +166,8 @@ executable cannon ghc-options: -O2 -Wall -Wincomplete-uni-patterns -Wincomplete-record-updates -Wpartial-fields -fwarn-tabs -optP-Wno-nonportable-include-path - -threaded -rtsopts -with-rtsopts=-N -with-rtsopts=-T - -with-rtsopts=-M1g -with-rtsopts=-ki4k -Wredundant-constraints - -Wunused-packages + -threaded -rtsopts "-with-rtsopts=-N -T -M1g -ki4k" + -Wredundant-constraints -Wunused-packages build-depends: base diff --git a/services/federator/federator.cabal b/services/federator/federator.cabal index 1812c4e115b..4c88186b527 100644 --- a/services/federator/federator.cabal +++ b/services/federator/federator.cabal @@ -205,8 +205,8 @@ executable federator ghc-options: -O2 -Wall -Wincomplete-uni-patterns -Wincomplete-record-updates -Wpartial-fields -fwarn-tabs -optP-Wno-nonportable-include-path - -threaded -with-rtsopts=-N1 -with-rtsopts=-T -rtsopts - -Wredundant-constraints -Wunused-packages + -threaded "-with-rtsopts=-N -T" -rtsopts -Wredundant-constraints + -Wunused-packages build-depends: base diff --git a/services/spar/spar.cabal b/services/spar/spar.cabal index f557ea74082..e8a01fd1f8b 100644 --- a/services/spar/spar.cabal +++ b/services/spar/spar.cabal @@ -252,8 +252,7 @@ executable spar -O2 -Wall -Wincomplete-uni-patterns -Wincomplete-record-updates -Wpartial-fields -fwarn-tabs -optP-Wno-nonportable-include-path -j -Wno-redundant-constraints -Werror -threaded -rtsopts - -with-rtsopts=-N -with-rtsopts=-T -Wredundant-constraints - -Wunused-packages + "-with-rtsopts=-N -T" -Wredundant-constraints -Wunused-packages build-depends: base diff --git a/tools/db/auto-whitelist/auto-whitelist.cabal b/tools/db/auto-whitelist/auto-whitelist.cabal index 09239aa43c9..487ccc7ff6d 100644 --- a/tools/db/auto-whitelist/auto-whitelist.cabal +++ b/tools/db/auto-whitelist/auto-whitelist.cabal @@ -62,8 +62,8 @@ executable auto-whitelist ghc-options: -O2 -Wall -Wincomplete-uni-patterns -Wincomplete-record-updates -Wpartial-fields -fwarn-tabs -optP-Wno-nonportable-include-path - -funbox-strict-fields -threaded -with-rtsopts=-N -with-rtsopts=-T - -rtsopts -Wredundant-constraints -Wunused-packages + -funbox-strict-fields -threaded "-with-rtsopts=-N -T" -rtsopts + -Wredundant-constraints -Wunused-packages build-depends: base diff --git a/tools/db/find-undead/find-undead.cabal b/tools/db/find-undead/find-undead.cabal index 4d80aabac45..16a7035e1ed 100644 --- a/tools/db/find-undead/find-undead.cabal +++ b/tools/db/find-undead/find-undead.cabal @@ -62,8 +62,8 @@ executable find-undead ghc-options: -O2 -Wall -Wincomplete-uni-patterns -Wincomplete-record-updates -Wpartial-fields -fwarn-tabs -optP-Wno-nonportable-include-path - -funbox-strict-fields -threaded -with-rtsopts=-N -with-rtsopts=-T - -rtsopts -Wredundant-constraints -Wunused-packages + -funbox-strict-fields -threaded "-with-rtsopts=-N -T" -rtsopts + -Wredundant-constraints -Wunused-packages build-depends: aeson diff --git a/tools/db/inconsistencies/inconsistencies.cabal b/tools/db/inconsistencies/inconsistencies.cabal index bbc9a5c8f1f..4cc38f77c90 100644 --- a/tools/db/inconsistencies/inconsistencies.cabal +++ b/tools/db/inconsistencies/inconsistencies.cabal @@ -65,8 +65,8 @@ executable inconsistencies ghc-options: -O2 -Wall -Wincomplete-uni-patterns -Wincomplete-record-updates -Wpartial-fields -fwarn-tabs -optP-Wno-nonportable-include-path - -funbox-strict-fields -threaded -with-rtsopts=-N -with-rtsopts=-T - -rtsopts -Wredundant-constraints -Wunused-packages + -funbox-strict-fields -threaded "-with-rtsopts=-N -T" -rtsopts + -Wredundant-constraints -Wunused-packages build-depends: aeson diff --git a/tools/db/migrate-sso-feature-flag/migrate-sso-feature-flag.cabal b/tools/db/migrate-sso-feature-flag/migrate-sso-feature-flag.cabal index aca192a3aa1..b8b23b523b9 100644 --- a/tools/db/migrate-sso-feature-flag/migrate-sso-feature-flag.cabal +++ b/tools/db/migrate-sso-feature-flag/migrate-sso-feature-flag.cabal @@ -64,8 +64,8 @@ executable migrate-sso-feature-flag ghc-options: -O2 -Wall -Wincomplete-uni-patterns -Wincomplete-record-updates -Wpartial-fields -fwarn-tabs -optP-Wno-nonportable-include-path - -funbox-strict-fields -threaded -with-rtsopts=-N -with-rtsopts=-T - -rtsopts -Wredundant-constraints -Wunused-packages + -funbox-strict-fields -threaded "-with-rtsopts=-N -T" -rtsopts + -Wredundant-constraints -Wunused-packages build-depends: base diff --git a/tools/db/move-team/move-team.cabal b/tools/db/move-team/move-team.cabal index ba3abc5a288..c2a033e20db 100644 --- a/tools/db/move-team/move-team.cabal +++ b/tools/db/move-team/move-team.cabal @@ -65,8 +65,8 @@ library ghc-options: -O2 -Wall -Wincomplete-uni-patterns -Wincomplete-record-updates -Wpartial-fields -fwarn-tabs -optP-Wno-nonportable-include-path - -funbox-strict-fields -threaded -with-rtsopts=-N -with-rtsopts=-T - -rtsopts -Wredundant-constraints -Wunused-packages + -funbox-strict-fields -threaded "-with-rtsopts=-N -T" -rtsopts + -Wredundant-constraints -Wunused-packages build-depends: aeson @@ -144,8 +144,8 @@ executable move-team ghc-options: -O2 -Wall -Wincomplete-uni-patterns -Wincomplete-record-updates -Wpartial-fields -fwarn-tabs -optP-Wno-nonportable-include-path - -funbox-strict-fields -threaded -with-rtsopts=-N -with-rtsopts=-T - -rtsopts -Wredundant-constraints -Wunused-packages + -funbox-strict-fields -threaded "-with-rtsopts=-N -T" -rtsopts + -Wredundant-constraints -Wunused-packages build-depends: base @@ -210,8 +210,8 @@ executable move-team-generate ghc-options: -O2 -Wall -Wincomplete-uni-patterns -Wincomplete-record-updates -Wpartial-fields -fwarn-tabs -optP-Wno-nonportable-include-path - -funbox-strict-fields -threaded -with-rtsopts=-N -with-rtsopts=-T - -rtsopts -Wredundant-constraints -Wunused-packages + -funbox-strict-fields -threaded "-with-rtsopts=-N -T" -rtsopts + -Wredundant-constraints -Wunused-packages build-depends: base diff --git a/tools/db/repair-brig-clients-table/repair-brig-clients-table.cabal b/tools/db/repair-brig-clients-table/repair-brig-clients-table.cabal index c8cfd818ad5..56f53e49d1d 100644 --- a/tools/db/repair-brig-clients-table/repair-brig-clients-table.cabal +++ b/tools/db/repair-brig-clients-table/repair-brig-clients-table.cabal @@ -64,8 +64,8 @@ executable repair-brig-clients-table ghc-options: -O2 -Wall -Wincomplete-uni-patterns -Wincomplete-record-updates -Wpartial-fields -fwarn-tabs -optP-Wno-nonportable-include-path - -funbox-strict-fields -threaded -with-rtsopts=-N -with-rtsopts=-T - -rtsopts -Wredundant-constraints -Wunused-packages + -funbox-strict-fields -threaded "-with-rtsopts=-N -T" -rtsopts + -Wredundant-constraints -Wunused-packages build-depends: base diff --git a/tools/db/service-backfill/service-backfill.cabal b/tools/db/service-backfill/service-backfill.cabal index c6806e06a39..83ab197e26c 100644 --- a/tools/db/service-backfill/service-backfill.cabal +++ b/tools/db/service-backfill/service-backfill.cabal @@ -62,8 +62,8 @@ executable service-backfill ghc-options: -O2 -Wall -Wincomplete-uni-patterns -Wincomplete-record-updates -Wpartial-fields -fwarn-tabs -optP-Wno-nonportable-include-path - -funbox-strict-fields -threaded -with-rtsopts=-N -with-rtsopts=-T - -rtsopts -Wredundant-constraints -Wunused-packages + -funbox-strict-fields -threaded "-with-rtsopts=-N -T" -rtsopts + -Wredundant-constraints -Wunused-packages build-depends: base diff --git a/tools/fedcalls/fedcalls.cabal b/tools/fedcalls/fedcalls.cabal index 56f14407a56..aa2f03e2d4e 100644 --- a/tools/fedcalls/fedcalls.cabal +++ b/tools/fedcalls/fedcalls.cabal @@ -59,8 +59,8 @@ executable fedcalls ghc-options: -O2 -Wall -Wincomplete-uni-patterns -Wincomplete-record-updates -Wpartial-fields -fwarn-tabs -optP-Wno-nonportable-include-path - -funbox-strict-fields -threaded -with-rtsopts=-N -with-rtsopts=-T - -rtsopts -Wredundant-constraints -Wunused-packages + -funbox-strict-fields -threaded "-with-rtsopts=-N -T" -rtsopts + -Wredundant-constraints -Wunused-packages build-depends: base From 99d546e3f8a8ba63065fef319e01506d482cf4b6 Mon Sep 17 00:00:00 2001 From: Stefan Berthold Date: Wed, 3 Jul 2024 12:06:19 +0200 Subject: [PATCH 57/64] reject MLS messages for future epochs (#4110) Co-authored-by: Akshay Mankar --- changelog.d/2-features/WPB-9871 | 1 + integration/test/Test/MLS.hs | 30 +++++++++++++++++-- services/galley/src/Galley/API/MLS/Message.hs | 4 ++- 3 files changed, 32 insertions(+), 3 deletions(-) create mode 100644 changelog.d/2-features/WPB-9871 diff --git a/changelog.d/2-features/WPB-9871 b/changelog.d/2-features/WPB-9871 new file mode 100644 index 00000000000..cf474cbd534 --- /dev/null +++ b/changelog.d/2-features/WPB-9871 @@ -0,0 +1 @@ +reject MLS messages for future epochs diff --git a/integration/test/Test/MLS.hs b/integration/test/Test/MLS.hs index c3a9d707ba5..07534701b85 100644 --- a/integration/test/Test/MLS.hs +++ b/integration/test/Test/MLS.hs @@ -43,8 +43,8 @@ testSendMessageNoReturnToSender = do ) wsSender -testStaleApplicationMessage :: (HasCallStack) => Domain -> App () -testStaleApplicationMessage otherDomain = do +testPastStaleApplicationMessage :: (HasCallStack) => Domain -> App () +testPastStaleApplicationMessage otherDomain = do [alice, bob, charlie, dave, eve] <- createAndConnectUsers [OwnDomain, otherDomain, OwnDomain, OwnDomain, OwnDomain] [alice1, bob1, charlie1] <- traverse (createMLSClient def) [alice, bob, charlie] @@ -70,6 +70,32 @@ testStaleApplicationMessage otherDomain = do -- bob's application messages are now rejected void $ postMLSMessage bob1 msg2.message >>= getJSON 409 +testFutureStaleApplicationMessage :: (HasCallStack) => App () +testFutureStaleApplicationMessage = do + [alice, bob, charlie] <- createAndConnectUsers [OwnDomain, OwnDomain, OwnDomain] + [alice1, bob1, charlie1] <- traverse (createMLSClient def) [alice, bob, charlie] + traverse_ uploadNewKeyPackage [bob1, charlie1] + void $ createNewGroup alice1 + + -- alice adds bob + void . sendAndConsumeCommitBundle =<< createAddCommit alice1 [bob] + + -- alice adds charlie and consumes the commit without sending it + void $ createAddCommit alice1 [charlie] + modifyMLSState $ \mls -> + mls + { epoch = epoch mls + 1, + members = members mls <> Set.singleton charlie1, + newMembers = mempty + } + + -- alice's application message is rejected + void + . getJSON 409 + =<< postMLSMessage alice1 + . (.message) + =<< createApplicationMessage alice1 "hi bob" + testMixedProtocolUpgrade :: (HasCallStack) => Domain -> App () testMixedProtocolUpgrade secondDomain = do (alice, tid, _) <- createTeam OwnDomain 1 diff --git a/services/galley/src/Galley/API/MLS/Message.hs b/services/galley/src/Galley/API/MLS/Message.hs index a4add447b06..8451e05019c 100644 --- a/services/galley/src/Galley/API/MLS/Message.hs +++ b/services/galley/src/Galley/API/MLS/Message.hs @@ -414,7 +414,9 @@ postMLSMessageToLocalConv qusr c con msg ctype convOrSubId = do Nothing -> throw $ mlsProtocolError "Application messages at epoch 0 are not supported" Just activeData -> when - (epochInt msg.epoch < epochInt activeData.epoch - 2) + ( epochInt msg.epoch < epochInt activeData.epoch - 2 + || epochInt msg.epoch > epochInt activeData.epoch + ) $ throwS @'MLSStaleMessage propagateMessage qusr (Just c) lConvOrSub con msg.rawMessage (tUnqualified lConvOrSub).members From d1f4b1fd9829f3e0d900f67352442e9fe832d021 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Marko=20Dimja=C5=A1evi=C4=87?= Date: Wed, 3 Jul 2024 13:03:36 +0200 Subject: [PATCH 58/64] [WPB-9065] Stop supporting phone numbers in supported client API versions (#4045) * Deny registering a new user with a phone number * Update user registration documentation * Update the user activation documentation * Disable user activation via a phone code * Ignore the voice_call field in POST /activation/send * stern-test: fail to get users by phone with error * stern: prevent updating phone numbers, clean up some brig. * brig: WIP clean up phone-related tests. * brig: updated failing test. * Migrate a test: POST /activate/send: invalid phone * brig: change error label and msg for invalid phone errors * Update SendActivationCode golden tests * Make `PUT i/users/:uid/sso-id` not fail * Fix `POST /activate/send - 403 prefix excluded` * Fix more tests * Remove more phone-related code * Fix Stern calls to internal Brig API * Drop phones from Brig.Code * Remove brig phone modules * Restore public API * Revert brig phone middleware hack * Remove all references to Twilio and Nexmo * Fix test send-phone-code * Fix test "post /register - 201 existing activation" * Fix test for registering w/o email and password * Revert "Ignore the voice_call field in POST /activation/send" This reverts commit c5992c5f360e814e6e24ebf5f9d9778c23ada435. * Revert changes to golden tests for NewUser type This undoes the changes to the tests that expected a failure while parsing. Instead, we rely on failing at the handler execution time. * Remove phone and full identity constructor * Fix Cassandra queries in Brig (no phone selection) * Fix spar tests * Remove phone prefix code * Remove PhoneBudgetTimeout * Remove BlacklistedPhone error * Add CHANGELOG entries * Fix last TODOs * Drop "phone" from an identity error message * Fix user identity and activation response unit and golden tests * Remove unused golden test files * Fix NewUser golden tests * Stern: remove tests for removed endpoints * brig-types golden test: use email instead of phone * Drop the excluded_phones DB table * Revert "Drop the excluded_phones DB table" This reverts commit 6174f1b72551da5473b5fd13b17925d5f78ce4a2. * Make new Ormolu happy * Align with fisx'es changes Remove some unused phone types * Brig: fix dependency on wire-subsystems * Hi CI --------- Co-authored-by: Igor Ranieri Co-authored-by: Paolo Capriotti --- cabal.project | 3 - .../0-release-notes/remove-phone-support.md | 4 + .../remove-internal-phone-endpoints.md | 10 + charts/brig/templates/configmap.yaml | 2 - charts/brig/templates/secret.yaml | 2 - .../dockerephemeral/federation-v0/brig.yaml | 3 - .../developer/reference/user/activation.md | 43 +- .../developer/reference/user/registration.md | 29 +- .../install/infrastructure-configuration.md | 17 - .../api-client-perspective/authentication.md | 100 +-- hack/helm_vars/wire-server/values.yaml.gotmpl | 6 - integration/test/API/Brig.hs | 6 + integration/test/Test/User.hs | 10 + libs/brig-types/brig-types.cabal | 1 - libs/brig-types/src/Brig/Types/Common.hs | 32 - libs/brig-types/src/Brig/Types/Connection.hs | 4 +- .../src/Brig/Types/Test/Arbitrary.hs | 4 - .../test/unit/Test/Brig/Types/Common.hs | 4 +- .../test/unit/Test/Brig/Types/User.hs | 2 +- libs/ropes/.ormolu | 1 - libs/ropes/LICENSE | 661 ------------------ libs/ropes/default.nix | 37 - libs/ropes/ropes.cabal | 79 --- libs/ropes/src/Ropes/Nexmo.hs | 356 ---------- libs/ropes/src/Ropes/Twilio.hs | 224 ------ libs/wire-api/src/Wire/API/Allowlists.hs | 17 +- libs/wire-api/src/Wire/API/Error/Brig.hs | 13 +- .../src/Wire/API/Routes/Internal/Brig.hs | 49 +- .../src/Wire/API/Routes/Public/Brig.hs | 10 +- libs/wire-api/src/Wire/API/User.hs | 150 +--- libs/wire-api/src/Wire/API/User/Activation.hs | 2 +- libs/wire-api/src/Wire/API/User/Identity.hs | 86 +-- libs/wire-api/src/Wire/API/User/Password.hs | 49 +- libs/wire-api/src/Wire/API/UserEvent.hs | 2 +- .../golden/Test/Wire/API/Golden/Generated.hs | 7 +- .../Generated/ActivationResponse_user.hs | 100 +-- .../Generated/CompletePasswordReset_user.hs | 17 +- .../Golden/Generated/NewPasswordReset_user.hs | 122 +--- .../Golden/Generated/NewUserPublic_user.hs | 6 +- .../Wire/API/Golden/Generated/NewUser_user.hs | 52 +- .../API/Golden/Generated/SelfProfile_user.hs | 2 +- .../Generated/SendActivationCode_user.hs | 6 +- .../Wire/API/Golden/Generated/User_user.hs | 6 +- .../testObject_NewUserPublic_user_1-2.json | 3 +- .../testObject_NewUserPublic_user_1-3.json | 5 +- ...testObject_ActivationResponse_user_11.json | 4 - ...testObject_ActivationResponse_user_12.json | 4 - ...testObject_ActivationResponse_user_13.json | 7 - ...testObject_ActivationResponse_user_14.json | 7 - ...testObject_ActivationResponse_user_15.json | 4 - ...testObject_ActivationResponse_user_16.json | 5 - ...testObject_ActivationResponse_user_17.json | 8 - ...testObject_ActivationResponse_user_18.json | 4 - ...testObject_ActivationResponse_user_19.json | 8 - .../testObject_ActivationResponse_user_2.json | 4 +- ...testObject_ActivationResponse_user_20.json | 5 - .../testObject_ActivationResponse_user_4.json | 3 +- .../testObject_ActivationResponse_user_8.json | 4 +- .../testObject_ActivationResponse_user_9.json | 3 +- .../testObject_NewPasswordReset_user_10.json | 3 - .../testObject_NewPasswordReset_user_11.json | 3 - .../testObject_NewPasswordReset_user_12.json | 3 - .../testObject_NewPasswordReset_user_13.json | 3 - .../testObject_NewPasswordReset_user_14.json | 3 - .../testObject_NewPasswordReset_user_15.json | 3 - .../testObject_NewPasswordReset_user_16.json | 3 - .../testObject_NewPasswordReset_user_17.json | 3 - .../testObject_NewPasswordReset_user_18.json | 3 - .../testObject_NewPasswordReset_user_19.json | 3 - .../testObject_NewPasswordReset_user_2.json | 3 - .../testObject_NewPasswordReset_user_3.json | 3 - .../testObject_NewPasswordReset_user_4.json | 3 - .../testObject_NewPasswordReset_user_5.json | 3 - .../testObject_NewPasswordReset_user_6.json | 3 - .../testObject_NewPasswordReset_user_7.json | 3 - .../testObject_NewPasswordReset_user_8.json | 3 - .../testObject_NewPasswordReset_user_9.json | 3 - .../testObject_NewUserPublic_user_1.json | 3 +- .../golden/testObject_NewUser_user_1.json | 1 - .../golden/testObject_NewUser_user_7.json | 2 +- .../golden/testObject_NewUser_user_8.json | 2 +- .../golden/testObject_NewUser_user_9.json | 30 + .../golden/testObject_SelfProfile_user_1.json | 1 - .../testObject_SendActivationCode_user_5.json | 2 +- .../test/golden/testObject_User_user_2.json | 2 +- .../test/golden/testObject_User_user_5.json | 3 +- libs/wire-api/test/unit/Test/Wire/API/User.hs | 18 +- .../src/Wire/AuthenticationSubsystem.hs | 4 +- .../src/Wire/AuthenticationSubsystem/Error.hs | 4 + .../AuthenticationSubsystem/Interpreter.hs | 40 +- .../src/Wire/EmailSmsSubsystem.hs | 1 - .../src/Wire/EmailSmsSubsystem/Interpreter.hs | 20 +- libs/wire-subsystems/src/Wire/StoredUser.hs | 13 +- libs/wire-subsystems/src/Wire/UserKeyStore.hs | 76 +- .../src/Wire/UserKeyStore/Cassandra.hs | 24 +- .../wire-subsystems/src/Wire/UserSubsystem.hs | 2 +- .../src/Wire/UserSubsystem/Interpreter.hs | 8 +- .../InterpreterSpec.hs | 28 +- .../test/unit/Wire/MiniBackend.hs | 6 +- .../Wire/MockInterpreters/UserKeyStore.hs | 2 +- .../Wire/MockInterpreters/UserSubsystem.hs | 3 +- .../test/unit/Wire/UserStoreSpec.hs | 1 - .../Wire/UserSubsystem/InterpreterSpec.hs | 6 +- nix/local-haskell-packages.nix | 1 - services/brig/brig.cabal | 5 - services/brig/brig.integration.yaml | 5 - services/brig/default.nix | 2 - services/brig/src/Brig/API/Auth.hs | 27 +- services/brig/src/Brig/API/Error.hs | 20 +- services/brig/src/Brig/API/Handler.hs | 19 +- services/brig/src/Brig/API/Internal.hs | 158 +---- services/brig/src/Brig/API/Public.hs | 89 +-- services/brig/src/Brig/API/Types.hs | 21 +- services/brig/src/Brig/API/User.hs | 367 +++------- services/brig/src/Brig/AWS/SesNotification.hs | 6 +- services/brig/src/Brig/App.hs | 10 - .../brig/src/Brig/CanonicalInterpreter.hs | 28 +- services/brig/src/Brig/Code.hs | 92 +-- services/brig/src/Brig/Data/Activation.hs | 49 +- services/brig/src/Brig/Data/User.hs | 52 +- .../Brig/Effects/BlacklistPhonePrefixStore.hs | 16 - .../BlacklistPhonePrefixStore/Cassandra.hs | 57 -- .../brig/src/Brig/Effects/BlacklistStore.hs | 6 +- .../Brig/Effects/BlacklistStore/Cassandra.hs | 12 +- services/brig/src/Brig/Options.hs | 7 +- services/brig/src/Brig/Phone.hs | 323 --------- services/brig/src/Brig/Provider/API.hs | 12 +- services/brig/src/Brig/Team/API.hs | 16 +- services/brig/src/Brig/User/Auth.hs | 87 +-- services/brig/src/Brig/User/EJPD.hs | 2 +- services/brig/src/Brig/User/Phone.hs | 279 -------- .../brig/test/integration/API/Provider.hs | 10 +- services/brig/test/integration/API/Team.hs | 20 - .../test/integration/API/TeamUserSearch.hs | 4 +- .../brig/test/integration/API/User/Account.hs | 246 +------ .../brig/test/integration/API/User/Auth.hs | 34 +- .../brig/test/integration/API/User/Client.hs | 4 +- .../test/integration/API/User/Connection.hs | 2 - .../brig/test/integration/API/User/Util.hs | 25 +- services/brig/test/integration/Util.hs | 14 +- .../test/resources/nexmo-credentials.yaml | 2 - services/spar/spar.cabal | 1 + services/spar/src/Spar/Scim/User.hs | 4 +- .../test-integration/Test/Spar/APISpec.hs | 4 +- .../Test/Spar/Scim/UserSpec.hs | 2 +- .../spar/test-integration/Util/Activation.hs | 47 ++ services/spar/test-integration/Util/Core.hs | 63 +- services/spar/test-integration/Util/Email.hs | 19 +- services/spar/test-integration/Util/Scim.hs | 2 +- .../inconsistencies/src/DanglingUserKeys.hs | 57 +- .../db/inconsistencies/src/EmailLessUsers.hs | 4 +- tools/stern/src/Stern/API.hs | 50 +- tools/stern/src/Stern/API/Routes.hs | 43 +- tools/stern/src/Stern/Intra.hs | 29 +- tools/stern/test/integration/API.hs | 29 +- tools/stern/test/integration/Util.hs | 20 +- 156 files changed, 871 insertions(+), 4402 deletions(-) create mode 100644 changelog.d/0-release-notes/remove-phone-support.md create mode 100644 changelog.d/1-api-changes/remove-internal-phone-endpoints.md delete mode 100644 libs/brig-types/src/Brig/Types/Common.hs delete mode 120000 libs/ropes/.ormolu delete mode 100644 libs/ropes/LICENSE delete mode 100644 libs/ropes/default.nix delete mode 100644 libs/ropes/ropes.cabal delete mode 100644 libs/ropes/src/Ropes/Nexmo.hs delete mode 100644 libs/ropes/src/Ropes/Twilio.hs delete mode 100644 libs/wire-api/test/golden/testObject_ActivationResponse_user_11.json delete mode 100644 libs/wire-api/test/golden/testObject_ActivationResponse_user_12.json delete mode 100644 libs/wire-api/test/golden/testObject_ActivationResponse_user_13.json delete mode 100644 libs/wire-api/test/golden/testObject_ActivationResponse_user_14.json delete mode 100644 libs/wire-api/test/golden/testObject_ActivationResponse_user_15.json delete mode 100644 libs/wire-api/test/golden/testObject_ActivationResponse_user_16.json delete mode 100644 libs/wire-api/test/golden/testObject_ActivationResponse_user_17.json delete mode 100644 libs/wire-api/test/golden/testObject_ActivationResponse_user_18.json delete mode 100644 libs/wire-api/test/golden/testObject_ActivationResponse_user_19.json delete mode 100644 libs/wire-api/test/golden/testObject_ActivationResponse_user_20.json delete mode 100644 libs/wire-api/test/golden/testObject_NewPasswordReset_user_10.json delete mode 100644 libs/wire-api/test/golden/testObject_NewPasswordReset_user_11.json delete mode 100644 libs/wire-api/test/golden/testObject_NewPasswordReset_user_12.json delete mode 100644 libs/wire-api/test/golden/testObject_NewPasswordReset_user_13.json delete mode 100644 libs/wire-api/test/golden/testObject_NewPasswordReset_user_14.json delete mode 100644 libs/wire-api/test/golden/testObject_NewPasswordReset_user_15.json delete mode 100644 libs/wire-api/test/golden/testObject_NewPasswordReset_user_16.json delete mode 100644 libs/wire-api/test/golden/testObject_NewPasswordReset_user_17.json delete mode 100644 libs/wire-api/test/golden/testObject_NewPasswordReset_user_18.json delete mode 100644 libs/wire-api/test/golden/testObject_NewPasswordReset_user_19.json delete mode 100644 libs/wire-api/test/golden/testObject_NewPasswordReset_user_2.json delete mode 100644 libs/wire-api/test/golden/testObject_NewPasswordReset_user_3.json delete mode 100644 libs/wire-api/test/golden/testObject_NewPasswordReset_user_4.json delete mode 100644 libs/wire-api/test/golden/testObject_NewPasswordReset_user_5.json delete mode 100644 libs/wire-api/test/golden/testObject_NewPasswordReset_user_6.json delete mode 100644 libs/wire-api/test/golden/testObject_NewPasswordReset_user_7.json delete mode 100644 libs/wire-api/test/golden/testObject_NewPasswordReset_user_8.json delete mode 100644 libs/wire-api/test/golden/testObject_NewPasswordReset_user_9.json create mode 100644 libs/wire-api/test/golden/testObject_NewUser_user_9.json delete mode 100644 services/brig/src/Brig/Effects/BlacklistPhonePrefixStore.hs delete mode 100644 services/brig/src/Brig/Effects/BlacklistPhonePrefixStore/Cassandra.hs delete mode 100644 services/brig/src/Brig/Phone.hs delete mode 100644 services/brig/src/Brig/User/Phone.hs delete mode 100644 services/brig/test/resources/nexmo-credentials.yaml create mode 100644 services/spar/test-integration/Util/Activation.hs diff --git a/cabal.project b/cabal.project index 5ebc608c29e..2e55626a809 100644 --- a/cabal.project +++ b/cabal.project @@ -19,7 +19,6 @@ packages: , libs/metrics-core/ , libs/metrics-wai/ , libs/polysemy-wire-zoo/ - , libs/ropes/ , libs/schema-profunctor/ , libs/sodium-crypto-sign/ , libs/ssl-util/ @@ -136,8 +135,6 @@ package repair-handles ghc-options: -Werror package rex ghc-options: -Werror -package ropes - ghc-options: -Werror package schema-profunctor ghc-options: -Werror package service-backfill diff --git a/changelog.d/0-release-notes/remove-phone-support.md b/changelog.d/0-release-notes/remove-phone-support.md new file mode 100644 index 00000000000..609832ac624 --- /dev/null +++ b/changelog.d/0-release-notes/remove-phone-support.md @@ -0,0 +1,4 @@ +Phone registration and login is not supported anymore. All API endpoints dealing with phone numbers and phone activation codes now fail with a 400 error. Brig options related to phone number support have now been deleted, namely: + - `setTwilio` + - `setNexmo` + - `setAllowlistPhonePrefixes`. diff --git a/changelog.d/1-api-changes/remove-internal-phone-endpoints.md b/changelog.d/1-api-changes/remove-internal-phone-endpoints.md new file mode 100644 index 00000000000..ed80d0eca54 --- /dev/null +++ b/changelog.d/1-api-changes/remove-internal-phone-endpoints.md @@ -0,0 +1,10 @@ +Internal API endpoints related to phone numbers have been removed. + +In brig: +- `iGetPhonePrefix` +- `iDeletePhonePrefix` +- `iPostPhonePrefix`. + +In stern: +- `get-users-by-phone` +- `put-phone`. diff --git a/charts/brig/templates/configmap.yaml b/charts/brig/templates/configmap.yaml index bf7881db81c..669e047bdc9 100644 --- a/charts/brig/templates/configmap.yaml +++ b/charts/brig/templates/configmap.yaml @@ -253,8 +253,6 @@ data: {{- if .setExpiredUserCleanupTimeout }} setExpiredUserCleanupTimeout: {{ .setExpiredUserCleanupTimeout }} {{- end }} - setTwilio: /etc/wire/brig/secrets/twilio-credentials.yaml - setNexmo: /etc/wire/brig/secrets/nexmo-credentials.yaml setUserMaxConnections: {{ .setUserMaxConnections }} setCookieInsecure: {{ .setCookieInsecure }} setUserCookieRenewAge: {{ .setUserCookieRenewAge }} diff --git a/charts/brig/templates/secret.yaml b/charts/brig/templates/secret.yaml index c2359979f57..b596954c7d8 100644 --- a/charts/brig/templates/secret.yaml +++ b/charts/brig/templates/secret.yaml @@ -20,8 +20,6 @@ data: awsKeyId: {{ .awsKeyId | b64enc | quote }} awsSecretKey: {{ .awsSecretKey | b64enc | quote }} {{- end }} - twilio-credentials.yaml: {{ .setTwilio | b64enc | quote }} - nexmo-credentials.yaml: {{ .setNexmo | b64enc | quote }} {{- if (not $.Values.config.useSES) }} smtp-password.txt: {{ .smtpPassword | b64enc | quote }} {{- end }} diff --git a/deploy/dockerephemeral/federation-v0/brig.yaml b/deploy/dockerephemeral/federation-v0/brig.yaml index 1864175667d..a236c83b90e 100644 --- a/deploy/dockerephemeral/federation-v0/brig.yaml +++ b/deploy/dockerephemeral/federation-v0/brig.yaml @@ -200,9 +200,6 @@ optSettings: # To only allow specific email address domains to register, uncomment and update the setting below # setAllowlistEmailDomains: # - wire.com - # To only allow specific phone number prefixes to register uncomment and update the settings below - # setAllowlistPhonePrefixes: - # - "+1555555" # needs to be kept in sync with services/nginz/integration-test/resources/oauth/ed25519_public.jwk setOAuthJwkKeyPair: /etc/wire/brig/conf/oauth-ed25519.jwk setOAuthAuthCodeExpirationTimeSecs: 3 # 3 secs diff --git a/docs/src/developer/reference/user/activation.md b/docs/src/developer/reference/user/activation.md index 373b2c190d3..a98a3fe48a2 100644 --- a/docs/src/developer/reference/user/activation.md +++ b/docs/src/developer/reference/user/activation.md @@ -6,7 +6,8 @@ _Author: Artyom Kazak_ --- -A user is called _activated_ they have a verified identity -- e.g. a phone number that has been verified via a text message, or an email address that has been verified by sending an activation code to it. +A user is called _activated_ when they have a verified identity -- an email +address that has been verified by sending an activation code to it. A user that has been provisioned via single sign-on is always considered to be activated. @@ -25,14 +26,17 @@ The only flow where it makes sense for non-activated users to exist is the [wire ### Requesting an activation code (RefActivationRequest)= -During the [standard registration flow](RefRegistrationStandard), the user submits an email address or phone number by making a request to `POST /activate/send`. A six-digit activation code will be sent to that email address / phone number. Sample request and response: +During the [standard registration flow](RefRegistrationStandard), the user +submits an email address by making a request to `POST /activate/send`. A +six-digit activation code will be sent to that email address. Sample request and +response: ``` POST /activate/send { - // Either 'email' or 'phone' - "phone": "+1234567890" + // the user's 'email' address + "email": "pink@example.com" } ``` @@ -40,9 +44,13 @@ POST /activate/send 200 OK ``` -The user can submit the activation code during registration to prove that they own the email address / phone number. +The user can submit the activation code during registration to prove that they +own the email address. -The same `POST /activate/send` endpoint can be used to re-request an activation code. Please use this ability sparingly! To avoid unnecessary activation code requests, users should be warned that it might take up to a few minutes for an email or text message to arrive. +The same `POST /activate/send` endpoint can be used to re-request an activation +code. Please use this ability sparingly! To avoid unnecessary activation code +requests, users should be warned that it might take up to a few minutes for an +email to arrive. ### Activating an existing account (RefActivationSubmit)= @@ -53,8 +61,8 @@ If the account [has not been activated during verification](RefRegistrationNoPre POST /activate { - // One of 'phone', 'email', or 'key' - "phone": "+1234567890", + // One of 'email', 'key' + "email": "pink@example.com", // 6-digit activation code "code": "123456", @@ -69,14 +77,16 @@ POST /activate 200 OK { - "phone": "+1234567890", + "email": "pink@example.com", // Whether it is the first successful activation for the user "first": true } ``` -If the email or phone has been verified already, `POST /activate` will return status code `204 No Content`. If the code is invalid, `POST /activate` will return status code `404 Not Found` with `"label": "invalid-code"`. +If the email has been verified already, `POST /activate` will return status code +`204 No Content`. If the code is invalid, `POST /activate` will return status +code `404 Not Found` with `"label": "invalid-code"`. There is a maximum of 3 activation attempts per activation code. On the third failed attempt the code is invalidated and a new one must be requested. @@ -112,7 +122,7 @@ GET /self } ``` -If the profile includes `"email"` or `"phone"`, the account is activated. +If the profile includes `"email"`, the account is activated. ## Automating activation via email (RefActivationEmailHeaders)= @@ -134,10 +144,10 @@ X-Zeta-Key: ... X-Zeta-Code: 123456 ``` -## Phone/email whitelist +## Email whitelist (RefActivationAllowlist)= -The backend can be configured to only allow specific phone number prefixes and email address domains to register. The following options have to be set in `brig.yaml`: +The backend can be configured to only allow specific email address domains to register. The following option has to be set in `brig.yaml`: ```yaml optSettings: @@ -145,19 +155,16 @@ optSettings: - wire.com - example.com - notagoodexample.com - setAllowlistPhonePrefixes: - - "+49" - - "+1555555" ``` When those options are present, the backend will match every activation request against these lists. -If an email address or phone number are rejected by the whitelist, `POST /activate/send` or `POST /register` will return `403 Forbidden`: +If an email address is rejected by the whitelist, `POST /activate/send` or `POST /register` will return `403 Forbidden`: ```json { "code": 403, "label": "unauthorized", - "message": "Unauthorized e-mail address or phone number." + "message": "Unauthorized e-mail address" } ``` diff --git a/docs/src/developer/reference/user/registration.md b/docs/src/developer/reference/user/registration.md index 90fb353d583..b598d4ac365 100644 --- a/docs/src/developer/reference/user/registration.md +++ b/docs/src/developer/reference/user/registration.md @@ -12,16 +12,17 @@ This page describes the "normal" user registration flow. Autoprovisioning is cov The vast majority of our API is only available to Wire users. Unless a user is autoprovisioned, they have to register an account by calling the `POST /register` endpoint. -Most users also go through [activation](activation.md) -- sharing and verifying an email address and/or phone number with Wire. This can happen either before or after registration. [Certain functionality](RefActivationBenefits) is only available to activated users. +Most users also go through [activation](activation.md) -- sharing and verifying +an email address with Wire. This can happen either before or after registration. +[Certain functionality](RefActivationBenefits) is only available to activated +users. ## Standard registration flow (RefRegistrationStandard)= -During the standard registration flow, the user first calls [`POST /activate/send`](RefActivationRequest) to pre-verify their email address or phone number. Phone numbers must be in [E.164][] format. +During the standard registration flow, the user first calls [`POST /activate/send`](RefActivationRequest) to pre-verify their email address. -[E.164]: https://en.wikipedia.org/wiki/E.164 - -After receiving a six-digit activation code via email/text message, it can be submitted with the registration request via `POST /register`. If the code is correct, the account will be activated immediately. Here is a sample request and response: +After receiving a six-digit activation code via email message, it can be submitted with the registration request via `POST /register`. If the code is correct, the account will be activated immediately. Here is a sample request and response: ``` POST /register @@ -30,13 +31,13 @@ POST /register // The name is mandatory "name": "Pink", - // 'email', 'phone', or both have to be provided + // 'email' has to be provided "email": "pink@example.com", // The password is optional "password": "secret", - // 6-digit 'email_code' or 'phone_code' + // 6-digit 'email_code' "email_code": "123456" } ``` @@ -76,7 +77,9 @@ If the code is incorrect or if an incorrect code has been tried enough times, th _NOTE: This flow is currently not used by any clients. At least this was the state on 2020-05-28_ -It is also possible to call `POST /register` without verifying the email address or phone number, in which case the account will have to be activated later by calling [`POST /activate`](RefActivationSubmit). Sample API request and response: +It is also possible to call `POST /register` without verifying the email +address, in which case the account will have to be activated later by calling +[`POST /activate`](RefActivationSubmit). Sample API request and response: ``` POST /register @@ -85,7 +88,7 @@ POST /register // The name is mandatory "name": "Pink", - // 'email', 'phone', or both have to be provided + // 'email' has to be provided "email": "pink@example.com", // The password is optional @@ -109,13 +112,15 @@ Set-Cookie: zuid=... } ``` -A verification email will be sent to the email address (if provided), and a verification text message will be sent to the phone number (also, if provided). +A verification email will be sent to the email address (if provided). ## Anonymous registration, aka "Wireless" (RefRegistrationWireless)= -A user can be created without either email or phone number, in which case only `"name"` is required. The `"name"` does not have to be unique. This feature is used for [guest rooms](https://wire.com/en/features/encrypted-guest-rooms/). +A user can be created without email, in which case only `"name"` is required. +The `"name"` does not have to be unique. This feature is used for [guest +rooms](https://wire.com/en/features/encrypted-guest-rooms/). An anonymous, non-activated account is only usable for a period of time specified in `brig.yaml` at `zauth.authSettings.sessionTokenTimeout`, which is set to 1 day for Wire production. (The access cookie returned by `/register` can not be refreshed, and an anonymous user can not use `/login` to get a new cookie.) @@ -172,7 +177,7 @@ These end-points support 5 flows: We need an option to block 1, 2, 5 on-prem; 3, 4 should remain available (no block option). There are also provisioning flows via SAML or SCIM, which are not critical. In short, this could refactored into: - * Allow team members to register (via email/phone or SSO) + * Allow team members to register (via email or SSO) * Allow ephemeral users During registration, we can take advantage of [NewUserOrigin](https://github.com/wireapp/wire-server/blob/a89b9cd818997e7837e5d0938ecfd90cf8dd9e52/libs/wire-api/src/Wire/API/User.hs#L625); we're particularly interested in `NewUserOriginTeamUser` --> only `NewTeamMember` or `NewTeamMemberSSO` should be accepted. In case this is a `Nothing`, we need to check if the user expires, i.e., if the user has no identity (and thus `Ephemeral`). diff --git a/docs/src/how-to/install/infrastructure-configuration.md b/docs/src/how-to/install/infrastructure-configuration.md index a9cf8f4941d..35821dd9c5c 100644 --- a/docs/src/how-to/install/infrastructure-configuration.md +++ b/docs/src/how-to/install/infrastructure-configuration.md @@ -527,23 +527,6 @@ Additionally, you may wish to build, sign, and host your own docker images to have increased confidence in those images. We haved "signed container images" on our roadmap. -## Sign up with a phone number (Sending SMS) - -**Provides**: - -- Registering accounts with a phone number - -**You need**: - -- a [Nexmo](https://www.nexmo.com/) account -- a [Twilio](https://www.twilio.com/) account - -**How to configure**: - -See the `brig` chart for configuration. - -(rd-party-proxying)= - ## 3rd-party proxying You need Giphy/Google/Spotify/Soundcloud API keys (if you want to diff --git a/docs/src/understand/api-client-perspective/authentication.md b/docs/src/understand/api-client-perspective/authentication.md index 8a734146546..a3e2efadb06 100644 --- a/docs/src/understand/api-client-perspective/authentication.md +++ b/docs/src/understand/api-client-perspective/authentication.md @@ -53,11 +53,10 @@ be removed in the future. ## Login - `POST /login` -A login is the process of authenticating a user either through a known secret in -a {ref}`password login ` or by proving ownership of a verified -phone number associated with an account in an {ref}`SMS login `. The -response to a successful login contains an access cookie in a `Set-Cookie` -header and an access token in the JSON response body. +A login is the process of authenticating a user either through a known +secret in a {ref}`password login `. The response to a +successful login contains an access cookie in a `Set-Cookie` header and an +access token in the JSON response body. (login-cookies)= @@ -92,8 +91,8 @@ The corresponding backend configuration settings are described in: ### Password Login To perform a password login, send a `POST` request to the `/login` -endpoint, providing either a verified email address or phone number and -the corresponding password. For example: +endpoint, providing either a verified email address and the corresponding +password. For example: ``` POST /login HTTP/1.1 @@ -105,11 +104,10 @@ POST /login HTTP/1.1 } ``` -If a phone number is used, the `phone` field is used instead of -`email`. If a @handle is used, the `handle` field is used instead of -`email` (note that the handle value should be sent *without* the `@` -symbol). Assuming the credentials are correct, the API will respond with -a `200 OK` and an access token and cookie: +If a @handle is used, the `handle` field is used instead of `email` (note +that the handle value should be sent *without* the `@` symbol). Assuming +the credentials are correct, the API will respond with a `200 OK` and an +access token and cookie: ``` HTTP/1.1 200 OK @@ -133,39 +131,6 @@ The value of `expires_in` is the number of seconds that the As of yet, the `token_type` is always `Bearer`. -(login-sms)= - -### SMS Login - -To perform an SMS login, first request an SMS code to be sent to a -verified phone number: - -``` -POST /login/send HTTP/1.1 -[headers omitted] - -{ - "phone": "+1234567890" -} -``` - -An SMS with a short-lived login code will be sent. Upon receiving the -SMS and extracting the code from it, the login can be performed using -the `phone` and `code` as follows: - -``` -POST /login HTTP/1.1 -[headers omitted] - -{ - "phone": "+1234567890", - "code": "123456" -} -``` - -A successful response is identical to that of a {ref}`password -login `. - (login-persistent)= ### Persistent Logins @@ -182,7 +147,7 @@ POST /login?persist=true HTTP/1.1 [headers omitted] { - "phone": "+1234567890", + "email": "alice@example.com", "code": "123456" } ``` @@ -282,7 +247,7 @@ POST /login?persist=true HTTP/1.1 [headers omitted] { - "phone": "+1234567890", + "email": "alice@example.com", "code": "123456", "label": "Google Nexus 5" } @@ -361,49 +326,42 @@ if you suspect your current password to be compromised. ### Initiate a Password Reset -To initiate a password reset, send a `POST` request to -`/password-reset`, specifying either a verified email address or phone -number for the account in question: +To initiate a password reset, send a `POST` request to `/password-reset`, +specifying a verified email address for the account in question: ``` POST /password-reset HTTP/1.1 [headers omitted] { - "phone": "+1234567890" + "email": "alice@example.com" } ``` -For a phone number, the `phone` field would be used instead. As a -result of a successful request, either a password reset key and code is -sent via email or a password reset code is sent via SMS, depending on -whether an email address or a phone number was provided. Password reset -emails will contain a link to the [wire.com](https://www.wire.com/) -website which will guide the user through the completion of the password -reset, which means that the website will perform the necessary requests -to complete the password reset. To complete a password reset initiated -with a phone number, the completion of the password reset has to happen -from the mobile client application itself. - -Once a password reset has been initiated for an email address or phone -number, no further password reset can be initiated for the same email -address or phone number before the prior reset is completed or times -out. The current timeout for an initiated password reset is -`10 minutes`. +As a result of a successful request, a password reset key and code are sent +via email. Password reset emails will contain a link to the +[wire.com](https://www.wire.com/) website which will guide the user through +the completion of the password reset, which means that the website will +perform the necessary requests to complete the password reset. + +Once a password reset has been initiated for an email address, no further +password reset can be initiated for the same email address before the prior +reset is completed or times out. The current timeout for an initiated +password reset is `10 minutes`. ### Complete a Password Reset To complete a password reset, the password reset code, together with the -new password and the `email` or `phone` used when initiating the -reset (or the opaque `key` sent by mail) are sent to -`/password-reset/complete` in a `POST` request: +new password and the `email` used when initiating the reset (or the opaque +`key` sent by mail) are sent to `/password-reset/complete` in a `POST` +request: ``` POST /password-reset/complete HTTP/1.1 [headers omitted] { - "phone": "+1234567890", + "email": "alice@example.com", "code": "123456", "password": "new-secret-password" } diff --git a/hack/helm_vars/wire-server/values.yaml.gotmpl b/hack/helm_vars/wire-server/values.yaml.gotmpl index e57f8a4b1cc..452b3864685 100644 --- a/hack/helm_vars/wire-server/values.yaml.gotmpl +++ b/hack/helm_vars/wire-server/values.yaml.gotmpl @@ -149,12 +149,6 @@ brig: secret: rPrUbws7PQZlfN2GG8Ggi7g5iOYPk7BiCoKHl3VoFZ awsKeyId: dummykey awsSecretKey: dummysecret - setTwilio: | - sid: "dummy" - token: "dummy" - setNexmo: |- - key: "dummy" - secret: "dummy" smtpPassword: dummy-smtp-password dpopSigKeyBundle: | -----BEGIN PRIVATE KEY----- diff --git a/integration/test/API/Brig.hs b/integration/test/API/Brig.hs index 362527c7a8f..c41865273e9 100644 --- a/integration/test/API/Brig.hs +++ b/integration/test/API/Brig.hs @@ -541,6 +541,12 @@ activateProvider dom key code = do submit "GET" (addQueryParams ps req) `bindResponse` \resp -> do resp.status `shouldMatchOneOf` [Number 200, Number 204] +activateUserV5 :: (HasCallStack, MakesValue dom, MakesValue bdy) => dom -> bdy -> App Response +activateUserV5 dom bdy = do + b <- make bdy + req <- rawBaseRequest dom Brig (ExplicitVersion 5) $ joinHttpPath ["activate", "send"] + submit "POST" $ (addJSON b req) + -- | Returns the value of the Set-Cookie header that is to be used to -- authenticate to provider endpoints. loginProvider :: diff --git a/integration/test/Test/User.hs b/integration/test/Test/User.hs index 4b397b680cc..183a391d779 100644 --- a/integration/test/Test/User.hs +++ b/integration/test/Test/User.hs @@ -6,6 +6,7 @@ import API.Brig import API.BrigInternal import API.GalleyInternal import API.Spar +import qualified Data.Aeson as Aeson import qualified Data.UUID as UUID import qualified Data.UUID.V4 as UUID import SetupHelpers @@ -163,3 +164,12 @@ data TestUpdateSelfMode | TestUpdateEmailAddress | TestUpdateLocale deriving (Eq, Show, Generic) + +testActivateAccountWithPhoneV5 :: (HasCallStack) => App () +testActivateAccountWithPhoneV5 = do + let dom = OwnDomain + let phone = "+4912345678" + let reqBody = Aeson.object ["phone" .= phone] + activateUserV5 dom reqBody `bindResponse` \resp -> do + resp.status `shouldMatchInt` 400 + resp.json %. "label" `shouldMatch` "invalid-phone" diff --git a/libs/brig-types/brig-types.cabal b/libs/brig-types/brig-types.cabal index 4d4d0640dd1..7f294c52fac 100644 --- a/libs/brig-types/brig-types.cabal +++ b/libs/brig-types/brig-types.cabal @@ -13,7 +13,6 @@ build-type: Simple library exposed-modules: Brig.Types.Activation - Brig.Types.Common Brig.Types.Connection Brig.Types.Instances Brig.Types.Intra diff --git a/libs/brig-types/src/Brig/Types/Common.hs b/libs/brig-types/src/Brig/Types/Common.hs deleted file mode 100644 index 0def1dde6a4..00000000000 --- a/libs/brig-types/src/Brig/Types/Common.hs +++ /dev/null @@ -1,32 +0,0 @@ --- This file is part of the Wire Server implementation. --- --- Copyright (C) 2022 Wire Swiss GmbH --- --- This program is free software: you can redistribute it and/or modify it under --- the terms of the GNU Affero General Public License as published by the Free --- Software Foundation, either version 3 of the License, or (at your option) any --- later version. --- --- This program is distributed in the hope that it will be useful, but WITHOUT --- ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS --- FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for more --- details. --- --- You should have received a copy of the GNU Affero General Public License along --- with this program. If not, see . - --- rename to Brig.Types.Account? -module Brig.Types.Common - ( -- * PhoneBudgetTimeout - PhoneBudgetTimeout (..), - - -- * PhonePrefix - PhonePrefix (..), - parsePhonePrefix, - isValidPhonePrefix, - allPrefixes, - ExcludedPrefix (..), - ) -where - -import Wire.API.User diff --git a/libs/brig-types/src/Brig/Types/Connection.hs b/libs/brig-types/src/Brig/Types/Connection.hs index f88cc8cd6e2..83345069204 100644 --- a/libs/brig-types/src/Brig/Types/Connection.hs +++ b/libs/brig-types/src/Brig/Types/Connection.hs @@ -19,11 +19,9 @@ -- -- Types for connections between users. module Brig.Types.Connection - ( module C, - UserIds (..), + ( UserIds (..), UpdateConnectionsInternal (..), ) where -import Brig.Types.Common as C import Wire.API.User diff --git a/libs/brig-types/src/Brig/Types/Test/Arbitrary.hs b/libs/brig-types/src/Brig/Types/Test/Arbitrary.hs index 05fb72d1925..fd00582837d 100644 --- a/libs/brig-types/src/Brig/Types/Test/Arbitrary.hs +++ b/libs/brig-types/src/Brig/Types/Test/Arbitrary.hs @@ -22,15 +22,11 @@ module Brig.Types.Test.Arbitrary ) where -import Brig.Types.Common import Brig.Types.Team.LegalHold import Imports import Test.QuickCheck import Wire.Arbitrary -instance Arbitrary ExcludedPrefix where - arbitrary = ExcludedPrefix <$> arbitrary <*> arbitrary - instance Arbitrary LegalHoldClientRequest where arbitrary = LegalHoldClientRequest diff --git a/libs/brig-types/test/unit/Test/Brig/Types/Common.hs b/libs/brig-types/test/unit/Test/Brig/Types/Common.hs index 6ef039f3cfe..92cdd9b7864 100644 --- a/libs/brig-types/test/unit/Test/Brig/Types/Common.hs +++ b/libs/brig-types/test/unit/Test/Brig/Types/Common.hs @@ -23,7 +23,6 @@ -- galley-types. module Test.Brig.Types.Common where -import Brig.Types.Common import Brig.Types.Team.LegalHold import Brig.Types.Test.Arbitrary () import Test.Brig.Roundtrip (testRoundTrip) @@ -35,7 +34,6 @@ tests :: TestTree tests = testGroup "Common (types vs. aeson)" - [ testRoundTrip @ExcludedPrefix, - testRoundTrip @LegalHoldService, + [ testRoundTrip @LegalHoldService, testRoundTrip @LegalHoldClientRequest ] diff --git a/libs/brig-types/test/unit/Test/Brig/Types/User.hs b/libs/brig-types/test/unit/Test/Brig/Types/User.hs index dee80388143..ee966465ad2 100644 --- a/libs/brig-types/test/unit/Test/Brig/Types/User.hs +++ b/libs/brig-types/test/unit/Test/Brig/Types/User.hs @@ -65,7 +65,7 @@ testCaseUserAccount = testCase "UserAcccount" $ do assertEqual "2" (Just json2) (encode <$> decode @UserAccount json2) where json1 :: LByteString - json1 = "{\"accent_id\":1,\"assets\":[],\"deleted\":true,\"expires_at\":\"1864-05-09T17:20:22.192Z\",\"handle\":\"-ve\",\"id\":\"00000000-0000-0001-0000-000100000000\",\"locale\":\"lu\",\"managed_by\":\"wire\",\"name\":\"bla\",\"phone\":\"+433017355611929\",\"picture\":[],\"qualified_id\":{\"domain\":\"4-o60.j7-i\",\"id\":\"00000000-0000-0001-0000-000100000000\"},\"service\":{\"id\":\"00000000-0000-0001-0000-000000000001\",\"provider\":\"00000001-0000-0001-0000-000000000001\"},\"status\":\"suspended\",\"supported_protocols\":[\"proteus\"],\"team\":\"00000000-0000-0001-0000-000100000001\"}" + json1 = "{\"accent_id\":1,\"assets\":[],\"deleted\":true,\"email\":\"foo@example.com\",\"expires_at\":\"1864-05-09T17:20:22.192Z\",\"handle\":\"-ve\",\"id\":\"00000000-0000-0001-0000-000100000000\",\"locale\":\"lu\",\"managed_by\":\"wire\",\"name\":\"bla\",\"picture\":[],\"qualified_id\":{\"domain\":\"4-o60.j7-i\",\"id\":\"00000000-0000-0001-0000-000100000000\"},\"service\":{\"id\":\"00000000-0000-0001-0000-000000000001\",\"provider\":\"00000001-0000-0001-0000-000000000001\"},\"status\":\"suspended\",\"supported_protocols\":[\"proteus\"],\"team\":\"00000000-0000-0001-0000-000100000001\"}" json2 :: LByteString json2 = "{\"accent_id\":0,\"assets\":[{\"key\":\"3-4-00000000-0000-0001-0000-000000000000\",\"size\":\"preview\",\"type\":\"image\"}],\"email\":\"@\",\"expires_at\":\"1864-05-10T22:45:44.823Z\",\"handle\":\"b8m\",\"id\":\"00000000-0000-0000-0000-000000000001\",\"locale\":\"tk-KZ\",\"managed_by\":\"wire\",\"name\":\"name2\",\"picture\":[],\"qualified_id\":{\"domain\":\"1-8wq0.b22k1.w5\",\"id\":\"00000000-0000-0000-0000-000000000001\"},\"service\":{\"id\":\"00000000-0000-0001-0000-000000000001\",\"provider\":\"00000001-0000-0001-0000-000100000000\"},\"status\":\"pending-invitation\",\"supported_protocols\":[\"proteus\"],\"team\":\"00000000-0000-0001-0000-000000000001\"}" diff --git a/libs/ropes/.ormolu b/libs/ropes/.ormolu deleted file mode 120000 index 157b212d7cd..00000000000 --- a/libs/ropes/.ormolu +++ /dev/null @@ -1 +0,0 @@ -../../.ormolu \ No newline at end of file diff --git a/libs/ropes/LICENSE b/libs/ropes/LICENSE deleted file mode 100644 index dba13ed2ddf..00000000000 --- a/libs/ropes/LICENSE +++ /dev/null @@ -1,661 +0,0 @@ - GNU AFFERO GENERAL PUBLIC LICENSE - Version 3, 19 November 2007 - - Copyright (C) 2007 Free Software Foundation, Inc. - Everyone is permitted to copy and distribute verbatim copies - of this license document, but changing it is not allowed. - - Preamble - - The GNU Affero General Public License is a free, copyleft license for -software and other kinds of works, specifically designed to ensure -cooperation with the community in the case of network server software. - - The licenses for most software and other practical works are designed -to take away your freedom to share and change the works. By contrast, -our General Public Licenses are intended to guarantee your freedom to -share and change all versions of a program--to make sure it remains free -software for all its users. - - When we speak of free software, we are referring to freedom, not -price. Our General Public Licenses are designed to make sure that you -have the freedom to distribute copies of free software (and charge for -them if you wish), that you receive source code or can get it if you -want it, that you can change the software or use pieces of it in new -free programs, and that you know you can do these things. - - Developers that use our General Public Licenses protect your rights -with two steps: (1) assert copyright on the software, and (2) offer -you this License which gives you legal permission to copy, distribute -and/or modify the software. - - A secondary benefit of defending all users' freedom is that -improvements made in alternate versions of the program, if they -receive widespread use, become available for other developers to -incorporate. Many developers of free software are heartened and -encouraged by the resulting cooperation. However, in the case of -software used on network servers, this result may fail to come about. -The GNU General Public License permits making a modified version and -letting the public access it on a server without ever releasing its -source code to the public. - - The GNU Affero General Public License is designed specifically to -ensure that, in such cases, the modified source code becomes available -to the community. It requires the operator of a network server to -provide the source code of the modified version running there to the -users of that server. Therefore, public use of a modified version, on -a publicly accessible server, gives the public access to the source -code of the modified version. - - An older license, called the Affero General Public License and -published by Affero, was designed to accomplish similar goals. This is -a different license, not a version of the Affero GPL, but Affero has -released a new version of the Affero GPL which permits relicensing under -this license. - - The precise terms and conditions for copying, distribution and -modification follow. - - TERMS AND CONDITIONS - - 0. Definitions. - - "This License" refers to version 3 of the GNU Affero General Public License. - - "Copyright" also means copyright-like laws that apply to other kinds of -works, such as semiconductor masks. - - "The Program" refers to any copyrightable work licensed under this -License. Each licensee is addressed as "you". "Licensees" and -"recipients" may be individuals or organizations. - - To "modify" a work means to copy from or adapt all or part of the work -in a fashion requiring copyright permission, other than the making of an -exact copy. The resulting work is called a "modified version" of the -earlier work or a work "based on" the earlier work. - - A "covered work" means either the unmodified Program or a work based -on the Program. - - To "propagate" a work means to do anything with it that, without -permission, would make you directly or secondarily liable for -infringement under applicable copyright law, except executing it on a -computer or modifying a private copy. Propagation includes copying, -distribution (with or without modification), making available to the -public, and in some countries other activities as well. - - To "convey" a work means any kind of propagation that enables other -parties to make or receive copies. Mere interaction with a user through -a computer network, with no transfer of a copy, is not conveying. - - An interactive user interface displays "Appropriate Legal Notices" -to the extent that it includes a convenient and prominently visible -feature that (1) displays an appropriate copyright notice, and (2) -tells the user that there is no warranty for the work (except to the -extent that warranties are provided), that licensees may convey the -work under this License, and how to view a copy of this License. If -the interface presents a list of user commands or options, such as a -menu, a prominent item in the list meets this criterion. - - 1. Source Code. - - The "source code" for a work means the preferred form of the work -for making modifications to it. "Object code" means any non-source -form of a work. - - A "Standard Interface" means an interface that either is an official -standard defined by a recognized standards body, or, in the case of -interfaces specified for a particular programming language, one that -is widely used among developers working in that language. - - The "System Libraries" of an executable work include anything, other -than the work as a whole, that (a) is included in the normal form of -packaging a Major Component, but which is not part of that Major -Component, and (b) serves only to enable use of the work with that -Major Component, or to implement a Standard Interface for which an -implementation is available to the public in source code form. A -"Major Component", in this context, means a major essential component -(kernel, window system, and so on) of the specific operating system -(if any) on which the executable work runs, or a compiler used to -produce the work, or an object code interpreter used to run it. - - The "Corresponding Source" for a work in object code form means all -the source code needed to generate, install, and (for an executable -work) run the object code and to modify the work, including scripts to -control those activities. However, it does not include the work's -System Libraries, or general-purpose tools or generally available free -programs which are used unmodified in performing those activities but -which are not part of the work. For example, Corresponding Source -includes interface definition files associated with source files for -the work, and the source code for shared libraries and dynamically -linked subprograms that the work is specifically designed to require, -such as by intimate data communication or control flow between those -subprograms and other parts of the work. - - The Corresponding Source need not include anything that users -can regenerate automatically from other parts of the Corresponding -Source. - - The Corresponding Source for a work in source code form is that -same work. - - 2. Basic Permissions. - - All rights granted under this License are granted for the term of -copyright on the Program, and are irrevocable provided the stated -conditions are met. This License explicitly affirms your unlimited -permission to run the unmodified Program. The output from running a -covered work is covered by this License only if the output, given its -content, constitutes a covered work. This License acknowledges your -rights of fair use or other equivalent, as provided by copyright law. - - You may make, run and propagate covered works that you do not -convey, without conditions so long as your license otherwise remains -in force. You may convey covered works to others for the sole purpose -of having them make modifications exclusively for you, or provide you -with facilities for running those works, provided that you comply with -the terms of this License in conveying all material for which you do -not control copyright. Those thus making or running the covered works -for you must do so exclusively on your behalf, under your direction -and control, on terms that prohibit them from making any copies of -your copyrighted material outside their relationship with you. - - Conveying under any other circumstances is permitted solely under -the conditions stated below. Sublicensing is not allowed; section 10 -makes it unnecessary. - - 3. Protecting Users' Legal Rights From Anti-Circumvention Law. - - No covered work shall be deemed part of an effective technological -measure under any applicable law fulfilling obligations under article -11 of the WIPO copyright treaty adopted on 20 December 1996, or -similar laws prohibiting or restricting circumvention of such -measures. - - When you convey a covered work, you waive any legal power to forbid -circumvention of technological measures to the extent such circumvention -is effected by exercising rights under this License with respect to -the covered work, and you disclaim any intention to limit operation or -modification of the work as a means of enforcing, against the work's -users, your or third parties' legal rights to forbid circumvention of -technological measures. - - 4. Conveying Verbatim Copies. - - You may convey verbatim copies of the Program's source code as you -receive it, in any medium, provided that you conspicuously and -appropriately publish on each copy an appropriate copyright notice; -keep intact all notices stating that this License and any -non-permissive terms added in accord with section 7 apply to the code; -keep intact all notices of the absence of any warranty; and give all -recipients a copy of this License along with the Program. - - You may charge any price or no price for each copy that you convey, -and you may offer support or warranty protection for a fee. - - 5. Conveying Modified Source Versions. - - You may convey a work based on the Program, or the modifications to -produce it from the Program, in the form of source code under the -terms of section 4, provided that you also meet all of these conditions: - - a) The work must carry prominent notices stating that you modified - it, and giving a relevant date. - - b) The work must carry prominent notices stating that it is - released under this License and any conditions added under section - 7. This requirement modifies the requirement in section 4 to - "keep intact all notices". - - c) You must license the entire work, as a whole, under this - License to anyone who comes into possession of a copy. This - License will therefore apply, along with any applicable section 7 - additional terms, to the whole of the work, and all its parts, - regardless of how they are packaged. This License gives no - permission to license the work in any other way, but it does not - invalidate such permission if you have separately received it. - - d) If the work has interactive user interfaces, each must display - Appropriate Legal Notices; however, if the Program has interactive - interfaces that do not display Appropriate Legal Notices, your - work need not make them do so. - - A compilation of a covered work with other separate and independent -works, which are not by their nature extensions of the covered work, -and which are not combined with it such as to form a larger program, -in or on a volume of a storage or distribution medium, is called an -"aggregate" if the compilation and its resulting copyright are not -used to limit the access or legal rights of the compilation's users -beyond what the individual works permit. Inclusion of a covered work -in an aggregate does not cause this License to apply to the other -parts of the aggregate. - - 6. Conveying Non-Source Forms. - - You may convey a covered work in object code form under the terms -of sections 4 and 5, provided that you also convey the -machine-readable Corresponding Source under the terms of this License, -in one of these ways: - - a) Convey the object code in, or embodied in, a physical product - (including a physical distribution medium), accompanied by the - Corresponding Source fixed on a durable physical medium - customarily used for software interchange. - - b) Convey the object code in, or embodied in, a physical product - (including a physical distribution medium), accompanied by a - written offer, valid for at least three years and valid for as - long as you offer spare parts or customer support for that product - model, to give anyone who possesses the object code either (1) a - copy of the Corresponding Source for all the software in the - product that is covered by this License, on a durable physical - medium customarily used for software interchange, for a price no - more than your reasonable cost of physically performing this - conveying of source, or (2) access to copy the - Corresponding Source from a network server at no charge. - - c) Convey individual copies of the object code with a copy of the - written offer to provide the Corresponding Source. This - alternative is allowed only occasionally and noncommercially, and - only if you received the object code with such an offer, in accord - with subsection 6b. - - d) Convey the object code by offering access from a designated - place (gratis or for a charge), and offer equivalent access to the - Corresponding Source in the same way through the same place at no - further charge. You need not require recipients to copy the - Corresponding Source along with the object code. If the place to - copy the object code is a network server, the Corresponding Source - may be on a different server (operated by you or a third party) - that supports equivalent copying facilities, provided you maintain - clear directions next to the object code saying where to find the - Corresponding Source. Regardless of what server hosts the - Corresponding Source, you remain obligated to ensure that it is - available for as long as needed to satisfy these requirements. - - e) Convey the object code using peer-to-peer transmission, provided - you inform other peers where the object code and Corresponding - Source of the work are being offered to the general public at no - charge under subsection 6d. - - A separable portion of the object code, whose source code is excluded -from the Corresponding Source as a System Library, need not be -included in conveying the object code work. - - A "User Product" is either (1) a "consumer product", which means any -tangible personal property which is normally used for personal, family, -or household purposes, or (2) anything designed or sold for incorporation -into a dwelling. In determining whether a product is a consumer product, -doubtful cases shall be resolved in favor of coverage. For a particular -product received by a particular user, "normally used" refers to a -typical or common use of that class of product, regardless of the status -of the particular user or of the way in which the particular user -actually uses, or expects or is expected to use, the product. A product -is a consumer product regardless of whether the product has substantial -commercial, industrial or non-consumer uses, unless such uses represent -the only significant mode of use of the product. - - "Installation Information" for a User Product means any methods, -procedures, authorization keys, or other information required to install -and execute modified versions of a covered work in that User Product from -a modified version of its Corresponding Source. The information must -suffice to ensure that the continued functioning of the modified object -code is in no case prevented or interfered with solely because -modification has been made. - - If you convey an object code work under this section in, or with, or -specifically for use in, a User Product, and the conveying occurs as -part of a transaction in which the right of possession and use of the -User Product is transferred to the recipient in perpetuity or for a -fixed term (regardless of how the transaction is characterized), the -Corresponding Source conveyed under this section must be accompanied -by the Installation Information. But this requirement does not apply -if neither you nor any third party retains the ability to install -modified object code on the User Product (for example, the work has -been installed in ROM). - - The requirement to provide Installation Information does not include a -requirement to continue to provide support service, warranty, or updates -for a work that has been modified or installed by the recipient, or for -the User Product in which it has been modified or installed. Access to a -network may be denied when the modification itself materially and -adversely affects the operation of the network or violates the rules and -protocols for communication across the network. - - Corresponding Source conveyed, and Installation Information provided, -in accord with this section must be in a format that is publicly -documented (and with an implementation available to the public in -source code form), and must require no special password or key for -unpacking, reading or copying. - - 7. Additional Terms. - - "Additional permissions" are terms that supplement the terms of this -License by making exceptions from one or more of its conditions. -Additional permissions that are applicable to the entire Program shall -be treated as though they were included in this License, to the extent -that they are valid under applicable law. If additional permissions -apply only to part of the Program, that part may be used separately -under those permissions, but the entire Program remains governed by -this License without regard to the additional permissions. - - When you convey a copy of a covered work, you may at your option -remove any additional permissions from that copy, or from any part of -it. (Additional permissions may be written to require their own -removal in certain cases when you modify the work.) You may place -additional permissions on material, added by you to a covered work, -for which you have or can give appropriate copyright permission. - - Notwithstanding any other provision of this License, for material you -add to a covered work, you may (if authorized by the copyright holders of -that material) supplement the terms of this License with terms: - - a) Disclaiming warranty or limiting liability differently from the - terms of sections 15 and 16 of this License; or - - b) Requiring preservation of specified reasonable legal notices or - author attributions in that material or in the Appropriate Legal - Notices displayed by works containing it; or - - c) Prohibiting misrepresentation of the origin of that material, or - requiring that modified versions of such material be marked in - reasonable ways as different from the original version; or - - d) Limiting the use for publicity purposes of names of licensors or - authors of the material; or - - e) Declining to grant rights under trademark law for use of some - trade names, trademarks, or service marks; or - - f) Requiring indemnification of licensors and authors of that - material by anyone who conveys the material (or modified versions of - it) with contractual assumptions of liability to the recipient, for - any liability that these contractual assumptions directly impose on - those licensors and authors. - - All other non-permissive additional terms are considered "further -restrictions" within the meaning of section 10. If the Program as you -received it, or any part of it, contains a notice stating that it is -governed by this License along with a term that is a further -restriction, you may remove that term. If a license document contains -a further restriction but permits relicensing or conveying under this -License, you may add to a covered work material governed by the terms -of that license document, provided that the further restriction does -not survive such relicensing or conveying. - - If you add terms to a covered work in accord with this section, you -must place, in the relevant source files, a statement of the -additional terms that apply to those files, or a notice indicating -where to find the applicable terms. - - Additional terms, permissive or non-permissive, may be stated in the -form of a separately written license, or stated as exceptions; -the above requirements apply either way. - - 8. Termination. - - You may not propagate or modify a covered work except as expressly -provided under this License. Any attempt otherwise to propagate or -modify it is void, and will automatically terminate your rights under -this License (including any patent licenses granted under the third -paragraph of section 11). - - However, if you cease all violation of this License, then your -license from a particular copyright holder is reinstated (a) -provisionally, unless and until the copyright holder explicitly and -finally terminates your license, and (b) permanently, if the copyright -holder fails to notify you of the violation by some reasonable means -prior to 60 days after the cessation. - - Moreover, your license from a particular copyright holder is -reinstated permanently if the copyright holder notifies you of the -violation by some reasonable means, this is the first time you have -received notice of violation of this License (for any work) from that -copyright holder, and you cure the violation prior to 30 days after -your receipt of the notice. - - Termination of your rights under this section does not terminate the -licenses of parties who have received copies or rights from you under -this License. If your rights have been terminated and not permanently -reinstated, you do not qualify to receive new licenses for the same -material under section 10. - - 9. Acceptance Not Required for Having Copies. - - You are not required to accept this License in order to receive or -run a copy of the Program. Ancillary propagation of a covered work -occurring solely as a consequence of using peer-to-peer transmission -to receive a copy likewise does not require acceptance. However, -nothing other than this License grants you permission to propagate or -modify any covered work. These actions infringe copyright if you do -not accept this License. Therefore, by modifying or propagating a -covered work, you indicate your acceptance of this License to do so. - - 10. Automatic Licensing of Downstream Recipients. - - Each time you convey a covered work, the recipient automatically -receives a license from the original licensors, to run, modify and -propagate that work, subject to this License. You are not responsible -for enforcing compliance by third parties with this License. - - An "entity transaction" is a transaction transferring control of an -organization, or substantially all assets of one, or subdividing an -organization, or merging organizations. If propagation of a covered -work results from an entity transaction, each party to that -transaction who receives a copy of the work also receives whatever -licenses to the work the party's predecessor in interest had or could -give under the previous paragraph, plus a right to possession of the -Corresponding Source of the work from the predecessor in interest, if -the predecessor has it or can get it with reasonable efforts. - - You may not impose any further restrictions on the exercise of the -rights granted or affirmed under this License. For example, you may -not impose a license fee, royalty, or other charge for exercise of -rights granted under this License, and you may not initiate litigation -(including a cross-claim or counterclaim in a lawsuit) alleging that -any patent claim is infringed by making, using, selling, offering for -sale, or importing the Program or any portion of it. - - 11. Patents. - - A "contributor" is a copyright holder who authorizes use under this -License of the Program or a work on which the Program is based. The -work thus licensed is called the contributor's "contributor version". - - A contributor's "essential patent claims" are all patent claims -owned or controlled by the contributor, whether already acquired or -hereafter acquired, that would be infringed by some manner, permitted -by this License, of making, using, or selling its contributor version, -but do not include claims that would be infringed only as a -consequence of further modification of the contributor version. For -purposes of this definition, "control" includes the right to grant -patent sublicenses in a manner consistent with the requirements of -this License. - - Each contributor grants you a non-exclusive, worldwide, royalty-free -patent license under the contributor's essential patent claims, to -make, use, sell, offer for sale, import and otherwise run, modify and -propagate the contents of its contributor version. - - In the following three paragraphs, a "patent license" is any express -agreement or commitment, however denominated, not to enforce a patent -(such as an express permission to practice a patent or covenant not to -sue for patent infringement). To "grant" such a patent license to a -party means to make such an agreement or commitment not to enforce a -patent against the party. - - If you convey a covered work, knowingly relying on a patent license, -and the Corresponding Source of the work is not available for anyone -to copy, free of charge and under the terms of this License, through a -publicly available network server or other readily accessible means, -then you must either (1) cause the Corresponding Source to be so -available, or (2) arrange to deprive yourself of the benefit of the -patent license for this particular work, or (3) arrange, in a manner -consistent with the requirements of this License, to extend the patent -license to downstream recipients. "Knowingly relying" means you have -actual knowledge that, but for the patent license, your conveying the -covered work in a country, or your recipient's use of the covered work -in a country, would infringe one or more identifiable patents in that -country that you have reason to believe are valid. - - If, pursuant to or in connection with a single transaction or -arrangement, you convey, or propagate by procuring conveyance of, a -covered work, and grant a patent license to some of the parties -receiving the covered work authorizing them to use, propagate, modify -or convey a specific copy of the covered work, then the patent license -you grant is automatically extended to all recipients of the covered -work and works based on it. - - A patent license is "discriminatory" if it does not include within -the scope of its coverage, prohibits the exercise of, or is -conditioned on the non-exercise of one or more of the rights that are -specifically granted under this License. You may not convey a covered -work if you are a party to an arrangement with a third party that is -in the business of distributing software, under which you make payment -to the third party based on the extent of your activity of conveying -the work, and under which the third party grants, to any of the -parties who would receive the covered work from you, a discriminatory -patent license (a) in connection with copies of the covered work -conveyed by you (or copies made from those copies), or (b) primarily -for and in connection with specific products or compilations that -contain the covered work, unless you entered into that arrangement, -or that patent license was granted, prior to 28 March 2007. - - Nothing in this License shall be construed as excluding or limiting -any implied license or other defenses to infringement that may -otherwise be available to you under applicable patent law. - - 12. No Surrender of Others' Freedom. - - If conditions are imposed on you (whether by court order, agreement or -otherwise) that contradict the conditions of this License, they do not -excuse you from the conditions of this License. If you cannot convey a -covered work so as to satisfy simultaneously your obligations under this -License and any other pertinent obligations, then as a consequence you may -not convey it at all. For example, if you agree to terms that obligate you -to collect a royalty for further conveying from those to whom you convey -the Program, the only way you could satisfy both those terms and this -License would be to refrain entirely from conveying the Program. - - 13. Remote Network Interaction; Use with the GNU General Public License. - - Notwithstanding any other provision of this License, if you modify the -Program, your modified version must prominently offer all users -interacting with it remotely through a computer network (if your version -supports such interaction) an opportunity to receive the Corresponding -Source of your version by providing access to the Corresponding Source -from a network server at no charge, through some standard or customary -means of facilitating copying of software. This Corresponding Source -shall include the Corresponding Source for any work covered by version 3 -of the GNU General Public License that is incorporated pursuant to the -following paragraph. - - Notwithstanding any other provision of this License, you have -permission to link or combine any covered work with a work licensed -under version 3 of the GNU General Public License into a single -combined work, and to convey the resulting work. The terms of this -License will continue to apply to the part which is the covered work, -but the work with which it is combined will remain governed by version -3 of the GNU General Public License. - - 14. Revised Versions of this License. - - The Free Software Foundation may publish revised and/or new versions of -the GNU Affero General Public License from time to time. Such new versions -will be similar in spirit to the present version, but may differ in detail to -address new problems or concerns. - - Each version is given a distinguishing version number. If the -Program specifies that a certain numbered version of the GNU Affero General -Public License "or any later version" applies to it, you have the -option of following the terms and conditions either of that numbered -version or of any later version published by the Free Software -Foundation. If the Program does not specify a version number of the -GNU Affero General Public License, you may choose any version ever published -by the Free Software Foundation. - - If the Program specifies that a proxy can decide which future -versions of the GNU Affero General Public License can be used, that proxy's -public statement of acceptance of a version permanently authorizes you -to choose that version for the Program. - - Later license versions may give you additional or different -permissions. However, no additional obligations are imposed on any -author or copyright holder as a result of your choosing to follow a -later version. - - 15. Disclaimer of Warranty. - - THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY -APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT -HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY -OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, -THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR -PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM -IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF -ALL NECESSARY SERVICING, REPAIR OR CORRECTION. - - 16. Limitation of Liability. - - IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING -WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MODIFIES AND/OR CONVEYS -THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY -GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE -USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF -DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD -PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS), -EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF -SUCH DAMAGES. - - 17. Interpretation of Sections 15 and 16. - - If the disclaimer of warranty and limitation of liability provided -above cannot be given local legal effect according to their terms, -reviewing courts shall apply local law that most closely approximates -an absolute waiver of all civil liability in connection with the -Program, unless a warranty or assumption of liability accompanies a -copy of the Program in return for a fee. - - END OF TERMS AND CONDITIONS - - How to Apply These Terms to Your New Programs - - If you develop a new program, and you want it to be of the greatest -possible use to the public, the best way to achieve this is to make it -free software which everyone can redistribute and change under these terms. - - To do so, attach the following notices to the program. It is safest -to attach them to the start of each source file to most effectively -state the exclusion of warranty; and each file should have at least -the "copyright" line and a pointer to where the full notice is found. - - - Copyright (C) - - This program is free software: you can redistribute it and/or modify - it under the terms of the GNU Affero General Public License as published by - the Free Software Foundation, either version 3 of the License, or - (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU Affero General Public License for more details. - - You should have received a copy of the GNU Affero General Public License - along with this program. If not, see . - -Also add information on how to contact you by electronic and paper mail. - - If your software can interact with users remotely through a computer -network, you should also make sure that it provides a way for users to -get its source. For example, if your program is a web application, its -interface could display a "Source" link that leads users to an archive -of the code. There are many ways you could offer source, and different -solutions will be better for different programs; see section 13 for the -specific requirements. - - You should also get your employer (if you work as a programmer) or school, -if any, to sign a "copyright disclaimer" for the program, if necessary. -For more information on this, and how to apply and follow the GNU AGPL, see -. diff --git a/libs/ropes/default.nix b/libs/ropes/default.nix deleted file mode 100644 index 6dd3c1ed69f..00000000000 --- a/libs/ropes/default.nix +++ /dev/null @@ -1,37 +0,0 @@ -# WARNING: GENERATED FILE, DO NOT EDIT. -# This file is generated by running hack/bin/generate-local-nix-packages.sh and -# must be regenerated whenever local packages are added or removed, or -# dependencies are added or removed. -{ mkDerivation -, aeson -, base -, bytestring -, errors -, gitignoreSource -, http-client -, http-types -, imports -, iso3166-country-codes -, lib -, text -, time -}: -mkDerivation { - pname = "ropes"; - version = "0.4.20"; - src = gitignoreSource ./.; - libraryHaskellDepends = [ - aeson - base - bytestring - errors - http-client - http-types - imports - iso3166-country-codes - text - time - ]; - description = "Various ropes to tie together with external web services"; - license = lib.licenses.agpl3Only; -} diff --git a/libs/ropes/ropes.cabal b/libs/ropes/ropes.cabal deleted file mode 100644 index 0a5e9457039..00000000000 --- a/libs/ropes/ropes.cabal +++ /dev/null @@ -1,79 +0,0 @@ -cabal-version: 1.12 -name: ropes -version: 0.4.20 -synopsis: Various ropes to tie together with external web services. -category: Network -author: Wire Swiss GmbH -maintainer: Wire Swiss GmbH -copyright: (c) 2017 Wire Swiss GmbH -license: AGPL-3 -license-file: LICENSE -build-type: Simple - -library - exposed-modules: - Ropes.Nexmo - Ropes.Twilio - - other-modules: Paths_ropes - hs-source-dirs: src - default-extensions: - AllowAmbiguousTypes - BangPatterns - ConstraintKinds - DataKinds - DefaultSignatures - DeriveFunctor - DeriveGeneric - DeriveLift - DeriveTraversable - DerivingStrategies - DerivingVia - DuplicateRecordFields - EmptyCase - FlexibleContexts - FlexibleInstances - FunctionalDependencies - GADTs - InstanceSigs - KindSignatures - LambdaCase - MultiParamTypeClasses - MultiWayIf - NamedFieldPuns - NoImplicitPrelude - OverloadedRecordDot - OverloadedStrings - PackageImports - PatternSynonyms - PolyKinds - QuasiQuotes - RankNTypes - ScopedTypeVariables - StandaloneDeriving - TupleSections - TypeApplications - TypeFamilies - TypeFamilyDependencies - TypeOperators - UndecidableInstances - ViewPatterns - - ghc-options: - -O2 -Wall -Wincomplete-uni-patterns -Wincomplete-record-updates - -Wpartial-fields -fwarn-tabs -optP-Wno-nonportable-include-path - -Wredundant-constraints -Wunused-packages - - build-depends: - aeson >=2.0.1.0 - , base >=4 && <5 - , bytestring >=0.9 - , errors >=2.0 - , http-client >=0.7 - , http-types >=0.7 - , imports - , iso3166-country-codes >=0.20140203.7 - , text >=0.11 - , time >=1.1 - - default-language: GHC2021 diff --git a/libs/ropes/src/Ropes/Nexmo.hs b/libs/ropes/src/Ropes/Nexmo.hs deleted file mode 100644 index 9f1900a86f4..00000000000 --- a/libs/ropes/src/Ropes/Nexmo.hs +++ /dev/null @@ -1,356 +0,0 @@ -{-# LANGUAGE DeriveDataTypeable #-} -{-# LANGUAGE GeneralizedNewtypeDeriving #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE ScopedTypeVariables #-} - --- This file is part of the Wire Server implementation. --- --- Copyright (C) 2022 Wire Swiss GmbH --- --- This program is free software: you can redistribute it and/or modify it under --- the terms of the GNU Affero General Public License as published by the Free --- Software Foundation, either version 3 of the License, or (at your option) any --- later version. --- --- This program is distributed in the hope that it will be useful, but WITHOUT --- ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS --- FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for more --- details. --- --- You should have received a copy of the GNU Affero General Public License along --- with this program. If not, see . - -module Ropes.Nexmo - ( -- * Types - ApiKey (..), - ApiSecret (..), - Credentials, - ParseError (..), - Charset (..), - - -- * SMS - MessageErrorResponse (..), - MessageErrorStatus (..), - Message (..), - MessageId, - MessageResponse, - - -- * Call - Call (..), - CallId, - CallErrorResponse (..), - CallErrorStatus (..), - - -- * Functions - sendCall, - sendMessage, - sendMessages, - sendFeedback, - msgIds, - ) -where - -import Control.Exception -import Data.Aeson -import Data.Aeson.Types -import Data.ByteString.Lazy (toStrict) -import Data.List.NonEmpty (NonEmpty (..)) -import Data.List.NonEmpty qualified as N -import Data.Text.Encoding (decodeUtf8) -import Data.Time (UTCTime) -import Data.Time.Format (defaultTimeLocale, formatTime) -import Imports hiding (head, length) -import Network.HTTP.Client hiding (Response) -import Network.HTTP.Types - --- * Types - -newtype ApiKey = ApiKey Text deriving (FromJSON) - -newtype ApiSecret = ApiSecret Text deriving (FromJSON) - -data Charset = GSM7 | GSM8 | UCS2 deriving (Eq, Show) - -data Credentials = Credentials - { key :: ApiKey, - secret :: ApiSecret - } - -instance FromJSON Credentials where - parseJSON = withObject "credentials" $ \o -> - Credentials - <$> o .: "key" - <*> o .: "secret" - --- * SMS related - -newtype MessageId = MessageId {messageIdText :: Text} deriving (Eq, Show) - -data Message = Message - { msgFrom :: !Text, - msgTo :: !Text, - msgText :: !Text, - msgType :: !Charset - } - deriving (Eq, Show) - -newtype MessageResponse = MessageResponse {msgIds :: NonEmpty MessageId} - deriving (Eq, Show) - -data MessageErrorStatus - = MessageThrottled - | MessageInternal - | MessageUnroutable - | MessageNumBarred - | MessagePartnerAccountBarred - | MessagePartnerQuotaExceeded - | MessageTooLong - | MessageCommunicationFailed - | MessageInvalidSenderAddress - | MessageFacilityNotAllowed - | MessageInvalidMessageClass - | MessageOther - deriving (Eq, Show) - -instance FromJSON MessageErrorStatus where - parseJSON "1" = pure MessageThrottled - parseJSON "5" = pure MessageInternal - parseJSON "6" = pure MessageUnroutable - parseJSON "7" = pure MessageNumBarred - parseJSON "8" = pure MessagePartnerAccountBarred - parseJSON "9" = pure MessagePartnerQuotaExceeded - parseJSON "12" = pure MessageTooLong - parseJSON "13" = pure MessageCommunicationFailed - parseJSON "15" = pure MessageInvalidSenderAddress - parseJSON "19" = pure MessageFacilityNotAllowed - parseJSON "20" = pure MessageInvalidMessageClass - parseJSON _ = pure MessageOther - -data MessageErrorResponse = MessageErrorResponse - { erStatus :: !MessageErrorStatus, - erErrorText :: !(Maybe Text) - } - deriving (Eq, Show, Typeable) - -instance Exception MessageErrorResponse - -instance FromJSON MessageErrorResponse where - parseJSON = withObject "message-error-response" $ \o -> - MessageErrorResponse - <$> o .: "status" - <*> o .:? "error-text" - -newtype ParseError = ParseError String - deriving (Eq, Show, Typeable) - -instance Exception ParseError - -instance FromJSON MessageId where - parseJSON = withText "MessageId" $ pure . MessageId - -instance ToJSON MessageId where - toJSON = String . messageIdText - -instance FromJSON Charset where - parseJSON "text" = pure GSM7 - parseJSON "binary" = pure GSM8 - parseJSON "unicode" = pure UCS2 - parseJSON x = fail $ "Unsupported charset " <> show x - -instance ToJSON Charset where - toJSON GSM7 = "text" - toJSON GSM8 = "binary" - toJSON UCS2 = "unicode" - --- * Internal message parsers - -parseMessageFeedback :: Value -> Parser (Either MessageErrorResponse MessageId) -parseMessageFeedback j@(Object o) = do - st <- o .: "status" - case (st :: Text) of - "0" -> Right <$> parseMessageId j - _ -> Left <$> parseJSON j -parseMessageFeedback _ = fail "Ropes.Nexmo: message should be an object" - -parseMessageId :: Value -> Parser MessageId -parseMessageId = withObject "message-response" (.: "message-id") - -parseMessageResponse :: Value -> Parser (Either MessageErrorResponse MessageResponse) -parseMessageResponse = withObject "nexmo-response" $ \o -> do - xs <- o .: "messages" - ys <- sequence <$> mapM parseMessageFeedback xs - case ys of - Left e -> pure $ Left e - Right (f : fs) -> pure $ Right $ MessageResponse (f :| fs) - Right _ -> fail "Must have at least one message-id" - --- * Call related - -newtype CallId = CallId {callIdText :: Text} deriving (Eq, Show) - -data Call = Call - { callFrom :: !(Maybe Text), - callTo :: !Text, - callText :: !Text, - callLang :: !(Maybe Text), - callRepeat :: !(Maybe Int) - } - -data CallErrorStatus - = CallThrottled - | CallInternal - | CallDestinationNotPermitted - | CallDestinationBarred - | CallPartnerQuotaExceeded - | CallInvalidDestinationAddress - | CallUnroutable - | CallOther - deriving (Eq, Show) - -instance FromJSON CallErrorStatus where - parseJSON "1" = pure CallThrottled - parseJSON "5" = pure CallInternal - parseJSON "6" = pure CallDestinationNotPermitted - parseJSON "7" = pure CallDestinationBarred - parseJSON "9" = pure CallPartnerQuotaExceeded - parseJSON "15" = pure CallInvalidDestinationAddress - parseJSON "17" = pure CallUnroutable - parseJSON _ = pure CallOther - -data CallErrorResponse = CallErrorResponse - { caStatus :: !CallErrorStatus, - caErrorText :: !(Maybe Text) - } - deriving (Eq, Show, Typeable) - -instance Exception CallErrorResponse - -instance FromJSON CallErrorResponse where - parseJSON = withObject "call-error-response" $ \o -> - CallErrorResponse - <$> o .: "status" - <*> o .:? "error-text" - --- * Internal call parsers - -parseCallId :: Value -> Parser CallId -parseCallId = withObject "call-response" $ \o -> - CallId <$> o .: "call_id" - -parseCallResponse :: Value -> Parser (Either CallErrorResponse CallId) -parseCallResponse j@(Object o) = do - st <- o .: "status" - case (st :: Text) of - "0" -> Right <$> parseCallId j - _ -> Left <$> parseJSON j -parseCallResponse _ = fail "Ropes.Nexmo: response should be an object" - --- * Feedback related - -data Feedback = Feedback - { feedbackId :: !(Either CallId MessageId), - feedbackTime :: !UTCTime, - feedbackDelivered :: !Bool - } - deriving (Eq, Show) - -data FeedbackErrorResponse = FeedbackErrorResponse Text - deriving (Eq, Show) - -instance Exception FeedbackErrorResponse - --- * Functions - -sendCall :: Credentials -> Manager -> Call -> IO CallId -sendCall cr mgr call = httpLbs req mgr >>= parseResult - where - parseResult res = case parseEither parseCallResponse =<< eitherDecode (responseBody res) of - Left e -> throwIO $ ParseError e - Right r -> either throwIO pure r - req = - defaultRequest - { method = "POST", - host = "api.nexmo.com", - secure = True, - port = 443, - path = "/tts/json", - requestBody = RequestBodyLBS $ encode body, - requestHeaders = [(hContentType, "application/json")] - } - (ApiKey apiKey, ApiSecret apiSecret) = (key cr, secret cr) - body = - object - [ "api_key" .= apiKey, - "api_secret" .= apiSecret, - "from" .= callFrom call, - "to" .= callTo call, - "text" .= callText call, - "repeat" .= callRepeat call, - "lg" .= callLang call - ] - -sendFeedback :: Credentials -> Manager -> Feedback -> IO () -sendFeedback cr mgr fb = httpLbs req mgr >>= parseResponse - where - req = - defaultRequest - { method = "POST", - host = "api.nexmo.com", - secure = True, - port = 443, - path = - either - (const "/conversions/voice") - (const "/conversions/sms") - (feedbackId fb), - requestBody = RequestBodyLBS $ encode body, - requestHeaders = [(hContentType, "application/json")] - } - (ApiKey apiKey, ApiSecret apiSecret) = (key cr, secret cr) - body = - object - [ "api_key" .= apiKey, - "api_secret" .= apiSecret, - "message-id" .= either callIdText messageIdText (feedbackId fb), - "delivered" .= feedbackDelivered fb, - "timestamp" .= nexmoTimeFormat (feedbackTime fb) - ] - -- Format as specified https://docs.nexmo.com/api-ref/conversion-api/request - -- Note that the claim that "If you do not set this parameter, the Cloud - -- Communications Platform uses the time it recieves this request." is false - -- You must _always_ specify a timestamp - nexmoTimeFormat = formatTime defaultTimeLocale "%Y-%m-%d %H:%M:%S" - parseResponse res = - unless (responseStatus res == status200) $ - throwIO $ - FeedbackErrorResponse (decodeUtf8 . toStrict . responseBody $ res) - -sendMessage :: Credentials -> Manager -> Message -> IO MessageResponse -sendMessage cr mgr msg = N.head <$> sendMessages cr mgr (msg :| []) - -sendMessages :: Credentials -> Manager -> NonEmpty Message -> IO (NonEmpty MessageResponse) -sendMessages cr mgr msgs = forM msgs $ \m -> httpLbs (req m) mgr >>= parseResult - where - parseResult res = case parseEither parseMessageResponse =<< eitherDecode (responseBody res) of - Left e -> throwIO $ ParseError e - Right r -> either throwIO pure r - req m = - defaultRequest - { method = "POST", - host = "rest.nexmo.com", - secure = True, - port = 443, - path = "/sms/json", - requestBody = RequestBodyLBS $ encode (body m), - requestHeaders = [(hContentType, "application/json")] - } - (ApiKey apiKey, ApiSecret apiSecret) = (key cr, secret cr) - body m = - object - [ "api_key" .= apiKey, - "api_secret" .= apiSecret, - "from" .= msgFrom m, - "to" .= msgTo m, - "text" .= msgText m, - "type" .= msgType m - ] diff --git a/libs/ropes/src/Ropes/Twilio.hs b/libs/ropes/src/Ropes/Twilio.hs deleted file mode 100644 index 986f364117d..00000000000 --- a/libs/ropes/src/Ropes/Twilio.hs +++ /dev/null @@ -1,224 +0,0 @@ -{-# LANGUAGE DeriveDataTypeable #-} -{-# LANGUAGE LambdaCase #-} -{-# LANGUAGE OverloadedStrings #-} - --- This file is part of the Wire Server implementation. --- --- Copyright (C) 2022 Wire Swiss GmbH --- --- This program is free software: you can redistribute it and/or modify it under --- the terms of the GNU Affero General Public License as published by the Free --- Software Foundation, either version 3 of the License, or (at your option) any --- later version. --- --- This program is distributed in the hope that it will be useful, but WITHOUT --- ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS --- FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for more --- details. --- --- You should have received a copy of the GNU Affero General Public License along --- with this program. If not, see . - -module Ropes.Twilio - ( -- * Types - SID (..), - AccessToken (..), - Credentials, - Message (..), - MessageId, - LookupDetail (..), - CarrierInfo (..), - PhoneType (..), - LookupResult (..), - ErrorResponse (..), - ParseError (..), - - -- * Functions - sendMessage, - sendMessages, - lookupPhone, - tryTwilio, - ) -where - -import Control.Error (ExceptT (..)) -import Control.Exception -import Data.Aeson -import Data.ByteString.Char8 qualified as C -import Data.ISO3166_CountryCodes (CountryCode) -import Data.List.NonEmpty (NonEmpty (..)) -import Data.List.NonEmpty qualified as N -import Data.Text.Encoding (encodeUtf8) -import Imports hiding (head, length) -import Network.HTTP.Client -import Network.HTTP.Types.Status -import Network.HTTP.Types.URI - --- * Types - -newtype MessageId = MessageId ByteString - -newtype SID = SID ByteString - -newtype AccessToken = AccessToken ByteString - -data Credentials = Credentials - { sid :: SID, - token :: AccessToken - } - -instance FromJSON Credentials where - parseJSON = withObject "credentials" $ \o -> - Credentials - <$> (SID . encodeUtf8 <$> o .: "sid") - <*> (AccessToken . encodeUtf8 <$> o .: "token") - -data Message = Message - { msgFrom :: !Text, - msgTo :: !Text, - msgText :: !Text - } - deriving (Eq, Show) - -data ErrorResponse = ErrorResponse - { errStatus :: !Int, - errMessage :: !Text, - errCode :: !(Maybe Int), - errMoreInfo :: !(Maybe Text) - } - deriving (Eq, Show, Typeable) - -instance Exception ErrorResponse - -instance FromJSON ErrorResponse where - parseJSON = withObject "error-response" $ \o -> - ErrorResponse - <$> o .: "status" - <*> o .: "message" - <*> o .:? "code" - <*> o .:? "more_info" - -newtype ParseError = ParseError String - deriving (Eq, Show, Typeable) - -instance Exception ParseError - -data MessageResponse = MessageResponse - { msgId :: !MessageId - } - -instance FromJSON MessageResponse where - parseJSON = withObject "MessageResponse" $ \o -> - MessageResponse . MessageId . encodeUtf8 <$> o .: "sid" - -data LookupDetail - = LookupNoDetail - | LookupCarrier - deriving (Eq, Show) - -data LookupResult = LookupResult - { lookupE164 :: !Text, - lookupCarrier :: !(Maybe CarrierInfo) - } - -data CarrierInfo = CarrierInfo - { carrierName :: !(Maybe Text), - carrierType :: !(Maybe PhoneType) - } - -data PhoneType - = Landline - | Mobile - | VoIp - deriving (Eq, Show) - -instance FromJSON LookupResult where - parseJSON = withObject "LookupResult" $ \o -> - LookupResult - <$> o .: "phone_number" - <*> o .:? "carrier" - -instance FromJSON CarrierInfo where - parseJSON = withObject "CarrierInfo" $ \o -> - CarrierInfo - <$> o .:? "name" - <*> o .:? "type" - -instance FromJSON PhoneType where - parseJSON = withText "PhoneType" $ \case - "mobile" -> pure Mobile - "landline" -> pure Landline - "voip" -> pure VoIp - x -> fail $ "Unexpected phone type: " ++ show x - --- * Functions - -tryTwilio :: (MonadIO m) => IO a -> ExceptT ErrorResponse m a -tryTwilio = ExceptT . liftIO . try - -sendMessage :: Credentials -> Manager -> Message -> IO MessageId -sendMessage cr mgr msg = N.head <$> sendMessages cr mgr (msg :| []) - -sendMessages :: Credentials -> Manager -> NonEmpty Message -> IO (NonEmpty MessageId) -sendMessages cr mgr msgs = forM msgs $ \m -> do - let req = urlEncodedBody (form m) . applyBasicAuth tSid tToken $ apiReq - rsp <- httpLbs req mgr - if responseStatus rsp == status201 - then case eitherDecode (responseBody rsp) of - Right r -> pure $ msgId r - Left e -> throwIO $ ParseError e - else case eitherDecode (responseBody rsp) of - Right e -> throwIO (e :: ErrorResponse) - Left e -> throwIO $ ParseError e - where - apiReq = - defaultRequest - { method = "POST", - host = "api.twilio.com", - secure = True, - port = 443, - path = "/2010-04-01/Accounts/" <> tSid <> "/Messages.json" - } - (SID tSid, AccessToken tToken) = (sid cr, token cr) - form m = - [ ("From", encodeUtf8 . msgFrom $ m), - ("To", encodeUtf8 . msgTo $ m), - ("Body", encodeUtf8 . msgText $ m) - ] - -lookupPhone :: - Credentials -> - Manager -> - Text -> - LookupDetail -> - Maybe CountryCode -> - IO LookupResult -lookupPhone cr mgr phone detail country = do - let req = applyBasicAuth tSid tToken apiReq - rsp <- httpLbs req mgr - if responseStatus rsp == status200 - then case eitherDecode (responseBody rsp) of - Right r -> pure r - Left e -> throwIO $ ParseError e - else case eitherDecode (responseBody rsp) of - Right e -> throwIO (e :: ErrorResponse) - Left e -> throwIO $ ParseError e - where - (SID tSid, AccessToken tToken) = (sid cr, token cr) - apiReq = - defaultRequest - { method = "GET", - host = "lookups.twilio.com", - secure = True, - port = 443, - path = "/v1/PhoneNumbers/" <> encodeUtf8 phone, - queryString = renderSimpleQuery False queryItems - } - queryItems = - catMaybes - [ countryCode <$> country, - lookupType detail - ] - countryCode c = ("CountryCode", C.pack (show c)) - lookupType LookupNoDetail = Nothing - lookupType LookupCarrier = Just ("Type", "carrier") diff --git a/libs/wire-api/src/Wire/API/Allowlists.hs b/libs/wire-api/src/Wire/API/Allowlists.hs index c624d4c6bbd..244a5e8cb85 100644 --- a/libs/wire-api/src/Wire/API/Allowlists.hs +++ b/libs/wire-api/src/Wire/API/Allowlists.hs @@ -20,13 +20,11 @@ -- Email/phone whitelist. module Wire.API.Allowlists ( AllowlistEmailDomains (..), - AllowlistPhonePrefixes (..), verify, ) where import Data.Aeson -import Data.Text qualified as Text import Imports import Wire.API.User.Identity @@ -36,15 +34,8 @@ data AllowlistEmailDomains = AllowlistEmailDomains [Text] instance FromJSON AllowlistEmailDomains -data AllowlistPhonePrefixes = AllowlistPhonePrefixes [Text] - deriving (Show, Generic) - -instance FromJSON AllowlistPhonePrefixes - -- | Consult the whitelist settings in brig's config file and verify that the provided --- email/phone address is whitelisted. -verify :: Maybe AllowlistEmailDomains -> Maybe AllowlistPhonePrefixes -> Either Email Phone -> Bool -verify (Just (AllowlistEmailDomains allowed)) _ (Left email) = emailDomain email `elem` allowed -verify _ (Just (AllowlistPhonePrefixes allowed)) (Right phone) = any (`Text.isPrefixOf` fromPhone phone) allowed -verify Nothing _ (Left _) = True -verify _ Nothing (Right _) = True +-- email address is whitelisted. +verify :: Maybe AllowlistEmailDomains -> Email -> Bool +verify (Just (AllowlistEmailDomains allowed)) email = emailDomain email `elem` allowed +verify Nothing (_) = True diff --git a/libs/wire-api/src/Wire/API/Error/Brig.hs b/libs/wire-api/src/Wire/API/Error/Brig.hs index e0e560920fb..e84846c1620 100644 --- a/libs/wire-api/src/Wire/API/Error/Brig.hs +++ b/libs/wire-api/src/Wire/API/Error/Brig.hs @@ -44,7 +44,6 @@ data BrigError | InvalidHandle | HandleNotFound | UserCreationRestricted - | BlacklistedPhone | AllowlistError | InvalidInvitationCode | MissingIdentity @@ -165,7 +164,7 @@ type instance MapError 'NotConnected = 'StaticError 403 "not-connected" "Users a type instance MapError 'InvalidTransition = 'StaticError 403 "bad-conn-update" "Invalid status transition" -type instance MapError 'NoIdentity = 'StaticError 403 "no-identity" "The user has no verified identity (email or phone number)" +type instance MapError 'NoIdentity = 'StaticError 403 "no-identity" "The user has no verified email" type instance MapError 'HandleExists = 'StaticError 409 "handle-exists" "The given handle is already taken" @@ -175,13 +174,11 @@ type instance MapError 'HandleNotFound = 'StaticError 404 "not-found" "Handle no type instance MapError 'MLSDuplicatePublicKey = 'StaticError 400 "mls-duplicate-public-key" "MLS public key for the given signature scheme already exists" -type instance MapError 'BlacklistedPhone = 'StaticError 403 "blacklisted-phone" "The given phone number has been blacklisted due to suspected abuse or a complaint" - -type instance MapError 'AllowlistError = 'StaticError 403 "unauthorized" "Unauthorized e-mail address or phone number." +type instance MapError 'AllowlistError = 'StaticError 403 "unauthorized" "Unauthorized e-mail address" type instance MapError 'InvalidInvitationCode = 'StaticError 400 "invalid-invitation-code" "Invalid invitation code." -type instance MapError 'MissingIdentity = 'StaticError 403 "missing-identity" "Using an invitation code requires registering the given email and/or phone." +type instance MapError 'MissingIdentity = 'StaticError 403 "missing-identity" "Using an invitation code requires registering the given email." type instance MapError 'BlacklistedEmail = @@ -233,7 +230,7 @@ type instance MapError 'AccountEphemeral = 'StaticError 403 "ephemeral" "Account type instance MapError 'AccountPending = 'StaticError 403 "pending-activation" "Account pending activation" -type instance MapError 'UserKeyExists = 'StaticError 409 "key-exists" "The given e-mail address or phone number is in use." +type instance MapError 'UserKeyExists = 'StaticError 409 "key-exists" "The given e-mail address is in use." type instance MapError 'NameManagedByScim = 'StaticError 403 "managed-by-scim" "Updating name is not allowed, because it is managed by SCIM, or E2EId is enabled" @@ -241,7 +238,7 @@ type instance MapError 'HandleManagedByScim = 'StaticError 403 "managed-by-scim" type instance MapError 'LocaleManagedByScim = 'StaticError 403 "managed-by-scim" "Updating locale is not allowed, because it is managed by SCIM, or E2EId is enabled" -type instance MapError 'LastIdentity = 'StaticError 403 "last-identity" "The last user identity (email or phone number) cannot be removed." +type instance MapError 'LastIdentity = 'StaticError 403 "last-identity" "The last user identity cannot be removed." type instance MapError 'NoPassword = 'StaticError 403 "no-password" "The user has no password." diff --git a/libs/wire-api/src/Wire/API/Routes/Internal/Brig.hs b/libs/wire-api/src/Wire/API/Routes/Internal/Brig.hs index 3de1d1705eb..7d31bedba95 100644 --- a/libs/wire-api/src/Wire/API/Routes/Internal/Brig.hs +++ b/libs/wire-api/src/Wire/API/Routes/Internal/Brig.hs @@ -241,7 +241,6 @@ type AccountAPI = :> QueryParam' [Optional, Strict] "ids" (CommaSeparatedList UserId) :> QueryParam' [Optional, Strict] "handles" (CommaSeparatedList Handle) :> QueryParam' [Optional, Strict] "email" (CommaSeparatedList Email) -- don't rename to `emails`, for backwards compat! - :> QueryParam' [Optional, Strict] "phone" (CommaSeparatedList Phone) -- don't rename to `phones`, for backwards compat! :> QueryParam' [ Optional, Strict, @@ -262,16 +261,14 @@ type AccountAPI = "iGetUserActivationCode" ( "users" :> "activation-code" - :> QueryParam' [Optional, Strict] "email" Email - :> QueryParam' [Optional, Strict] "phone" Phone + :> QueryParam' [Required, Strict] "email" Email :> Get '[Servant.JSON] GetActivationCodeResp ) :<|> Named "iGetUserPasswordResetCode" ( "users" :> "password-reset-code" - :> QueryParam' [Optional, Strict] "email" Email - :> QueryParam' [Optional, Strict] "phone" Phone + :> QueryParam' [Required, Strict] "email" Email :> Get '[Servant.JSON] GetPasswordResetCodeResp ) :<|> Named @@ -279,16 +276,14 @@ type AccountAPI = ( Summary "This endpoint can lead to the following events being sent: UserIdentityRemoved event to target user" :> "users" :> "revoke-identity" - :> QueryParam' [Optional, Strict] "email" Email - :> QueryParam' [Optional, Strict] "phone" Phone + :> QueryParam' [Required, Strict] "email" Email :> Post '[Servant.JSON] NoContent ) :<|> Named "iHeadBlacklist" ( "users" :> "blacklist" - :> QueryParam' [Optional, Strict] "email" Email - :> QueryParam' [Optional, Strict] "phone" Phone + :> QueryParam' [Required, Strict] "email" Email :> MultiVerb 'GET '[Servant.JSON] @@ -301,46 +296,14 @@ type AccountAPI = "iDeleteBlacklist" ( "users" :> "blacklist" - :> QueryParam' [Optional, Strict] "email" Email - :> QueryParam' [Optional, Strict] "phone" Phone + :> QueryParam' [Required, Strict] "email" Email :> Delete '[Servant.JSON] NoContent ) :<|> Named "iPostBlacklist" ( "users" :> "blacklist" - :> QueryParam' [Optional, Strict] "email" Email - :> QueryParam' [Optional, Strict] "phone" Phone - :> Post '[Servant.JSON] NoContent - ) - :<|> Named - "iGetPhonePrefix" - ( Summary - "given a phone number (or phone number prefix), see whether it is blocked \ - \via a prefix (and if so, via which specific prefix)" - :> "users" - :> "phone-prefixes" - :> Capture "prefix" PhonePrefix - :> MultiVerb - 'GET - '[Servant.JSON] - '[ RespondEmpty 404 "PhonePrefixNotFound", - Respond 200 "PhonePrefixesFound" [ExcludedPrefix] - ] - GetPhonePrefixResponse - ) - :<|> Named - "iDeletePhonePrefix" - ( "users" - :> "phone-prefixes" - :> Capture "prefix" PhonePrefix - :> Delete '[Servant.JSON] NoContent - ) - :<|> Named - "iPostPhonePrefix" - ( "users" - :> "phone-prefixes" - :> ReqBody '[Servant.JSON] ExcludedPrefix + :> QueryParam' [Required, Strict] "email" Email :> Post '[Servant.JSON] NoContent ) :<|> Named diff --git a/libs/wire-api/src/Wire/API/Routes/Public/Brig.hs b/libs/wire-api/src/Wire/API/Routes/Public/Brig.hs index 998c882eebd..8a9cbfc0842 100644 --- a/libs/wire-api/src/Wire/API/Routes/Public/Brig.hs +++ b/libs/wire-api/src/Wire/API/Routes/Public/Brig.hs @@ -361,7 +361,6 @@ type SelfAPI = \email address and a password." :> MakesFederatedCall 'Brig "send-connection-action" :> ZUser - :> ZConn :> "self" :> "phone" :> MultiVerb 'DELETE '[JSON] RemoveIdentityResponses (Maybe RemoveIdentityError) @@ -377,7 +376,6 @@ type SelfAPI = \phone number." :> MakesFederatedCall 'Brig "send-connection-action" :> ZUser - :> ZConn :> "self" :> "email" :> MultiVerb 'DELETE '[JSON] RemoveIdentityResponses (Maybe RemoveIdentityError) @@ -481,8 +479,8 @@ type AccountAPI = ( Summary "Register a new user." :> Description "If the environment where the registration takes \ - \place is private and a registered email address or phone \ - \number is not whitelisted, a 403 error is returned." + \place is private and a registered email address \ + \is not whitelisted, a 403 error is returned." :> MakesFederatedCall 'Brig "send-connection-action" :> "register" :> ReqBody '[JSON] NewUserPublic @@ -550,12 +548,11 @@ type AccountAPI = -- docs/reference/user/activation.md {#RefActivationRequest} :<|> Named "post-activate-send" - ( Summary "Send (or resend) an email or phone activation code." + ( Summary "Send (or resend) an email activation code." :> CanThrow 'UserKeyExists :> CanThrow 'InvalidEmail :> CanThrow 'InvalidPhone :> CanThrow 'BlacklistedEmail - :> CanThrow 'BlacklistedPhone :> CanThrow 'CustomerExtensionBlockedDomain :> "activate" :> "send" @@ -1482,7 +1479,6 @@ type AuthAPI = :> CanThrow 'InvalidEmail :> CanThrow 'UserKeyExists :> CanThrow 'BlacklistedEmail - :> CanThrow 'BlacklistedPhone :> CanThrow 'BadCredentials :> MultiVerb 'PUT diff --git a/libs/wire-api/src/Wire/API/User.hs b/libs/wire-api/src/Wire/API/User.hs index 997e52e04a1..e24f63536f1 100644 --- a/libs/wire-api/src/Wire/API/User.hs +++ b/libs/wire-api/src/Wire/API/User.hs @@ -37,7 +37,6 @@ module Wire.API.User User (..), userId, userEmail, - userPhone, userSSOId, userIssuer, userSCIMExternalId, @@ -66,7 +65,6 @@ module Wire.API.User newUserInvitationCode, newUserTeam, newUserEmail, - newUserPhone, newUserSSOId, isNewUserEphemeral, isNewUserTeamMember, @@ -124,13 +122,6 @@ module Wire.API.User GetActivationCodeResp (..), GetPasswordResetCodeResp (..), CheckBlacklistResponse (..), - GetPhonePrefixResponse (..), - PhonePrefix (..), - parsePhonePrefix, - isValidPhonePrefix, - allPrefixes, - ExcludedPrefix (..), - PhoneBudgetTimeout (..), ManagedByUpdate (..), HavePendingInvitations (..), RichInfoUpdate (..), @@ -169,8 +160,6 @@ import Control.Lens (makePrisms, over, view, (.~), (?~), (^.)) import Data.Aeson (FromJSON (..), ToJSON (..), withText) import Data.Aeson.Types qualified as A import Data.Attoparsec.ByteString qualified as Parser -import Data.Attoparsec.Text qualified as TParser -import Data.Bifunctor qualified as Bifunctor import Data.Bits import Data.ByteString (toStrict) import Data.ByteString.Builder (toLazyByteString) @@ -198,7 +187,6 @@ import Data.Text qualified as T import Data.Text.Ascii import Data.Text.Encoding qualified as T import Data.Text.Encoding.Error -import Data.Time.Clock (NominalDiffTime) import Data.UUID (UUID, nil) import Data.UUID qualified as UUID import Deriving.Swagger @@ -311,117 +299,6 @@ instance fromUnion (S (Z (I ()))) = YesBlacklisted fromUnion (S (S x)) = case x of {} -data GetPhonePrefixResponse = PhonePrefixNotFound | PhonePrefixesFound [ExcludedPrefix] - -instance - AsUnion - '[ RespondEmpty 404 "PhonePrefixNotFound", - Respond 200 "PhonePrefixesFound" [ExcludedPrefix] - ] - GetPhonePrefixResponse - where - toUnion PhonePrefixNotFound = Z (I ()) - toUnion (PhonePrefixesFound pfxs) = S (Z (I pfxs)) - fromUnion (Z (I ())) = PhonePrefixNotFound - fromUnion (S (Z (I pfxs))) = PhonePrefixesFound pfxs - fromUnion (S (S x)) = case x of {} - --- | PhonePrefix (for excluding from SMS/calling) -newtype PhonePrefix = PhonePrefix {fromPhonePrefix :: Text} - deriving (Eq, Show, Generic) - deriving (FromJSON, ToJSON, S.ToSchema) via Schema PhonePrefix - -instance Arbitrary PhonePrefix where - arbitrary = do - digits <- take 8 <$> QC.listOf1 (QC.elements ['0' .. '9']) - pure . PhonePrefix . T.pack $ "+" <> digits - -instance ToSchema PhonePrefix where - schema = fromPhonePrefix .= parsedText "PhonePrefix" phonePrefixParser - -instance S.ToParamSchema PhonePrefix where - toParamSchema _ = S.toParamSchema (Proxy @String) - -instance FromByteString PhonePrefix where - parser = parser >>= maybe (fail "Invalid phone") pure . parsePhonePrefix - -instance ToByteString PhonePrefix where - builder = builder . fromPhonePrefix - -instance FromHttpApiData PhonePrefix where - parseUrlPiece = Bifunctor.first T.pack . phonePrefixParser - -deriving instance C.Cql PhonePrefix - -phonePrefixParser :: Text -> Either String PhonePrefix -phonePrefixParser p = maybe err pure (parsePhonePrefix p) - where - err = - Left $ - "Invalid phone number prefix: [" - ++ show p - ++ "]. Expected format similar to E.164 (with 1-15 digits after the +)." - --- | Parses a phone number prefix with a mandatory leading '+'. -parsePhonePrefix :: Text -> Maybe PhonePrefix -parsePhonePrefix p - | isValidPhonePrefix p = Just $ PhonePrefix p - | otherwise = Nothing - --- | Checks whether a phone number prefix is valid, --- i.e. it is like a E.164 format phone number, but shorter --- (with a mandatory leading '+', followed by 1-15 digits.) -isValidPhonePrefix :: Text -> Bool -isValidPhonePrefix = isRight . TParser.parseOnly e164Prefix - where - e164Prefix :: TParser.Parser () - e164Prefix = - TParser.char '+' - *> TParser.count 1 TParser.digit - *> TParser.count 14 (optional TParser.digit) - *> TParser.endOfInput - --- | get all valid prefixes of a phone number or phone number prefix --- e.g. from +123456789 get prefixes ["+1", "+12", "+123", ..., "+123456789" ] -allPrefixes :: Text -> [PhonePrefix] -allPrefixes t = mapMaybe parsePhonePrefix (T.inits t) - -data ExcludedPrefix = ExcludedPrefix - { phonePrefix :: PhonePrefix, - comment :: Text - } - deriving (Eq, Show, Generic) - deriving (FromJSON, ToJSON, S.ToSchema) via Schema ExcludedPrefix - -instance ToSchema ExcludedPrefix where - schema = - object "ExcludedPrefix" $ - ExcludedPrefix - <$> phonePrefix .= field "phone_prefix" schema - <*> comment .= field "comment" schema - --- | If the budget for SMS and voice calls for a phone number --- has been exhausted within a certain time frame, this timeout --- indicates in seconds when another attempt may be made. -newtype PhoneBudgetTimeout = PhoneBudgetTimeout - {phoneBudgetTimeout :: NominalDiffTime} - deriving (Eq, Show, Generic) - deriving newtype (Arbitrary) - deriving (FromJSON, ToJSON, S.ToSchema) via Schema PhoneBudgetTimeout - -instance ToSchema PhoneBudgetTimeout where - schema = - object "PhoneBudgetTimeout" $ - PhoneBudgetTimeout - <$> phoneBudgetTimeout .= field "expires_in" nominalDiffTimeSchema - --- | (32bit precision) -nominalDiffTimeSchema :: ValueSchema NamedSwaggerDoc NominalDiffTime -nominalDiffTimeSchema = fromIntegral <$> roundDiffTime .= schema - where - roundDiffTime :: NominalDiffTime -> Int32 - roundDiffTime = round - newtype ManagedByUpdate = ManagedByUpdate {mbuManagedBy :: ManagedBy} deriving (Eq, Show, Generic) deriving newtype (Arbitrary) @@ -752,9 +629,6 @@ userObjectSchema = userEmail :: User -> Maybe Email userEmail = emailIdentity <=< userIdentity -userPhone :: User -> Maybe Phone -userPhone = phoneIdentity <=< userIdentity - userSSOId :: User -> Maybe UserSSOId userSSOId = ssoIdentity <=< userIdentity @@ -909,7 +783,6 @@ data RegisterError | RegisterErrorInvalidActivationCodeWrongCode | RegisterErrorInvalidEmail | RegisterErrorInvalidPhone - | RegisterErrorBlacklistedPhone | RegisterErrorBlacklistedEmail | RegisterErrorTooManyTeamMembers | RegisterErrorUserCreationRestricted @@ -927,7 +800,6 @@ type RegisterErrorResponses = ErrorResponse 'InvalidActivationCodeWrongCode, ErrorResponse 'InvalidEmail, ErrorResponse 'InvalidPhone, - ErrorResponse 'BlacklistedPhone, ErrorResponse 'BlacklistedEmail, ErrorResponse 'TooManyTeamMembers, ErrorResponse 'UserCreationRestricted @@ -1068,7 +940,8 @@ newUserFromSpar new = NewUser { newUserDisplayName = newUserSparDisplayName new, newUserUUID = Just $ newUserSparUUID new, - newUserIdentity = Just $ SSOIdentity (newUserSparSSOId new) Nothing Nothing, + newUserIdentity = Just $ SSOIdentity (newUserSparSSOId new) Nothing, + newUserPhone = Nothing, newUserPict = Nothing, newUserAssets = [], newUserAccentId = Nothing, @@ -1088,6 +961,7 @@ data NewUser = NewUser -- | use this as 'UserId' (if 'Nothing', call 'Data.UUID.nextRandom'). newUserUUID :: Maybe UUID, newUserIdentity :: Maybe UserIdentity, + newUserPhone :: Maybe Phone, -- | DEPRECATED newUserPict :: Maybe Pict, newUserAssets :: [Asset], @@ -1111,6 +985,7 @@ emptyNewUser name = { newUserDisplayName = name, newUserUUID = Nothing, newUserIdentity = Nothing, + newUserPhone = Nothing, newUserPict = Nothing, newUserAssets = [], newUserAccentId = Nothing, @@ -1133,6 +1008,7 @@ data NewUserRaw = NewUserRaw { newUserRawDisplayName :: Name, newUserRawUUID :: Maybe UUID, newUserRawEmail :: Maybe Email, + -- | This is deprecated and it should always be 'Nothing'. newUserRawPhone :: Maybe Phone, newUserRawSSOId :: Maybe UserSSOId, -- | DEPRECATED @@ -1140,6 +1016,7 @@ data NewUserRaw = NewUserRaw newUserRawAssets :: [Asset], newUserRawAccentId :: Maybe ColourId, newUserRawEmailCode :: Maybe ActivationCode, + -- | This is deprecated and it should always be 'Nothing'. newUserRawPhoneCode :: Maybe ActivationCode, newUserRawInvitationCode :: Maybe InvitationCode, newUserRawTeamCode :: Maybe InvitationCode, @@ -1208,7 +1085,7 @@ newUserToRaw NewUser {..} = { newUserRawDisplayName = newUserDisplayName, newUserRawUUID = newUserUUID, newUserRawEmail = emailIdentity =<< newUserIdentity, - newUserRawPhone = phoneIdentity =<< newUserIdentity, + newUserRawPhone = newUserPhone, newUserRawSSOId = ssoIdentity =<< newUserIdentity, newUserRawPict = newUserPict, newUserRawAssets = newUserAssets, @@ -1235,7 +1112,9 @@ newUserFromRaw NewUserRaw {..} = do (isJust newUserRawPassword) (isJust newUserRawSSOId) (newUserRawInvitationCode, newUserRawTeamCode, newUserRawTeam, newUserRawTeamId) - let identity = maybeUserIdentityFromComponents (newUserRawEmail, newUserRawPhone, newUserRawSSOId) + let identity = + maybeUserIdentityFromComponents + (newUserRawEmail, newUserRawSSOId) expiresIn <- case (newUserRawExpiresIn, identity) of (Just _, Just _) -> fail "Only users without an identity can expire" @@ -1245,6 +1124,7 @@ newUserFromRaw NewUserRaw {..} = do { newUserDisplayName = newUserRawDisplayName, newUserUUID = newUserRawUUID, newUserIdentity = identity, + newUserPhone = newUserRawPhone, newUserPict = newUserRawPict, newUserAssets = newUserRawAssets, newUserAccentId = newUserRawAccentId, @@ -1263,6 +1143,7 @@ newUserFromRaw NewUserRaw {..} = do instance Arbitrary NewUser where arbitrary = do newUserIdentity <- arbitrary + newUserPhone <- arbitrary newUserOrigin <- genUserOrigin newUserIdentity newUserDisplayName <- arbitrary newUserUUID <- QC.elements [Just nil, Nothing] @@ -1314,9 +1195,6 @@ newUserTeam nu = case newUserOrigin nu of newUserEmail :: NewUser -> Maybe Email newUserEmail = emailIdentity <=< newUserIdentity -newUserPhone :: NewUser -> Maybe Phone -newUserPhone = phoneIdentity <=< newUserIdentity - newUserSSOId :: NewUser -> Maybe UserSSOId newUserSSOId = ssoIdentity <=< newUserIdentity @@ -1620,7 +1498,6 @@ instance ToSchema PhoneUpdate where data ChangePhoneError = PhoneExists | InvalidNewPhone - | BlacklistedNewPhone deriving (Generic) deriving (AsUnion ChangePhoneErrorResponses) via GenericAsUnion ChangePhoneErrorResponses ChangePhoneError @@ -1628,8 +1505,7 @@ instance GSOP.Generic ChangePhoneError type ChangePhoneErrorResponses = [ ErrorResponse 'UserKeyExists, - ErrorResponse 'InvalidPhone, - ErrorResponse 'BlacklistedPhone + ErrorResponse 'InvalidPhone ] type ChangePhoneResponses = diff --git a/libs/wire-api/src/Wire/API/User/Activation.hs b/libs/wire-api/src/Wire/API/User/Activation.hs index 6fd9e2d8f30..ff21fc57ac7 100644 --- a/libs/wire-api/src/Wire/API/User/Activation.hs +++ b/libs/wire-api/src/Wire/API/User/Activation.hs @@ -57,7 +57,7 @@ import Wire.Arbitrary (Arbitrary, GenericUniform (..)) -- | The target of an activation request. data ActivationTarget - = -- | An opaque key for some email or phone number awaiting activation. + = -- | An opaque key for some email awaiting activation. ActivateKey ActivationKey | -- | A known phone number awaiting activation. ActivatePhone Phone diff --git a/libs/wire-api/src/Wire/API/User/Identity.hs b/libs/wire-api/src/Wire/API/User/Identity.hs index 19e3f68218d..b96ad4135fa 100644 --- a/libs/wire-api/src/Wire/API/User/Identity.hs +++ b/libs/wire-api/src/Wire/API/User/Identity.hs @@ -22,9 +22,9 @@ module Wire.API.User.Identity ( -- * UserIdentity UserIdentity (..), + isSSOIdentity, newIdentity, emailIdentity, - phoneIdentity, ssoIdentity, userIdentityObjectSchema, maybeUserIdentityObjectSchema, @@ -72,8 +72,6 @@ import Data.Text qualified as Text import Data.Text.Encoding import Data.Text.Encoding.Error import Data.Text.Lazy qualified as LT -import Data.Time.Clock -import Data.Tuple.Extra (fst3, snd3, thd3) import Imports import SAML2.WebSSO (UserRef (..)) import SAML2.WebSSO.Test.Arbitrary () @@ -96,71 +94,54 @@ import Wire.Arbitrary (Arbitrary (arbitrary), GenericUniform (..)) -- | The private unique user identity that is used for login and -- account recovery. data UserIdentity - = FullIdentity Email Phone - | EmailIdentity Email - | PhoneIdentity Phone - | SSOIdentity UserSSOId (Maybe Email) (Maybe Phone) + = EmailIdentity Email + | SSOIdentity UserSSOId (Maybe Email) deriving stock (Eq, Show, Generic) deriving (Arbitrary) via (GenericUniform UserIdentity) +isSSOIdentity :: UserIdentity -> Bool +isSSOIdentity (SSOIdentity _ _) = True +isSSOIdentity _ = False + userIdentityObjectSchema :: ObjectSchema SwaggerDoc UserIdentity userIdentityObjectSchema = - Just .= withParser maybeUserIdentityObjectSchema (maybe (fail "Missing 'email' or 'phone' or 'sso_id'.") pure) + Just .= withParser maybeUserIdentityObjectSchema (maybe (fail "Missing 'email' or 'sso_id'.") pure) maybeUserIdentityObjectSchema :: ObjectSchema SwaggerDoc (Maybe UserIdentity) maybeUserIdentityObjectSchema = dimap maybeUserIdentityToComponents maybeUserIdentityFromComponents userIdentityComponentsObjectSchema -type UserIdentityComponents = (Maybe Email, Maybe Phone, Maybe UserSSOId) +type UserIdentityComponents = (Maybe Email, Maybe UserSSOId) userIdentityComponentsObjectSchema :: ObjectSchema SwaggerDoc UserIdentityComponents userIdentityComponentsObjectSchema = - (,,) - <$> fst3 - .= maybe_ (optField "email" schema) - <*> snd3 - .= maybe_ (optField "phone" schema) - <*> thd3 - .= maybe_ (optField "sso_id" genericToSchema) + (,) + <$> fst .= maybe_ (optField "email" schema) + <*> snd .= maybe_ (optField "sso_id" genericToSchema) maybeUserIdentityFromComponents :: UserIdentityComponents -> Maybe UserIdentity maybeUserIdentityFromComponents = \case - (maybeEmail, maybePhone, Just ssoid) -> Just $ SSOIdentity ssoid maybeEmail maybePhone - (Just email, Just phone, Nothing) -> Just $ FullIdentity email phone - (Just email, Nothing, Nothing) -> Just $ EmailIdentity email - (Nothing, Just phone, Nothing) -> Just $ PhoneIdentity phone - (Nothing, Nothing, Nothing) -> Nothing + (maybeEmail, Just ssoid) -> Just $ SSOIdentity ssoid maybeEmail + (Just email, Nothing) -> Just $ EmailIdentity email + (Nothing, Nothing) -> Nothing maybeUserIdentityToComponents :: Maybe UserIdentity -> UserIdentityComponents -maybeUserIdentityToComponents Nothing = (Nothing, Nothing, Nothing) -maybeUserIdentityToComponents (Just (FullIdentity email phone)) = (Just email, Just phone, Nothing) -maybeUserIdentityToComponents (Just (EmailIdentity email)) = (Just email, Nothing, Nothing) -maybeUserIdentityToComponents (Just (PhoneIdentity phone)) = (Nothing, Just phone, Nothing) -maybeUserIdentityToComponents (Just (SSOIdentity ssoid m_email m_phone)) = (m_email, m_phone, Just ssoid) - -newIdentity :: Maybe Email -> Maybe Phone -> Maybe UserSSOId -> Maybe UserIdentity -newIdentity email phone (Just sso) = Just $! SSOIdentity sso email phone -newIdentity Nothing Nothing Nothing = Nothing -newIdentity (Just e) Nothing Nothing = Just $! EmailIdentity e -newIdentity Nothing (Just p) Nothing = Just $! PhoneIdentity p -newIdentity (Just e) (Just p) Nothing = Just $! FullIdentity e p +maybeUserIdentityToComponents Nothing = (Nothing, Nothing) +maybeUserIdentityToComponents (Just (EmailIdentity email)) = (Just email, Nothing) +maybeUserIdentityToComponents (Just (SSOIdentity ssoid m_email)) = (m_email, Just ssoid) + +newIdentity :: Maybe Email -> Maybe UserSSOId -> Maybe UserIdentity +newIdentity email (Just sso) = Just $! SSOIdentity sso email +newIdentity (Just e) Nothing = Just $! EmailIdentity e +newIdentity Nothing Nothing = Nothing emailIdentity :: UserIdentity -> Maybe Email -emailIdentity (FullIdentity email _) = Just email emailIdentity (EmailIdentity email) = Just email -emailIdentity (PhoneIdentity _) = Nothing -emailIdentity (SSOIdentity _ (Just email) _) = Just email -emailIdentity (SSOIdentity _ Nothing _) = Nothing - -phoneIdentity :: UserIdentity -> Maybe Phone -phoneIdentity (FullIdentity _ phone) = Just phone -phoneIdentity (PhoneIdentity phone) = Just phone -phoneIdentity (EmailIdentity _) = Nothing -phoneIdentity (SSOIdentity _ _ (Just phone)) = Just phone -phoneIdentity (SSOIdentity _ _ Nothing) = Nothing +emailIdentity (SSOIdentity _ (Just email)) = Just email +emailIdentity (SSOIdentity _ _) = Nothing ssoIdentity :: UserIdentity -> Maybe UserSSOId -ssoIdentity (SSOIdentity ssoid _ _) = Just ssoid +ssoIdentity (SSOIdentity ssoid _) = Just ssoid ssoIdentity _ = Nothing -------------------------------------------------------------------------------- @@ -396,21 +377,6 @@ instance FromJSON UserSSOId where (Nothing, Nothing, Just eid) -> pure $ UserScimExternalId eid _ -> fail "either need tenant and subject, or scim_external_id, but not both" --- | If the budget for SMS and voice calls for a phone number --- has been exhausted within a certain time frame, this timeout --- indicates in seconds when another attempt may be made. -newtype PhoneBudgetTimeout = PhoneBudgetTimeout - {phoneBudgetTimeout :: NominalDiffTime} - deriving stock (Eq, Show, Generic) - deriving newtype (Arbitrary) - -instance FromJSON PhoneBudgetTimeout where - parseJSON = A.withObject "PhoneBudgetTimeout" $ \o -> - PhoneBudgetTimeout <$> o A..: "expires_in" - -instance ToJSON PhoneBudgetTimeout where - toJSON (PhoneBudgetTimeout t) = A.object ["expires_in" A..= t] - lenientlyParseSAMLIssuer :: Maybe LText -> A.Parser (Maybe SAML.Issuer) lenientlyParseSAMLIssuer mbtxt = forM mbtxt $ \txt -> do let asxml :: Either String SAML.Issuer diff --git a/libs/wire-api/src/Wire/API/User/Password.hs b/libs/wire-api/src/Wire/API/User/Password.hs index e9d1eb7ae28..f3955f3cd4f 100644 --- a/libs/wire-api/src/Wire/API/User/Password.hs +++ b/libs/wire-api/src/Wire/API/User/Password.hs @@ -48,7 +48,7 @@ import Data.Proxy (Proxy (Proxy)) import Data.Range (Ranged (..)) import Data.Schema as Schema import Data.Text.Ascii -import Data.Tuple.Extra (fst3, snd3, thd3) +import Data.Tuple.Extra import Imports import Servant (FromHttpApiData (..)) import Wire.API.User.Identity @@ -58,49 +58,46 @@ import Wire.Arbitrary (Arbitrary, GenericUniform (..)) -- NewPasswordReset -- | The payload for initiating a password reset. -newtype NewPasswordReset = NewPasswordReset (Either Email Phone) +data NewPasswordReset + = NewPasswordReset Email + | -- | Resetting via phone is not really supported anymore, but this is still + -- here to support older versions of the endpoint. + NewPasswordResetUnsupportedPhone deriving stock (Eq, Show, Generic) - deriving newtype (Arbitrary) + deriving (Arbitrary) via (GenericUniform NewPasswordReset) deriving (A.ToJSON, A.FromJSON, S.ToSchema) via Schema NewPasswordReset instance ToSchema NewPasswordReset where schema = objectWithDocModifier "NewPasswordReset" objectDesc $ - NewPasswordReset - <$> (toTuple . unNewPasswordReset) Schema..= newPasswordResetObjectSchema + (toTuple .= newPasswordResetTupleObjectSchema) `withParser` fromTuple where - unNewPasswordReset :: NewPasswordReset -> Either Email Phone - unNewPasswordReset (NewPasswordReset v) = v - objectDesc :: NamedSwaggerDoc -> NamedSwaggerDoc objectDesc = description ?~ "Data to initiate a password reset" - newPasswordResetObjectSchema :: ObjectSchemaP SwaggerDoc (Maybe Email, Maybe Phone) (Either Email Phone) - newPasswordResetObjectSchema = withParser newPasswordResetTupleObjectSchema fromTuple + newPasswordResetTupleObjectSchema :: ObjectSchema SwaggerDoc (Maybe Email, Maybe Text) + newPasswordResetTupleObjectSchema = + (,) + <$> fst .= maybe_ (optFieldWithDocModifier "email" phoneDocs schema) + <*> snd .= maybe_ (optFieldWithDocModifier "phone" emailDocs schema) where - newPasswordResetTupleObjectSchema :: ObjectSchema SwaggerDoc (Maybe Email, Maybe Phone) - newPasswordResetTupleObjectSchema = - (,) - <$> fst .= maybe_ (optFieldWithDocModifier "email" phoneDocs schema) - <*> snd .= maybe_ (optFieldWithDocModifier "phone" emailDocs schema) - where - emailDocs :: NamedSwaggerDoc -> NamedSwaggerDoc - emailDocs = description ?~ "Email" + emailDocs :: NamedSwaggerDoc -> NamedSwaggerDoc + emailDocs = description ?~ "Email" - phoneDocs :: NamedSwaggerDoc -> NamedSwaggerDoc - phoneDocs = description ?~ "Phone" + phoneDocs :: NamedSwaggerDoc -> NamedSwaggerDoc + phoneDocs = description ?~ "Phone" - fromTuple :: (Maybe Email, Maybe Phone) -> Parser (Either Email Phone) + fromTuple :: (Maybe Email, Maybe a) -> Parser NewPasswordReset fromTuple = \case (Just _, Just _) -> fail "Only one of 'email' or 'phone' allowed." - (Just email, Nothing) -> pure $ Left email - (Nothing, Just phone) -> pure $ Right phone + (Just email, Nothing) -> pure $ NewPasswordReset email + (Nothing, Just _) -> pure NewPasswordResetUnsupportedPhone (Nothing, Nothing) -> fail "One of 'email' or 'phone' required." - toTuple :: Either Email Phone -> (Maybe Email, Maybe Phone) + toTuple :: NewPasswordReset -> (Maybe Email, Maybe Text) toTuple = \case - Left e -> (Just e, Nothing) - Right p -> (Nothing, Just p) + NewPasswordReset e -> (Just e, Nothing) + NewPasswordResetUnsupportedPhone -> (Nothing, Just "") -------------------------------------------------------------------------------- -- CompletePasswordReset diff --git a/libs/wire-api/src/Wire/API/UserEvent.hs b/libs/wire-api/src/Wire/API/UserEvent.hs index ffcf9166be4..41cbc98fe75 100644 --- a/libs/wire-api/src/Wire/API/UserEvent.hs +++ b/libs/wire-api/src/Wire/API/UserEvent.hs @@ -108,7 +108,7 @@ instance ToSchema EventType where data UserEvent = UserCreated !User - | -- | A user is activated when the first user identity (email address or phone number) + | -- | A user is activated when the first user identity (email address) -- is verified. {#RefActivationEvent} UserActivated !User | -- | Account & API access of a user has been suspended. diff --git a/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated.hs b/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated.hs index db14e78b856..38c2fa673ea 100644 --- a/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated.hs +++ b/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated.hs @@ -866,6 +866,9 @@ tests = ), ( Test.Wire.API.Golden.Generated.NewUser_user.testObject_NewUser_user_8, "testObject_NewUser_user_8.json" + ), + ( Test.Wire.API.Golden.Generated.NewUser_user.testObject_NewUser_user_9, + "testObject_NewUser_user_9.json" ) ], testGroup "Golden: NewUserPublic_user" $ @@ -984,7 +987,7 @@ tests = testGroup "Golden: Activate_user" $ testObjects [(Test.Wire.API.Golden.Generated.Activate_user.testObject_Activate_user_1, "testObject_Activate_user_1.json"), (Test.Wire.API.Golden.Generated.Activate_user.testObject_Activate_user_2, "testObject_Activate_user_2.json"), (Test.Wire.API.Golden.Generated.Activate_user.testObject_Activate_user_3, "testObject_Activate_user_3.json"), (Test.Wire.API.Golden.Generated.Activate_user.testObject_Activate_user_4, "testObject_Activate_user_4.json"), (Test.Wire.API.Golden.Generated.Activate_user.testObject_Activate_user_5, "testObject_Activate_user_5.json"), (Test.Wire.API.Golden.Generated.Activate_user.testObject_Activate_user_6, "testObject_Activate_user_6.json"), (Test.Wire.API.Golden.Generated.Activate_user.testObject_Activate_user_7, "testObject_Activate_user_7.json"), (Test.Wire.API.Golden.Generated.Activate_user.testObject_Activate_user_8, "testObject_Activate_user_8.json"), (Test.Wire.API.Golden.Generated.Activate_user.testObject_Activate_user_9, "testObject_Activate_user_9.json"), (Test.Wire.API.Golden.Generated.Activate_user.testObject_Activate_user_10, "testObject_Activate_user_10.json"), (Test.Wire.API.Golden.Generated.Activate_user.testObject_Activate_user_11, "testObject_Activate_user_11.json"), (Test.Wire.API.Golden.Generated.Activate_user.testObject_Activate_user_12, "testObject_Activate_user_12.json"), (Test.Wire.API.Golden.Generated.Activate_user.testObject_Activate_user_13, "testObject_Activate_user_13.json"), (Test.Wire.API.Golden.Generated.Activate_user.testObject_Activate_user_14, "testObject_Activate_user_14.json"), (Test.Wire.API.Golden.Generated.Activate_user.testObject_Activate_user_15, "testObject_Activate_user_15.json"), (Test.Wire.API.Golden.Generated.Activate_user.testObject_Activate_user_16, "testObject_Activate_user_16.json"), (Test.Wire.API.Golden.Generated.Activate_user.testObject_Activate_user_17, "testObject_Activate_user_17.json"), (Test.Wire.API.Golden.Generated.Activate_user.testObject_Activate_user_18, "testObject_Activate_user_18.json"), (Test.Wire.API.Golden.Generated.Activate_user.testObject_Activate_user_19, "testObject_Activate_user_19.json"), (Test.Wire.API.Golden.Generated.Activate_user.testObject_Activate_user_20, "testObject_Activate_user_20.json")], testGroup "Golden: ActivationResponse_user" $ - testObjects [(Test.Wire.API.Golden.Generated.ActivationResponse_user.testObject_ActivationResponse_user_1, "testObject_ActivationResponse_user_1.json"), (Test.Wire.API.Golden.Generated.ActivationResponse_user.testObject_ActivationResponse_user_2, "testObject_ActivationResponse_user_2.json"), (Test.Wire.API.Golden.Generated.ActivationResponse_user.testObject_ActivationResponse_user_3, "testObject_ActivationResponse_user_3.json"), (Test.Wire.API.Golden.Generated.ActivationResponse_user.testObject_ActivationResponse_user_4, "testObject_ActivationResponse_user_4.json"), (Test.Wire.API.Golden.Generated.ActivationResponse_user.testObject_ActivationResponse_user_5, "testObject_ActivationResponse_user_5.json"), (Test.Wire.API.Golden.Generated.ActivationResponse_user.testObject_ActivationResponse_user_6, "testObject_ActivationResponse_user_6.json"), (Test.Wire.API.Golden.Generated.ActivationResponse_user.testObject_ActivationResponse_user_7, "testObject_ActivationResponse_user_7.json"), (Test.Wire.API.Golden.Generated.ActivationResponse_user.testObject_ActivationResponse_user_8, "testObject_ActivationResponse_user_8.json"), (Test.Wire.API.Golden.Generated.ActivationResponse_user.testObject_ActivationResponse_user_9, "testObject_ActivationResponse_user_9.json"), (Test.Wire.API.Golden.Generated.ActivationResponse_user.testObject_ActivationResponse_user_10, "testObject_ActivationResponse_user_10.json"), (Test.Wire.API.Golden.Generated.ActivationResponse_user.testObject_ActivationResponse_user_11, "testObject_ActivationResponse_user_11.json"), (Test.Wire.API.Golden.Generated.ActivationResponse_user.testObject_ActivationResponse_user_12, "testObject_ActivationResponse_user_12.json"), (Test.Wire.API.Golden.Generated.ActivationResponse_user.testObject_ActivationResponse_user_13, "testObject_ActivationResponse_user_13.json"), (Test.Wire.API.Golden.Generated.ActivationResponse_user.testObject_ActivationResponse_user_14, "testObject_ActivationResponse_user_14.json"), (Test.Wire.API.Golden.Generated.ActivationResponse_user.testObject_ActivationResponse_user_15, "testObject_ActivationResponse_user_15.json"), (Test.Wire.API.Golden.Generated.ActivationResponse_user.testObject_ActivationResponse_user_16, "testObject_ActivationResponse_user_16.json"), (Test.Wire.API.Golden.Generated.ActivationResponse_user.testObject_ActivationResponse_user_17, "testObject_ActivationResponse_user_17.json"), (Test.Wire.API.Golden.Generated.ActivationResponse_user.testObject_ActivationResponse_user_18, "testObject_ActivationResponse_user_18.json"), (Test.Wire.API.Golden.Generated.ActivationResponse_user.testObject_ActivationResponse_user_19, "testObject_ActivationResponse_user_19.json"), (Test.Wire.API.Golden.Generated.ActivationResponse_user.testObject_ActivationResponse_user_20, "testObject_ActivationResponse_user_20.json")], + testObjects [(Test.Wire.API.Golden.Generated.ActivationResponse_user.testObject_ActivationResponse_user_1, "testObject_ActivationResponse_user_1.json"), (Test.Wire.API.Golden.Generated.ActivationResponse_user.testObject_ActivationResponse_user_2, "testObject_ActivationResponse_user_2.json"), (Test.Wire.API.Golden.Generated.ActivationResponse_user.testObject_ActivationResponse_user_3, "testObject_ActivationResponse_user_3.json"), (Test.Wire.API.Golden.Generated.ActivationResponse_user.testObject_ActivationResponse_user_4, "testObject_ActivationResponse_user_4.json"), (Test.Wire.API.Golden.Generated.ActivationResponse_user.testObject_ActivationResponse_user_5, "testObject_ActivationResponse_user_5.json"), (Test.Wire.API.Golden.Generated.ActivationResponse_user.testObject_ActivationResponse_user_6, "testObject_ActivationResponse_user_6.json"), (Test.Wire.API.Golden.Generated.ActivationResponse_user.testObject_ActivationResponse_user_7, "testObject_ActivationResponse_user_7.json"), (Test.Wire.API.Golden.Generated.ActivationResponse_user.testObject_ActivationResponse_user_8, "testObject_ActivationResponse_user_8.json"), (Test.Wire.API.Golden.Generated.ActivationResponse_user.testObject_ActivationResponse_user_9, "testObject_ActivationResponse_user_9.json"), (Test.Wire.API.Golden.Generated.ActivationResponse_user.testObject_ActivationResponse_user_10, "testObject_ActivationResponse_user_10.json")], testGroup "Golden: SendActivationCode_user" $ testObjects [(Test.Wire.API.Golden.Generated.SendActivationCode_user.testObject_SendActivationCode_user_1, "testObject_SendActivationCode_user_1.json"), (Test.Wire.API.Golden.Generated.SendActivationCode_user.testObject_SendActivationCode_user_2, "testObject_SendActivationCode_user_2.json"), (Test.Wire.API.Golden.Generated.SendActivationCode_user.testObject_SendActivationCode_user_3, "testObject_SendActivationCode_user_3.json"), (Test.Wire.API.Golden.Generated.SendActivationCode_user.testObject_SendActivationCode_user_4, "testObject_SendActivationCode_user_4.json"), (Test.Wire.API.Golden.Generated.SendActivationCode_user.testObject_SendActivationCode_user_5, "testObject_SendActivationCode_user_5.json"), (Test.Wire.API.Golden.Generated.SendActivationCode_user.testObject_SendActivationCode_user_6, "testObject_SendActivationCode_user_6.json"), (Test.Wire.API.Golden.Generated.SendActivationCode_user.testObject_SendActivationCode_user_7, "testObject_SendActivationCode_user_7.json"), (Test.Wire.API.Golden.Generated.SendActivationCode_user.testObject_SendActivationCode_user_8, "testObject_SendActivationCode_user_8.json"), (Test.Wire.API.Golden.Generated.SendActivationCode_user.testObject_SendActivationCode_user_9, "testObject_SendActivationCode_user_9.json"), (Test.Wire.API.Golden.Generated.SendActivationCode_user.testObject_SendActivationCode_user_10, "testObject_SendActivationCode_user_10.json"), (Test.Wire.API.Golden.Generated.SendActivationCode_user.testObject_SendActivationCode_user_11, "testObject_SendActivationCode_user_11.json"), (Test.Wire.API.Golden.Generated.SendActivationCode_user.testObject_SendActivationCode_user_12, "testObject_SendActivationCode_user_12.json"), (Test.Wire.API.Golden.Generated.SendActivationCode_user.testObject_SendActivationCode_user_13, "testObject_SendActivationCode_user_13.json"), (Test.Wire.API.Golden.Generated.SendActivationCode_user.testObject_SendActivationCode_user_14, "testObject_SendActivationCode_user_14.json"), (Test.Wire.API.Golden.Generated.SendActivationCode_user.testObject_SendActivationCode_user_15, "testObject_SendActivationCode_user_15.json"), (Test.Wire.API.Golden.Generated.SendActivationCode_user.testObject_SendActivationCode_user_16, "testObject_SendActivationCode_user_16.json"), (Test.Wire.API.Golden.Generated.SendActivationCode_user.testObject_SendActivationCode_user_17, "testObject_SendActivationCode_user_17.json"), (Test.Wire.API.Golden.Generated.SendActivationCode_user.testObject_SendActivationCode_user_18, "testObject_SendActivationCode_user_18.json"), (Test.Wire.API.Golden.Generated.SendActivationCode_user.testObject_SendActivationCode_user_19, "testObject_SendActivationCode_user_19.json"), (Test.Wire.API.Golden.Generated.SendActivationCode_user.testObject_SendActivationCode_user_20, "testObject_SendActivationCode_user_20.json")], testGroup "Golden: LoginId_user" $ @@ -1056,7 +1059,7 @@ tests = testGroup "Golden: UserSSOId_user" $ testObjects [(Test.Wire.API.Golden.Generated.UserSSOId_user.testObject_UserSSOId_user_2, "testObject_UserSSOId_user_2.json"), (Test.Wire.API.Golden.Generated.UserSSOId_user.testObject_UserSSOId_user_9, "testObject_UserSSOId_user_9.json"), (Test.Wire.API.Golden.Generated.UserSSOId_user.testObject_UserSSOId_user_13, "testObject_UserSSOId_user_13.json")], testGroup "Golden: NewPasswordReset_user" $ - testObjects [(Test.Wire.API.Golden.Generated.NewPasswordReset_user.testObject_NewPasswordReset_user_1, "testObject_NewPasswordReset_user_1.json"), (Test.Wire.API.Golden.Generated.NewPasswordReset_user.testObject_NewPasswordReset_user_2, "testObject_NewPasswordReset_user_2.json"), (Test.Wire.API.Golden.Generated.NewPasswordReset_user.testObject_NewPasswordReset_user_3, "testObject_NewPasswordReset_user_3.json"), (Test.Wire.API.Golden.Generated.NewPasswordReset_user.testObject_NewPasswordReset_user_4, "testObject_NewPasswordReset_user_4.json"), (Test.Wire.API.Golden.Generated.NewPasswordReset_user.testObject_NewPasswordReset_user_5, "testObject_NewPasswordReset_user_5.json"), (Test.Wire.API.Golden.Generated.NewPasswordReset_user.testObject_NewPasswordReset_user_6, "testObject_NewPasswordReset_user_6.json"), (Test.Wire.API.Golden.Generated.NewPasswordReset_user.testObject_NewPasswordReset_user_7, "testObject_NewPasswordReset_user_7.json"), (Test.Wire.API.Golden.Generated.NewPasswordReset_user.testObject_NewPasswordReset_user_8, "testObject_NewPasswordReset_user_8.json"), (Test.Wire.API.Golden.Generated.NewPasswordReset_user.testObject_NewPasswordReset_user_9, "testObject_NewPasswordReset_user_9.json"), (Test.Wire.API.Golden.Generated.NewPasswordReset_user.testObject_NewPasswordReset_user_10, "testObject_NewPasswordReset_user_10.json"), (Test.Wire.API.Golden.Generated.NewPasswordReset_user.testObject_NewPasswordReset_user_11, "testObject_NewPasswordReset_user_11.json"), (Test.Wire.API.Golden.Generated.NewPasswordReset_user.testObject_NewPasswordReset_user_12, "testObject_NewPasswordReset_user_12.json"), (Test.Wire.API.Golden.Generated.NewPasswordReset_user.testObject_NewPasswordReset_user_13, "testObject_NewPasswordReset_user_13.json"), (Test.Wire.API.Golden.Generated.NewPasswordReset_user.testObject_NewPasswordReset_user_14, "testObject_NewPasswordReset_user_14.json"), (Test.Wire.API.Golden.Generated.NewPasswordReset_user.testObject_NewPasswordReset_user_15, "testObject_NewPasswordReset_user_15.json"), (Test.Wire.API.Golden.Generated.NewPasswordReset_user.testObject_NewPasswordReset_user_16, "testObject_NewPasswordReset_user_16.json"), (Test.Wire.API.Golden.Generated.NewPasswordReset_user.testObject_NewPasswordReset_user_17, "testObject_NewPasswordReset_user_17.json"), (Test.Wire.API.Golden.Generated.NewPasswordReset_user.testObject_NewPasswordReset_user_18, "testObject_NewPasswordReset_user_18.json"), (Test.Wire.API.Golden.Generated.NewPasswordReset_user.testObject_NewPasswordReset_user_19, "testObject_NewPasswordReset_user_19.json"), (Test.Wire.API.Golden.Generated.NewPasswordReset_user.testObject_NewPasswordReset_user_20, "testObject_NewPasswordReset_user_20.json")], + testObjects [(Test.Wire.API.Golden.Generated.NewPasswordReset_user.testObject_NewPasswordReset_user_1, "testObject_NewPasswordReset_user_1.json")], testGroup "Golden: PasswordResetKey_user" $ testObjects [(Test.Wire.API.Golden.Generated.PasswordResetKey_user.testObject_PasswordResetKey_user_1, "testObject_PasswordResetKey_user_1.json"), (Test.Wire.API.Golden.Generated.PasswordResetKey_user.testObject_PasswordResetKey_user_2, "testObject_PasswordResetKey_user_2.json"), (Test.Wire.API.Golden.Generated.PasswordResetKey_user.testObject_PasswordResetKey_user_3, "testObject_PasswordResetKey_user_3.json"), (Test.Wire.API.Golden.Generated.PasswordResetKey_user.testObject_PasswordResetKey_user_4, "testObject_PasswordResetKey_user_4.json"), (Test.Wire.API.Golden.Generated.PasswordResetKey_user.testObject_PasswordResetKey_user_5, "testObject_PasswordResetKey_user_5.json"), (Test.Wire.API.Golden.Generated.PasswordResetKey_user.testObject_PasswordResetKey_user_6, "testObject_PasswordResetKey_user_6.json"), (Test.Wire.API.Golden.Generated.PasswordResetKey_user.testObject_PasswordResetKey_user_7, "testObject_PasswordResetKey_user_7.json"), (Test.Wire.API.Golden.Generated.PasswordResetKey_user.testObject_PasswordResetKey_user_8, "testObject_PasswordResetKey_user_8.json"), (Test.Wire.API.Golden.Generated.PasswordResetKey_user.testObject_PasswordResetKey_user_9, "testObject_PasswordResetKey_user_9.json"), (Test.Wire.API.Golden.Generated.PasswordResetKey_user.testObject_PasswordResetKey_user_10, "testObject_PasswordResetKey_user_10.json"), (Test.Wire.API.Golden.Generated.PasswordResetKey_user.testObject_PasswordResetKey_user_11, "testObject_PasswordResetKey_user_11.json"), (Test.Wire.API.Golden.Generated.PasswordResetKey_user.testObject_PasswordResetKey_user_12, "testObject_PasswordResetKey_user_12.json"), (Test.Wire.API.Golden.Generated.PasswordResetKey_user.testObject_PasswordResetKey_user_13, "testObject_PasswordResetKey_user_13.json"), (Test.Wire.API.Golden.Generated.PasswordResetKey_user.testObject_PasswordResetKey_user_14, "testObject_PasswordResetKey_user_14.json"), (Test.Wire.API.Golden.Generated.PasswordResetKey_user.testObject_PasswordResetKey_user_15, "testObject_PasswordResetKey_user_15.json"), (Test.Wire.API.Golden.Generated.PasswordResetKey_user.testObject_PasswordResetKey_user_16, "testObject_PasswordResetKey_user_16.json"), (Test.Wire.API.Golden.Generated.PasswordResetKey_user.testObject_PasswordResetKey_user_17, "testObject_PasswordResetKey_user_17.json"), (Test.Wire.API.Golden.Generated.PasswordResetKey_user.testObject_PasswordResetKey_user_18, "testObject_PasswordResetKey_user_18.json"), (Test.Wire.API.Golden.Generated.PasswordResetKey_user.testObject_PasswordResetKey_user_19, "testObject_PasswordResetKey_user_19.json"), (Test.Wire.API.Golden.Generated.PasswordResetKey_user.testObject_PasswordResetKey_user_20, "testObject_PasswordResetKey_user_20.json")], testGroup "Golden: PasswordResetCode_user" $ diff --git a/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated/ActivationResponse_user.hs b/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated/ActivationResponse_user.hs index b4700eaeb43..020c4119ddd 100644 --- a/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated/ActivationResponse_user.hs +++ b/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated/ActivationResponse_user.hs @@ -19,18 +19,7 @@ module Test.Wire.API.Golden.Generated.ActivationResponse_user where import Imports (Bool (False, True), Maybe (Just, Nothing)) import Wire.API.User - ( Email (Email, emailDomain, emailLocal), - Phone (Phone, fromPhone), - UserIdentity - ( EmailIdentity, - FullIdentity, - PhoneIdentity, - SSOIdentity - ), - UserSSOId (UserSSOId, UserScimExternalId), - ) import Wire.API.User.Activation (ActivationResponse (..)) -import Wire.API.User.Identity (mkSimpleSampleUref) testObject_ActivationResponse_user_1 :: ActivationResponse testObject_ActivationResponse_user_1 = @@ -38,14 +27,13 @@ testObject_ActivationResponse_user_1 = { activatedIdentity = SSOIdentity (UserSSOId mkSimpleSampleUref) - (Just (Email {emailLocal = "\165918\rZ\a\ESC", emailDomain = "p\131777\62344"})) - Nothing, + (Just (Email {emailLocal = "\165918\rZ\a\ESC", emailDomain = "p\131777\62344"})), activatedFirst = False } testObject_ActivationResponse_user_2 :: ActivationResponse testObject_ActivationResponse_user_2 = - ActivationResponse {activatedIdentity = PhoneIdentity (Phone {fromPhone = "+7397347696479"}), activatedFirst = False} + ActivationResponse {activatedIdentity = EmailIdentity (Email "foo" "example.com"), activatedFirst = False} testObject_ActivationResponse_user_3 :: ActivationResponse testObject_ActivationResponse_user_3 = @@ -59,7 +47,7 @@ testObject_ActivationResponse_user_4 :: ActivationResponse testObject_ActivationResponse_user_4 = ActivationResponse { activatedIdentity = - FullIdentity (Email {emailLocal = "h\nPr3", emailDomain = ""}) (Phone {fromPhone = "+82309287"}), + EmailIdentity (Email {emailLocal = "h\nPr3", emailDomain = ""}), activatedFirst = True } @@ -74,7 +62,7 @@ testObject_ActivationResponse_user_5 = testObject_ActivationResponse_user_6 :: ActivationResponse testObject_ActivationResponse_user_6 = ActivationResponse - { activatedIdentity = SSOIdentity (UserScimExternalId "\an|") Nothing Nothing, + { activatedIdentity = SSOIdentity (UserScimExternalId "\an|") Nothing, activatedFirst = False } @@ -87,13 +75,13 @@ testObject_ActivationResponse_user_7 = testObject_ActivationResponse_user_8 :: ActivationResponse testObject_ActivationResponse_user_8 = - ActivationResponse {activatedIdentity = PhoneIdentity (Phone {fromPhone = "+0023160115015"}), activatedFirst = True} + ActivationResponse {activatedIdentity = EmailIdentity (Email "bar" "example.com"), activatedFirst = True} testObject_ActivationResponse_user_9 :: ActivationResponse testObject_ActivationResponse_user_9 = ActivationResponse { activatedIdentity = - FullIdentity (Email {emailLocal = "\ENQ?", emailDomain = ""}) (Phone {fromPhone = "+208573659013"}), + EmailIdentity (Email {emailLocal = "\ENQ?", emailDomain = ""}), activatedFirst = False } @@ -104,79 +92,3 @@ testObject_ActivationResponse_user_10 = EmailIdentity (Email {emailLocal = "\ACK3", emailDomain = "\f\1040847\1071035\EOT\1003280P\DEL"}), activatedFirst = False } - -testObject_ActivationResponse_user_11 :: ActivationResponse -testObject_ActivationResponse_user_11 = - ActivationResponse - { activatedIdentity = - EmailIdentity (Email {emailLocal = "z\126214m\146009<\1046292\a\DC31+*", emailDomain = "S\SO\125114"}), - activatedFirst = True - } - -testObject_ActivationResponse_user_12 :: ActivationResponse -testObject_ActivationResponse_user_12 = - ActivationResponse - { activatedIdentity = - EmailIdentity (Email {emailLocal = "d4p\r:\STXI5\167701\158743\GS\v", emailDomain = "\51121\100929"}), - activatedFirst = False - } - -testObject_ActivationResponse_user_13 :: ActivationResponse -testObject_ActivationResponse_user_13 = - ActivationResponse - { activatedIdentity = SSOIdentity (UserScimExternalId "#") Nothing (Just (Phone {fromPhone = "+6124426658"})), - activatedFirst = False - } - -testObject_ActivationResponse_user_14 :: ActivationResponse -testObject_ActivationResponse_user_14 = - ActivationResponse - { activatedIdentity = - SSOIdentity - (UserScimExternalId "\NUL\US\ETBY") - (Just (Email {emailLocal = "\66022", emailDomain = "\a\1081391"})) - Nothing, - activatedFirst = False - } - -testObject_ActivationResponse_user_15 :: ActivationResponse -testObject_ActivationResponse_user_15 = - ActivationResponse {activatedIdentity = PhoneIdentity (Phone {fromPhone = "+594453349310"}), activatedFirst = False} - -testObject_ActivationResponse_user_16 :: ActivationResponse -testObject_ActivationResponse_user_16 = - ActivationResponse - { activatedIdentity = - FullIdentity (Email {emailLocal = "r\FS,\"", emailDomain = "%R\n\164677^"}) (Phone {fromPhone = "+144713467"}), - activatedFirst = False - } - -testObject_ActivationResponse_user_17 :: ActivationResponse -testObject_ActivationResponse_user_17 = - ActivationResponse - { activatedIdentity = - SSOIdentity - (UserScimExternalId "") - (Just (Email {emailLocal = "\155143", emailDomain = "+)"})) - (Just (Phone {fromPhone = "+703448141"})), - activatedFirst = True - } - -testObject_ActivationResponse_user_18 :: ActivationResponse -testObject_ActivationResponse_user_18 = - ActivationResponse {activatedIdentity = PhoneIdentity (Phone {fromPhone = "+974462685543005"}), activatedFirst = True} - -testObject_ActivationResponse_user_19 :: ActivationResponse -testObject_ActivationResponse_user_19 = - ActivationResponse - { activatedIdentity = SSOIdentity (UserSSOId mkSimpleSampleUref) (Just (Email {emailLocal = "R", emailDomain = "K"})) Nothing, - activatedFirst = False - } - -testObject_ActivationResponse_user_20 :: ActivationResponse -testObject_ActivationResponse_user_20 = - ActivationResponse - { activatedIdentity = - FullIdentity (Email {emailLocal = "", emailDomain = "E"}) (Phone {fromPhone = "+73148778831190"}), - activatedFirst = False - } diff --git a/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated/CompletePasswordReset_user.hs b/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated/CompletePasswordReset_user.hs index a52b2589cb2..5881ee95222 100644 --- a/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated/CompletePasswordReset_user.hs +++ b/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated/CompletePasswordReset_user.hs @@ -17,20 +17,11 @@ module Test.Wire.API.Golden.Generated.CompletePasswordReset_user where -import Data.Misc (plainTextPassword8Unsafe) -import Data.Text.Ascii (AsciiChars (validate)) -import Imports (fromRight, undefined) -import Wire.API.User (Email (Email, emailDomain, emailLocal), Phone (Phone, fromPhone)) +import Data.Misc +import Data.Text.Ascii +import Imports +import Wire.API.User import Wire.API.User.Password - ( CompletePasswordReset (..), - PasswordResetCode (PasswordResetCode, fromPasswordResetCode), - PasswordResetIdentity - ( PasswordResetEmailIdentity, - PasswordResetIdentityKey, - PasswordResetPhoneIdentity - ), - PasswordResetKey (PasswordResetKey, fromPasswordResetKey), - ) testObject_CompletePasswordReset_user_1 :: CompletePasswordReset testObject_CompletePasswordReset_user_1 = diff --git a/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated/NewPasswordReset_user.hs b/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated/NewPasswordReset_user.hs index d978208f4c9..f21c63bcbe2 100644 --- a/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated/NewPasswordReset_user.hs +++ b/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated/NewPasswordReset_user.hs @@ -17,124 +17,14 @@ module Test.Wire.API.Golden.Generated.NewPasswordReset_user where -import Imports (Either (Left, Right)) -import Wire.API.User (Email (Email, emailDomain, emailLocal), Phone (Phone, fromPhone)) -import Wire.API.User.Password (NewPasswordReset (..)) +import Wire.API.User +import Wire.API.User.Password testObject_NewPasswordReset_user_1 :: NewPasswordReset testObject_NewPasswordReset_user_1 = NewPasswordReset - ( Left - ( Email - { emailLocal = "\1007057b\1098950\&9#\34943\DLEX2o\6661\171973\60563t", - emailDomain = "\1080376\60900\DC1\41907s\f\98453}\CAN\SO\n8\SUBz\169687\n\154344Zdb#\SUB4IM8\67225+" - } - ) + ( Email + { emailLocal = "\1007057b\1098950\&9#\34943\DLEX2o\6661\171973\60563t", + emailDomain = "\1080376\60900\DC1\41907s\f\98453}\CAN\SO\n8\SUBz\169687\n\154344Zdb#\SUB4IM8\67225+" + } ) - -testObject_NewPasswordReset_user_2 :: NewPasswordReset -testObject_NewPasswordReset_user_2 = NewPasswordReset (Right (Phone {fromPhone = "+529329682"})) - -testObject_NewPasswordReset_user_3 :: NewPasswordReset -testObject_NewPasswordReset_user_3 = NewPasswordReset (Right (Phone {fromPhone = "+41719978"})) - -testObject_NewPasswordReset_user_4 :: NewPasswordReset -testObject_NewPasswordReset_user_4 = NewPasswordReset (Right (Phone {fromPhone = "+607957193"})) - -testObject_NewPasswordReset_user_5 :: NewPasswordReset -testObject_NewPasswordReset_user_5 = NewPasswordReset (Right (Phone {fromPhone = "+83279556464710"})) - -testObject_NewPasswordReset_user_6 :: NewPasswordReset -testObject_NewPasswordReset_user_6 = - NewPasswordReset - ( Left - ( Email - { emailLocal = "\152884", - emailDomain = - "pkTt\1001860,K\1102090C\53037\&2\1035134\1067347s\n\r\1067827\1098299+\41929\DEL:\GS[\194887MbEC\NUL" - } - ) - ) - -testObject_NewPasswordReset_user_7 :: NewPasswordReset -testObject_NewPasswordReset_user_7 = - NewPasswordReset - ( Left - ( Email - { emailLocal = "N\189885V'}\985226\a3", - emailDomain = "*\SYNjF\18337\"~Z\58036\41350z\138497bN\131493\8948)I3\t\EOT\1042981\1077394,\DC4" - } - ) - ) - -testObject_NewPasswordReset_user_8 :: NewPasswordReset -testObject_NewPasswordReset_user_8 = - NewPasswordReset - ( Left - ( Email - { emailLocal = "(a\34126'CKj\ESC\EM\1051534", - emailDomain = "?\986742D\135082\1012625\&7\1076206eh\18902gS\1090140}\1073865n_" - } - ) - ) - -testObject_NewPasswordReset_user_9 :: NewPasswordReset -testObject_NewPasswordReset_user_9 = - NewPasswordReset - ( Left - ( Email - { emailLocal = "\ETXji\b\a\995206\1001044\120664'\8103k\RS+", - emailDomain = - "\FS:\ETX\f\1071180\&5\22603t\135200>\174985IE\1065671M\DC2g\SUBAO\159061\&3\"\1000816H\54341c\129145\44991\&6" - } - ) - ) - -testObject_NewPasswordReset_user_10 :: NewPasswordReset -testObject_NewPasswordReset_user_10 = - NewPasswordReset - ( Left - ( Email - { emailLocal = "P\1065495m#\bo\n?n\170449\RSnr\"^c\1033506\\'g\53693l", - emailDomain = "/?\17268\1093472\SUBt\ETXv" - } - ) - ) - -testObject_NewPasswordReset_user_11 :: NewPasswordReset -testObject_NewPasswordReset_user_11 = NewPasswordReset (Right (Phone {fromPhone = "+009509628647"})) - -testObject_NewPasswordReset_user_12 :: NewPasswordReset -testObject_NewPasswordReset_user_12 = - NewPasswordReset - (Left (Email {emailLocal = "9G\144799", emailDomain = "\986254\SYN\1003426\182313\SI\STX\US\NAKgP \987001"})) - -testObject_NewPasswordReset_user_13 :: NewPasswordReset -testObject_NewPasswordReset_user_13 = NewPasswordReset (Right (Phone {fromPhone = "+33232954574312"})) - -testObject_NewPasswordReset_user_14 :: NewPasswordReset -testObject_NewPasswordReset_user_14 = NewPasswordReset (Right (Phone {fromPhone = "+314850099"})) - -testObject_NewPasswordReset_user_15 :: NewPasswordReset -testObject_NewPasswordReset_user_15 = - NewPasswordReset - ( Left - (Email {emailLocal = "\139234\21486\ETX 9\ESC0!\ETX\1007793\ETXxBxL=DL\25894/\r\7651", emailDomain = "$56f!/"}) - ) - -testObject_NewPasswordReset_user_16 :: NewPasswordReset -testObject_NewPasswordReset_user_16 = - NewPasswordReset - (Left (Email {emailLocal = "w\SOHspQ(\25060\EOT\"\\\ETXrbE\n5\111158D", emailDomain = "ps!\t\178810"})) - -testObject_NewPasswordReset_user_17 :: NewPasswordReset -testObject_NewPasswordReset_user_17 = NewPasswordReset (Right (Phone {fromPhone = "+560530602858"})) - -testObject_NewPasswordReset_user_18 :: NewPasswordReset -testObject_NewPasswordReset_user_18 = NewPasswordReset (Right (Phone {fromPhone = "+2603603795"})) - -testObject_NewPasswordReset_user_19 :: NewPasswordReset -testObject_NewPasswordReset_user_19 = NewPasswordReset (Right (Phone {fromPhone = "+002938255629"})) - -testObject_NewPasswordReset_user_20 :: NewPasswordReset -testObject_NewPasswordReset_user_20 = NewPasswordReset (Right (Phone {fromPhone = "+77098859488192"})) diff --git a/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated/NewUserPublic_user.hs b/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated/NewUserPublic_user.hs index dd4280f8b41..e51c5ce8aff 100644 --- a/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated/NewUserPublic_user.hs +++ b/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated/NewUserPublic_user.hs @@ -38,7 +38,8 @@ testObject_NewUserPublic_user_1 = { newUserDisplayName = Name {fromName = "\\sY4]u\1033976\DLE\1027259\FS\ETX \US\ETB\1066640dw;}\1073386@\184511\r8"}, newUserUUID = Nothing, - newUserIdentity = Just (PhoneIdentity (Phone {fromPhone = "+35453839"})), + newUserIdentity = Just (EmailIdentity (Email {emailLocal = "test", emailDomain = "example.com"})), + newUserPhone = Nothing, newUserPict = Nothing, newUserAssets = [ ImageAsset (AssetKeyV3 (Id (fromJust (UUID.fromString "5cd81cc4-c643-4e9c-849c-c596a88c27fd"))) AssetExpiring) (Just AssetComplete), @@ -52,8 +53,7 @@ testObject_NewUserPublic_user_1 = { fromActivationCode = fromRight undefined (validate "cfTQLlhl6H6sYloQXsghILggxWoGhM2WGbxjzm0=") } ), - newUserPhoneCode = - Just (ActivationCode {fromActivationCode = fromRight undefined (validate "wCWrnJoscPLT")}), + newUserPhoneCode = Nothing, newUserOrigin = Just ( NewUserOriginTeamUser diff --git a/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated/NewUser_user.hs b/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated/NewUser_user.hs index d596164f75c..5d0a458757c 100644 --- a/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated/NewUser_user.hs +++ b/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated/NewUser_user.hs @@ -39,31 +39,8 @@ import Imports (Maybe (Just, Nothing), fromJust, fromRight, undefined, (.)) import Wire.API.Asset import Wire.API.Team (BindingNewTeam (..), Icon (..), NewTeam (..)) import Wire.API.User - ( Asset (ImageAsset), - AssetSize (..), - BindingNewTeamUser (..), - ColourId (ColourId, fromColourId), - Country (Country, fromCountry), - Email (Email, emailDomain, emailLocal), - InvitationCode (InvitationCode, fromInvitationCode), - Language (Language), - Locale (Locale, lCountry, lLanguage), - ManagedBy (ManagedByWire), - Name (Name, fromName), - NewTeamUser (..), - NewUser (..), - NewUserOrigin (..), - Pict (Pict, fromPict), - UserIdentity - ( EmailIdentity, - PhoneIdentity, - SSOIdentity - ), - emptyNewUser, - ) import Wire.API.User.Activation (ActivationCode (ActivationCode, fromActivationCode)) import Wire.API.User.Auth (CookieLabel (CookieLabel, cookieLabelText)) -import Wire.API.User.Identity (Phone (..), UserSSOId (UserSSOId), mkSimpleSampleUref) testObject_NewUser_user_1 :: NewUser testObject_NewUser_user_1 = @@ -75,6 +52,7 @@ testObject_NewUser_user_1 = }, newUserUUID = (Just . toUUID) (Id (fromJust (UUID.fromString "00000000-0000-0000-0000-000000000000"))), newUserIdentity = Just (EmailIdentity (Email {emailLocal = "S\ENQX\1076723$\STX\"\1110507e\1015716\24831\1031964L\ETB", emailDomain = "P.b"})), + newUserPhone = Nothing, newUserPict = Just (Pict {fromPict = []}), newUserAssets = [ ImageAsset (AssetKeyV3 (Id (fromJust (UUID.fromString "5cd81cc4-c643-4e9c-849c-c596a88c27fd"))) AssetExpiring) (Just AssetPreview), @@ -83,7 +61,7 @@ testObject_NewUser_user_1 = ], newUserAccentId = Just (ColourId {fromColourId = -7404}), newUserEmailCode = Just (ActivationCode {fromActivationCode = fromRight undefined (validate "1YgaHo0=")}), - newUserPhoneCode = Just (ActivationCode {fromActivationCode = fromRight undefined (validate "z1OeJQ==")}), + newUserPhoneCode = Nothing, newUserOrigin = Just ( NewUserOriginInvitationCode @@ -143,7 +121,7 @@ testObject_NewUser_user_6 = (Name {fromName = "test name"}) ) { newUserOrigin = Just (NewUserOriginTeamUser (NewTeamMemberSSO tid)), - newUserIdentity = Just (SSOIdentity (UserSSOId mkSimpleSampleUref) Nothing Nothing) + newUserIdentity = Just (SSOIdentity (UserSSOId mkSimpleSampleUref) Nothing) } where tid = Id (fromJust (UUID.fromString "00007b0e-0000-3489-0000-075c00005be7")) @@ -154,7 +132,7 @@ testObject_NewUser_user_7 = (Name {fromName = "test name"}) ) { newUserOrigin = Just (NewUserOriginTeamUser (NewTeamCreator user)), - newUserIdentity = Just (PhoneIdentity (Phone "+12345678")), + newUserIdentity = Just (EmailIdentity (Email "12345678" "example.com")), newUserPassword = Just (plainTextPassword8Unsafe "12345678") } where @@ -184,6 +162,26 @@ testObject_NewUser_user_8 = (Name {fromName = "test name"}) ) { newUserOrigin = Just (NewUserOriginTeamUser (NewTeamMember invCode)), - newUserIdentity = Just (PhoneIdentity (Phone "+12345678")), + newUserIdentity = + Just + ( EmailIdentity + ( Email + { emailLocal = "S\ENQX\1076723$\STX\"\1110507e\1015716\24831\1031964L\ETB", + emailDomain = "P.b" + } + ) + ), newUserPassword = Just (plainTextPassword8Unsafe "12345678") } + +testObject_NewUser_user_9 :: NewUser +testObject_NewUser_user_9 = + testObject_NewUser_user_1 + { newUserPhoneCode = + Just + ( ActivationCode + { fromActivationCode = + fromRight undefined (validate "z1OeJQ==") + } + ) + } diff --git a/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated/SelfProfile_user.hs b/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated/SelfProfile_user.hs index 046e2bf3dc5..d2ad435f18c 100644 --- a/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated/SelfProfile_user.hs +++ b/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated/SelfProfile_user.hs @@ -42,7 +42,7 @@ testObject_SelfProfile_user_1 = qDomain = Domain {_domainText = "n0-994.m-226.f91.vg9p-mj-j2"} }, userIdentity = - Just (FullIdentity (Email {emailLocal = "\a", emailDomain = ""}) (Phone {fromPhone = "+6171884202"})), + Just (EmailIdentity (Email {emailLocal = "\a", emailDomain = ""})), userDisplayName = Name {fromName = "@\1457\2598\66242\US\1104967l+\137302\&6\996495^\162211Mu\t"}, userPict = Pict {fromPict = []}, userAssets = [], diff --git a/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated/SendActivationCode_user.hs b/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated/SendActivationCode_user.hs index 03758db46bd..9ef7d361f43 100644 --- a/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated/SendActivationCode_user.hs +++ b/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated/SendActivationCode_user.hs @@ -71,7 +71,11 @@ testObject_SendActivationCode_user_4 = testObject_SendActivationCode_user_5 :: SendActivationCode testObject_SendActivationCode_user_5 = - SendActivationCode {saUserKey = Right (Phone {fromPhone = "+883124214493"}), saLocale = Nothing, saCall = False} + SendActivationCode + { saUserKey = Left (Email {emailLocal = "test", emailDomain = "example.com"}), + saLocale = Nothing, + saCall = False + } testObject_SendActivationCode_user_6 :: SendActivationCode testObject_SendActivationCode_user_6 = diff --git a/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated/User_user.hs b/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated/User_user.hs index de58fc8b457..42e501c6f2b 100644 --- a/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated/User_user.hs +++ b/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated/User_user.hs @@ -77,7 +77,7 @@ testObject_User_user_2 = { qUnqualified = Id (fromJust (UUID.fromString "00000000-0000-0001-0000-000200000001")), qDomain = Domain {_domainText = "k.vbg.p"} }, - userIdentity = Just (PhoneIdentity (Phone {fromPhone = "+837934954"})), + userIdentity = Just (EmailIdentity (Email "foo" "example.com")), userDisplayName = Name { fromName = @@ -145,7 +145,7 @@ testObject_User_user_4 = qDomain = Domain {_domainText = "28b.cqb"} }, userIdentity = - Just (SSOIdentity (UserScimExternalId "") (Just (Email {emailLocal = "", emailDomain = ""})) Nothing), + Just (SSOIdentity (UserScimExternalId "") (Just (Email {emailLocal = "", emailDomain = ""}))), userDisplayName = Name { fromName = @@ -180,7 +180,7 @@ testObject_User_user_5 = qDomain = Domain {_domainText = "28b.cqb"} }, userIdentity = - Just (FullIdentity (Email {emailLocal = "", emailDomain = ""}) (Phone {fromPhone = "+837934954"})), + Just (EmailIdentity (Email {emailLocal = "bar", emailDomain = "example.com"})), userDisplayName = Name { fromName = diff --git a/libs/wire-api/test/golden/fromJSON/testObject_NewUserPublic_user_1-2.json b/libs/wire-api/test/golden/fromJSON/testObject_NewUserPublic_user_1-2.json index 1d92088b8d5..b766fba68f4 100644 --- a/libs/wire-api/test/golden/fromJSON/testObject_NewUserPublic_user_1-2.json +++ b/libs/wire-api/test/golden/fromJSON/testObject_NewUserPublic_user_1-2.json @@ -16,13 +16,12 @@ "type": "image" } ], + "email": "test@example.com", "email_code": "cfTQLlhl6H6sYloQXsghILggxWoGhM2WGbxjzm0=", "label": ">>Mp१𤘇9:󺰽􋼒\u0010D1j󾮢􂊠;􄆇󳸪f#]", "locale": "so", "managed_by": "wire", "name": "\\sY4]u󼛸\u0010󺲻\u001c\u0003 \u001f\u0017􄚐dw;}􆃪@𭂿\r8", "password": "dX󹊒赲󶻎ht𘙏󴰏\u0007>\u0018\u000bO95\u0015\n(𩝙󻞌嶝f]_𪀮\u00002FQbNS=6g󿷼P𢲾􃨫󰧽􅤹M\u001e7\u0016~\u0017m󽎭\u0006\u0001\u000bkgmBp\u0017w悬𩓯f󹼮%Q\u0004𢔶kP|G𥬅\u0017B-\nJWH(8)4$󱠶<7𭨖\u001cI\u0008A\u0010\r?󹀊\u0008\u00085\u0006󶟨d \u00166􍉶G\u0018\u0008\t=qG􃁰 D\u0002vV\tYpg󸋮吝q\n \u0017L􁼛-􏕋\u0013󺃝F7Q􊔜]揃i?\r\u0010\u001b{=􎕻_?e􇢹%\u000eR󱆼\u001b+\u000ef\u0017q:g\\Rk馍𪝞[l\u0015􉜀VK\njwp\u00043TJྏEj\u0002R7d83ON\u0017q獿\u0019𮣜N8\n\u000f󻦼u:GꓻFZ\u001c<\u0015揤7􉖬tH󿳸;hbS{ꮯ\u001csMs󲷒9B4􀷾35c(~CUc󸇪\\V_XD3>Mp१𤘇9:󺰽􋼒\u0010D1j󾮢􂊠;􄆇󳸪f#]", "locale": "so", "managed_by": "scim", "name": "\\sY4]u󼛸\u0010󺲻\u001c\u0003 \u001f\u0017􄚐dw;}􆃪@𭂿\r8", - "password": "dX󹊒赲󶻎ht𘙏󴰏\u0007>\u0018\u000bO95\u0015\n(𩝙󻞌嶝f]_𪀮\u00002FQbNS=6g󿷼P𢲾􃨫󰧽􅤹M\u001e7\u0016~\u0017m󽎭\u0006\u0001\u000bkgmBp\u0017w悬𩓯f󹼮%Q\u0004𢔶kP|G𥬅\u0017B-\nJWH(8)4$󱠶<7𭨖\u001cI\u0008A\u0010\r?󹀊\u0008\u00085\u0006󶟨d \u00166􍉶G\u0018\u0008\t=qG􃁰 D\u0002vV\tYpg󸋮吝q\n \u0017L􁼛-􏕋\u0013󺃝F7Q􊔜]揃i?\r\u0010\u001b{=􎕻_?e􇢹%\u000eR󱆼\u001b+\u000ef\u0017q:g\\Rk馍𪝞[l\u0015􉜀VK\njwp\u00043TJྏEj\u0002R7d83ON\u0017q獿\u0019𮣜N8\n\u000f󻦼u:GꓻFZ\u001c<\u0015揤7􉖬tH󿳸;hbS{ꮯ\u001csMs󲷒9B4􀷾35c(~CUc󸇪\\V_XD3\u0018\u000bO95\u0015\n(𩝙󻞌嶝f]_𪀮\u00002FQbNS=6g󿷼P𢲾􃨫󰧽􅤹M\u001e7\u0016~\u0017m󽎭\u0006\u0001\u000bkgmBp\u0017w悬𩓯f󹼮%Q\u0004𢔶kP|G𥬅\u0017B-\nJWH(8)4$󱠶<7𭨖\u001cI\u0008A\u0010\r?󹀊\u0008\u00085\u0006󶟨d \u00166􍉶G\u0018\u0008\t=qG􃁰 D\u0002vV\tYpg󸋮吝q\n \u0017L􁼛-􏕋\u0013󺃝F7Q􊔜]揃i?\r\u0010\u001b{=􎕻_?e􇢹%\u000eR󱆼\u001b+\u000ef\u0017q:g\\Rk馍𪝞[l\u0015􉜀VK\njwp\u00043TJྏEj\u0002R7d83ON\u0017q獿\u0019𮣜N8\n\u000f󻦼u:GꓻFZ\u001c<\u0015揤7􉖬tH󿳸;hbS{ꮯ\u001csMs󲷒9B4􀷾35c(~CUc󸇪\\V_XD3me@example.com", - "tenant": "http://example.com/" - } -} diff --git a/libs/wire-api/test/golden/testObject_ActivationResponse_user_2.json b/libs/wire-api/test/golden/testObject_ActivationResponse_user_2.json index 03b9bf0eda7..7f4dc0a99de 100644 --- a/libs/wire-api/test/golden/testObject_ActivationResponse_user_2.json +++ b/libs/wire-api/test/golden/testObject_ActivationResponse_user_2.json @@ -1,4 +1,4 @@ { - "first": false, - "phone": "+7397347696479" + "email": "foo@example.com", + "first": false } diff --git a/libs/wire-api/test/golden/testObject_ActivationResponse_user_20.json b/libs/wire-api/test/golden/testObject_ActivationResponse_user_20.json deleted file mode 100644 index 8632977b231..00000000000 --- a/libs/wire-api/test/golden/testObject_ActivationResponse_user_20.json +++ /dev/null @@ -1,5 +0,0 @@ -{ - "email": "@E", - "first": false, - "phone": "+73148778831190" -} diff --git a/libs/wire-api/test/golden/testObject_ActivationResponse_user_4.json b/libs/wire-api/test/golden/testObject_ActivationResponse_user_4.json index 93dce573572..2fc240718b3 100644 --- a/libs/wire-api/test/golden/testObject_ActivationResponse_user_4.json +++ b/libs/wire-api/test/golden/testObject_ActivationResponse_user_4.json @@ -1,5 +1,4 @@ { "email": "h\nPr3@", - "first": true, - "phone": "+82309287" + "first": true } diff --git a/libs/wire-api/test/golden/testObject_ActivationResponse_user_8.json b/libs/wire-api/test/golden/testObject_ActivationResponse_user_8.json index 513dc4fb48e..38b2903f340 100644 --- a/libs/wire-api/test/golden/testObject_ActivationResponse_user_8.json +++ b/libs/wire-api/test/golden/testObject_ActivationResponse_user_8.json @@ -1,4 +1,4 @@ { - "first": true, - "phone": "+0023160115015" + "email": "bar@example.com", + "first": true } diff --git a/libs/wire-api/test/golden/testObject_ActivationResponse_user_9.json b/libs/wire-api/test/golden/testObject_ActivationResponse_user_9.json index 0d2dac853ad..83a3641e055 100644 --- a/libs/wire-api/test/golden/testObject_ActivationResponse_user_9.json +++ b/libs/wire-api/test/golden/testObject_ActivationResponse_user_9.json @@ -1,5 +1,4 @@ { "email": "\u0005?@", - "first": false, - "phone": "+208573659013" + "first": false } diff --git a/libs/wire-api/test/golden/testObject_NewPasswordReset_user_10.json b/libs/wire-api/test/golden/testObject_NewPasswordReset_user_10.json deleted file mode 100644 index 152a1896f54..00000000000 --- a/libs/wire-api/test/golden/testObject_NewPasswordReset_user_10.json +++ /dev/null @@ -1,3 +0,0 @@ -{ - "email": "P􄈗m#\u0008o\n?n𩧑\u001enr\"^c󼔢\\'g톽l@/?䍴􊽠\u001at\u0003v" -} diff --git a/libs/wire-api/test/golden/testObject_NewPasswordReset_user_11.json b/libs/wire-api/test/golden/testObject_NewPasswordReset_user_11.json deleted file mode 100644 index 107ab814813..00000000000 --- a/libs/wire-api/test/golden/testObject_NewPasswordReset_user_11.json +++ /dev/null @@ -1,3 +0,0 @@ -{ - "phone": "+009509628647" -} diff --git a/libs/wire-api/test/golden/testObject_NewPasswordReset_user_12.json b/libs/wire-api/test/golden/testObject_NewPasswordReset_user_12.json deleted file mode 100644 index fcd31ea90cb..00000000000 --- a/libs/wire-api/test/golden/testObject_NewPasswordReset_user_12.json +++ /dev/null @@ -1,3 +0,0 @@ -{ - "email": "9G𣖟@󰲎\u0016󴾢𬠩\u000f\u0002\u001f\u0015gP 󰽹" -} diff --git a/libs/wire-api/test/golden/testObject_NewPasswordReset_user_13.json b/libs/wire-api/test/golden/testObject_NewPasswordReset_user_13.json deleted file mode 100644 index 3f76fe2e7d2..00000000000 --- a/libs/wire-api/test/golden/testObject_NewPasswordReset_user_13.json +++ /dev/null @@ -1,3 +0,0 @@ -{ - "phone": "+33232954574312" -} diff --git a/libs/wire-api/test/golden/testObject_NewPasswordReset_user_14.json b/libs/wire-api/test/golden/testObject_NewPasswordReset_user_14.json deleted file mode 100644 index 6efa3b1c7ed..00000000000 --- a/libs/wire-api/test/golden/testObject_NewPasswordReset_user_14.json +++ /dev/null @@ -1,3 +0,0 @@ -{ - "phone": "+314850099" -} diff --git a/libs/wire-api/test/golden/testObject_NewPasswordReset_user_15.json b/libs/wire-api/test/golden/testObject_NewPasswordReset_user_15.json deleted file mode 100644 index 5365ea04b92..00000000000 --- a/libs/wire-api/test/golden/testObject_NewPasswordReset_user_15.json +++ /dev/null @@ -1,3 +0,0 @@ -{ - "email": "𡿢叮\u0003 9\u001b0!\u0003󶂱\u0003xBxL=DL攦/\rᷣ@$56f!/" -} diff --git a/libs/wire-api/test/golden/testObject_NewPasswordReset_user_16.json b/libs/wire-api/test/golden/testObject_NewPasswordReset_user_16.json deleted file mode 100644 index 523c1e8b58d..00000000000 --- a/libs/wire-api/test/golden/testObject_NewPasswordReset_user_16.json +++ /dev/null @@ -1,3 +0,0 @@ -{ - "email": "w\u0001spQ(懤\u0004\"\\\u0003rbE\n5𛈶D@ps!\t𫩺" -} diff --git a/libs/wire-api/test/golden/testObject_NewPasswordReset_user_17.json b/libs/wire-api/test/golden/testObject_NewPasswordReset_user_17.json deleted file mode 100644 index 658a71b4a85..00000000000 --- a/libs/wire-api/test/golden/testObject_NewPasswordReset_user_17.json +++ /dev/null @@ -1,3 +0,0 @@ -{ - "phone": "+560530602858" -} diff --git a/libs/wire-api/test/golden/testObject_NewPasswordReset_user_18.json b/libs/wire-api/test/golden/testObject_NewPasswordReset_user_18.json deleted file mode 100644 index 50822cea0e1..00000000000 --- a/libs/wire-api/test/golden/testObject_NewPasswordReset_user_18.json +++ /dev/null @@ -1,3 +0,0 @@ -{ - "phone": "+2603603795" -} diff --git a/libs/wire-api/test/golden/testObject_NewPasswordReset_user_19.json b/libs/wire-api/test/golden/testObject_NewPasswordReset_user_19.json deleted file mode 100644 index 4625c19bd3c..00000000000 --- a/libs/wire-api/test/golden/testObject_NewPasswordReset_user_19.json +++ /dev/null @@ -1,3 +0,0 @@ -{ - "phone": "+002938255629" -} diff --git a/libs/wire-api/test/golden/testObject_NewPasswordReset_user_2.json b/libs/wire-api/test/golden/testObject_NewPasswordReset_user_2.json deleted file mode 100644 index 68395a3ba7c..00000000000 --- a/libs/wire-api/test/golden/testObject_NewPasswordReset_user_2.json +++ /dev/null @@ -1,3 +0,0 @@ -{ - "phone": "+529329682" -} diff --git a/libs/wire-api/test/golden/testObject_NewPasswordReset_user_3.json b/libs/wire-api/test/golden/testObject_NewPasswordReset_user_3.json deleted file mode 100644 index 56f49e6a58f..00000000000 --- a/libs/wire-api/test/golden/testObject_NewPasswordReset_user_3.json +++ /dev/null @@ -1,3 +0,0 @@ -{ - "phone": "+41719978" -} diff --git a/libs/wire-api/test/golden/testObject_NewPasswordReset_user_4.json b/libs/wire-api/test/golden/testObject_NewPasswordReset_user_4.json deleted file mode 100644 index 174d2ed33e6..00000000000 --- a/libs/wire-api/test/golden/testObject_NewPasswordReset_user_4.json +++ /dev/null @@ -1,3 +0,0 @@ -{ - "phone": "+607957193" -} diff --git a/libs/wire-api/test/golden/testObject_NewPasswordReset_user_5.json b/libs/wire-api/test/golden/testObject_NewPasswordReset_user_5.json deleted file mode 100644 index 0a8a0a8911b..00000000000 --- a/libs/wire-api/test/golden/testObject_NewPasswordReset_user_5.json +++ /dev/null @@ -1,3 +0,0 @@ -{ - "phone": "+83279556464710" -} diff --git a/libs/wire-api/test/golden/testObject_NewPasswordReset_user_6.json b/libs/wire-api/test/golden/testObject_NewPasswordReset_user_6.json deleted file mode 100644 index f62f1d3b713..00000000000 --- a/libs/wire-api/test/golden/testObject_NewPasswordReset_user_6.json +++ /dev/null @@ -1,3 +0,0 @@ -{ - "email": "𥔴@pkTt󴦄,K􍄊C켭2󼭾􄥓s\n\r􄬳􌈻+ꏉ:\u001d[真MbEC\u0000" -} diff --git a/libs/wire-api/test/golden/testObject_NewPasswordReset_user_7.json b/libs/wire-api/test/golden/testObject_NewPasswordReset_user_7.json deleted file mode 100644 index 72d7e3149eb..00000000000 --- a/libs/wire-api/test/golden/testObject_NewPasswordReset_user_7.json +++ /dev/null @@ -1,3 +0,0 @@ -{ - "email": "N𮖽V'}󰢊\u00073@*\u0016jF䞡\"~Zꆆz𡴁bN𠆥⋴)I3\t\u0004󾨥􇂒,\u0014" -} diff --git a/libs/wire-api/test/golden/testObject_NewPasswordReset_user_8.json b/libs/wire-api/test/golden/testObject_NewPasswordReset_user_8.json deleted file mode 100644 index d4f4083f802..00000000000 --- a/libs/wire-api/test/golden/testObject_NewPasswordReset_user_8.json +++ /dev/null @@ -1,3 +0,0 @@ -{ - "email": "(a蕎'CKj\u001b\u0019􀮎@?󰹶D𠾪󷎑7􆯮eh䧖gS􊉜}􆋉n_" -} diff --git a/libs/wire-api/test/golden/testObject_NewPasswordReset_user_9.json b/libs/wire-api/test/golden/testObject_NewPasswordReset_user_9.json deleted file mode 100644 index 43051dc8735..00000000000 --- a/libs/wire-api/test/golden/testObject_NewPasswordReset_user_9.json +++ /dev/null @@ -1,3 +0,0 @@ -{ - "email": "\u0003ji\u0008\u0007󲾆󴙔𝝘'ᾧk\u001e+@\u001c:\u0003\u000c􅡌5塋t𡀠>𪮉IE􄋇M\u0012g\u001aAO𦵕3\"󴕰H푅c🡹꾿6" -} diff --git a/libs/wire-api/test/golden/testObject_NewUserPublic_user_1.json b/libs/wire-api/test/golden/testObject_NewUserPublic_user_1.json index 9f90a680a18..a22cdbd6852 100644 --- a/libs/wire-api/test/golden/testObject_NewUserPublic_user_1.json +++ b/libs/wire-api/test/golden/testObject_NewUserPublic_user_1.json @@ -16,14 +16,13 @@ "type": "image" } ], + "email": "test@example.com", "email_code": "cfTQLlhl6H6sYloQXsghILggxWoGhM2WGbxjzm0=", "label": ">>Mp१𤘇9:󺰽􋼒\u0010D1j󾮢􂊠;􄆇󳸪f#]", "locale": "so", "managed_by": "wire", "name": "\\sY4]u󼛸\u0010󺲻\u001c\u0003 \u001f\u0017􄚐dw;}􆃪@𭂿\r8", "password": "dX󹊒赲󶻎ht𘙏󴰏\u0007>\u0018\u000bO95\u0015\n(𩝙󻞌嶝f]_𪀮\u00002FQbNS=6g󿷼P𢲾􃨫󰧽􅤹M\u001e7\u0016~\u0017m󽎭\u0006\u0001\u000bkgmBp\u0017w悬𩓯f󹼮%Q\u0004𢔶kP|G𥬅\u0017B-\nJWH(8)4$󱠶<7𭨖\u001cI\u0008A\u0010\r?󹀊\u0008\u00085\u0006󶟨d \u00166􍉶G\u0018\u0008\t=qG􃁰 D\u0002vV\tYpg󸋮吝q\n \u0017L􁼛-􏕋\u0013󺃝F7Q􊔜]揃i?\r\u0010\u001b{=􎕻_?e􇢹%\u000eR󱆼\u001b+\u000ef\u0017q:g\\Rk馍𪝞[l\u0015􉜀VK\njwp\u00043TJྏEj\u0002R7d83ON\u0017q獿\u0019𮣜N8\n\u000f󻦼u:GꓻFZ\u001c<\u0015揤7􉖬tH󿳸;hbS{ꮯ\u001csMs󲷒9B4􀷾35c(~CUc󸇪\\V_XD3䎆᳦\u0005-􃭧𘨛7W@)!$%v{\u000c\n_I6􉱮츜]r􍶔\u0002Gi_L\u0005@tr<讃2Dr䂇\\\u000b8쁽\u0014􅈿e\u0008𮞲𑚜srN蜨旗Qk+赥󳼩O\\c6󼉭X󺩽􆓖VV\\󴀯^􍺔\u0014(P~y\u000f(\nrO󽖎U=$󽩻k󷀘7.\u0015[dn􃊾粷_\u0000󳞑\u000bNVd햲z󻓕pV6\u001e𨭗#/m􄊮w\u0015沐u𣎯\u000fs\u0011𡔱^A𗔌>\u001a#\u0019sC!3#`𧂅q𐅄\\VrnT\u0010\u0016􂹙\u0014\u0002𦍺󵅅\u0012d 󻆃#\u0018𫺦/k㤣X\"I\u000fO,`GU+\u0011\"\n럲n)\u001b􂰕x󸨾􋽯%\u0012\u000fVr\u000c󾾡H`🚇W\u001c\u0015􀛞vii\u001c\u0007\u0005󵙼&d\u001d𣶇󲅊.􊈄j󶈟$=a_s\u0010Q󹇪\u000e\u000c\u0003󸽌B\u0005\u0018L\u0002_ZX\u0015 h_sGj)󿬂|\u0000\u000f\rlUN)\u0006\u0011`8\u000c󸫲󳼍\u0008,A\u0011\tt/0lT􅪡\u0007}\u0016j\u000f\u0007z|\u0005𥕰J,26󹰅\u00039⮫0\u0019w'\u0000O&g\u001fF0󴞭kg\u0002\u0011|Q􀁨\u001aM𠌸󽣾vuPgVp𬆇)/䎆᳦\u0005-􃭧𘨛7W@)!$%v{\u000c\n_I6􉱮츜]r􍶔\u0002Gi_L\u0005@tr<讃2Dr䂇\\\u000b8쁽\u0014􅈿e\u0008𮞲𑚜srN蜨旗Qk+赥󳼩O\\c6󼉭X󺩽􆓖VV\\󴀯^􍺔\u0014(P~y\u000f(\nrO󽖎U=$󽩻k󷀘7.\u0015[dn􃊾粷_\u0000󳞑\u000bNVd햲z󻓕pV6\u001e𨭗#/m􄊮w\u0015沐u𣎯\u000fs\u0011𡔱^A𗔌>\u001a#\u0019sC!3#`𧂅q𐅄\\VrnT\u0010\u0016􂹙\u0014\u0002𦍺󵅅\u0012d 󻆃#\u0018𫺦/k㤣X\"I\u000fO,`GU+\u0011\"\n럲n)\u001b􂰕x󸨾􋽯%\u0012\u000fVr\u000c󾾡H`🚇W\u001c\u0015􀛞vii\u001c\u0007\u0005󵙼&d\u001d𣶇󲅊.􊈄j󶈟$=a_s\u0010Q󹇪\u000e\u000c\u0003󸽌B\u0005\u0018L\u0002_ZX\u0015 h_sGj)󿬂|\u0000\u000f\rlUN)\u0006\u0011`8\u000c󸫲󳼍\u0008,A\u0011\tt/0lT􅪡\u0007}\u0016j\u000f\u0007z|\u0005𥕰J,26󹰅\u00039⮫0\u0019w'\u0000O&g\u001fF0󴞭kg\u0002\u0011|Q􀁨\u001aM𠌸󽣾vuPgVp𬆇)/f<7\u000eq|6\u0011\u0019󳟧􁗄\u001bf󷯶𩣇\u0013bnVAj`^L\u000c󿮁\u001fLI\u0005!􃈈\u0017`󾒁\u0003e曉\u001aK|", - "phone": "+837934954", "picture": [], "qualified_id": { "domain": "28b.cqb", diff --git a/libs/wire-api/test/unit/Test/Wire/API/User.hs b/libs/wire-api/test/unit/Test/Wire/API/User.hs index d8f9a115376..2a5fa7d31e1 100644 --- a/libs/wire-api/test/unit/Test/Wire/API/User.hs +++ b/libs/wire-api/test/unit/Test/Wire/API/User.hs @@ -129,19 +129,13 @@ parseIdentityTests = (=#=) _ bad = error $ "=#=: impossible: " <> show bad in testGroup "parseIdentity" - [ testCase "FullIdentity" $ - Right (Just (FullIdentity hemail hphone)) =#= [email, phone], - testCase "EmailIdentity" $ + [ testCase "EmailIdentity" $ Right (Just (EmailIdentity hemail)) =#= [email], - testCase "PhoneIdentity" $ - Right (Just (PhoneIdentity hphone)) =#= [phone], testCase "SSOIdentity" $ do - Right (Just (SSOIdentity hssoid Nothing Nothing)) =#= [ssoid] - Right (Just (SSOIdentity hssoid Nothing (Just hphone))) =#= [ssoid, phone] - Right (Just (SSOIdentity hssoid (Just hemail) Nothing)) =#= [ssoid, email] - Right (Just (SSOIdentity hssoid (Just hemail) (Just hphone))) =#= [ssoid, email, phone], - testCase "Bad phone" $ - Left "Error in $.phone: Invalid phone number. Expected E.164 format." =#= [badphone], + Right (Just (SSOIdentity hssoid Nothing)) =#= [ssoid] + Right (Just (SSOIdentity hssoid (Just hemail))) =#= [ssoid, email], + testCase "Phone not part of identity any more" $ + Right Nothing =#= [badphone], testCase "Bad email" $ Left "Error in $.email: Invalid email. Expected '@'." =#= [bademail], testCase "Nothing" $ @@ -151,8 +145,6 @@ parseIdentityTests = hemail = Email "me" "example.com" email = ("email", "me@example.com") bademail = ("email", "justme") - hphone = Phone "+493012345678" - phone = ("phone", "+493012345678") badphone = ("phone", "__@@") hssoid = UserSSOId mkSimpleSampleUref ssoid = ("sso_id", toJSON hssoid) diff --git a/libs/wire-subsystems/src/Wire/AuthenticationSubsystem.hs b/libs/wire-subsystems/src/Wire/AuthenticationSubsystem.hs index 415982b984c..9b669979bd8 100644 --- a/libs/wire-subsystems/src/Wire/AuthenticationSubsystem.hs +++ b/libs/wire-subsystems/src/Wire/AuthenticationSubsystem.hs @@ -26,9 +26,9 @@ import Wire.API.User.Password import Wire.UserKeyStore data AuthenticationSubsystem m a where - CreatePasswordResetCode :: UserKey -> AuthenticationSubsystem m () + CreatePasswordResetCode :: EmailKey -> AuthenticationSubsystem m () ResetPassword :: PasswordResetIdentity -> PasswordResetCode -> PlainTextPassword8 -> AuthenticationSubsystem m () -- For testing - InternalLookupPasswordResetCode :: UserKey -> AuthenticationSubsystem m (Maybe PasswordResetPair) + InternalLookupPasswordResetCode :: EmailKey -> AuthenticationSubsystem m (Maybe PasswordResetPair) makeSem ''AuthenticationSubsystem diff --git a/libs/wire-subsystems/src/Wire/AuthenticationSubsystem/Error.hs b/libs/wire-subsystems/src/Wire/AuthenticationSubsystem/Error.hs index 455f1563a44..28532db6c1c 100644 --- a/libs/wire-subsystems/src/Wire/AuthenticationSubsystem/Error.hs +++ b/libs/wire-subsystems/src/Wire/AuthenticationSubsystem/Error.hs @@ -29,6 +29,8 @@ data AuthenticationSubsystemError = AuthenticationSubsystemInvalidPasswordResetKey | AuthenticationSubsystemResetPasswordMustDiffer | AuthenticationSubsystemInvalidPasswordResetCode + | AuthenticationSubsystemInvalidPhone + | AuthenticationSubsystemAllowListError deriving (Eq, Show) instance Exception AuthenticationSubsystemError @@ -39,3 +41,5 @@ authenticationSubsystemErrorToWai = AuthenticationSubsystemInvalidPasswordResetKey -> dynError @(MapError E.InvalidPasswordResetKey) AuthenticationSubsystemInvalidPasswordResetCode -> dynError @(MapError E.InvalidPasswordResetCode) AuthenticationSubsystemResetPasswordMustDiffer -> dynError @(MapError E.ResetPasswordMustDiffer) + AuthenticationSubsystemInvalidPhone -> dynError @(MapError E.InvalidPhone) + AuthenticationSubsystemAllowListError -> dynError @(MapError E.AllowlistError) diff --git a/libs/wire-subsystems/src/Wire/AuthenticationSubsystem/Interpreter.hs b/libs/wire-subsystems/src/Wire/AuthenticationSubsystem/Interpreter.hs index dd2489ccd4a..b0e5f2429fa 100644 --- a/libs/wire-subsystems/src/Wire/AuthenticationSubsystem/Interpreter.hs +++ b/libs/wire-subsystems/src/Wire/AuthenticationSubsystem/Interpreter.hs @@ -34,7 +34,7 @@ import Polysemy.Input import Polysemy.TinyLog (TinyLog) import Polysemy.TinyLog qualified as Log import System.Logger -import Wire.API.Allowlists (AllowlistEmailDomains, AllowlistPhonePrefixes) +import Wire.API.Allowlists (AllowlistEmailDomains) import Wire.API.Allowlists qualified as AllowLists import Wire.API.Password import Wire.API.User @@ -61,7 +61,6 @@ interpretAuthenticationSubsystem :: Member SessionStore r, Member (Input (Local ())) r, Member (Input (Maybe AllowlistEmailDomains)) r, - Member (Input (Maybe AllowlistPhonePrefixes)) r, Member UserSubsystem r, Member PasswordStore r, Member EmailSmsSubsystem r @@ -96,16 +95,15 @@ createPasswordResetCodeImpl :: Member Now r, Member (Input (Local ())) r, Member (Input (Maybe AllowlistEmailDomains)) r, - Member (Input (Maybe AllowlistPhonePrefixes)) r, Member TinyLog r, Member UserSubsystem r, Member EmailSmsSubsystem r ) => - UserKey -> + EmailKey -> Sem r () createPasswordResetCodeImpl target = logPasswordResetError =<< runError do - allowListOk <- (\e p -> AllowLists.verify e p (toEither target)) <$> input <*> input + allowListOk <- (\e -> AllowLists.verify e (emailKeyOrig target)) <$> input unless allowListOk $ throw AllowListError user <- lookupActiveUserByUserKey target >>= maybe (throw InvalidResetKey) pure let uid = userId user @@ -117,15 +115,12 @@ createPasswordResetCodeImpl target = let key = mkPasswordResetKey uid now <- Now.get - code <- foldKey (const generateEmailCode) (const generatePhoneCode) target + code <- generateEmailCode codeInsert key (PRQueryData code uid (Identity maxAttempts) (Identity (passwordResetCodeTtl `addUTCTime` now))) (round passwordResetCodeTtl) - foldKey - (\email -> sendPasswordResetMail email (key, code) (Just user.userLocale)) - (\phone -> sendPasswordResetSms phone (key, code) (Just user.userLocale)) - target + sendPasswordResetMail (emailKeyOrig target) (key, code) (Just user.userLocale) pure () where -- `PasswordResetError` are errors that we don't want to leak to the caller. @@ -138,10 +133,17 @@ createPasswordResetCodeImpl target = . field "error" (displayException e) Right v -> pure v -lookupActiveUserIdByUserKey :: (Member UserSubsystem r, Member (Input (Local ())) r) => UserKey -> Sem r (Maybe UserId) -lookupActiveUserIdByUserKey target = userId <$$> lookupActiveUserByUserKey target - -lookupActiveUserByUserKey :: (Member UserSubsystem r, Member (Input (Local ())) r) => UserKey -> Sem r (Maybe User) +lookupActiveUserIdByUserKey :: + (Member UserSubsystem r, Member (Input (Local ())) r) => + EmailKey -> + Sem r (Maybe UserId) +lookupActiveUserIdByUserKey target = + userId <$$> lookupActiveUserByUserKey target + +lookupActiveUserByUserKey :: + (Member UserSubsystem r, Member (Input (Local ())) r) => + EmailKey -> + Sem r (Maybe User) lookupActiveUserByUserKey target = do localUnit <- input let ltarget = qualifyAs localUnit target @@ -160,7 +162,7 @@ internalLookupPasswordResetCodeImpl :: Member (Input (Local ())) r, Member UserSubsystem r ) => - UserKey -> + EmailKey -> Sem r (Maybe PasswordResetPair) internalLookupPasswordResetCodeImpl key = do mUser <- lookupActiveUserIdByUserKey key @@ -219,13 +221,11 @@ resetPasswordImpl ident code pw = do passwordResetKeyFromIdentity = case ident of PasswordResetIdentityKey k -> pure k PasswordResetEmailIdentity e -> do - mUserId <- lookupActiveUserIdByUserKey (userEmailKey e) - let mResetKey = mkPasswordResetKey <$> mUserId - maybe (throw AuthenticationSubsystemInvalidPasswordResetKey) pure mResetKey - PasswordResetPhoneIdentity p -> do - mUserId <- lookupActiveUserIdByUserKey (userPhoneKey p) + mUserId <- lookupActiveUserIdByUserKey (mkEmailKey e) let mResetKey = mkPasswordResetKey <$> mUserId maybe (throw AuthenticationSubsystemInvalidPasswordResetKey) pure mResetKey + PasswordResetPhoneIdentity _ -> do + throw AuthenticationSubsystemInvalidPhone checkNewIsDifferent :: UserId -> PlainTextPassword' t -> Sem r () checkNewIsDifferent uid newPassword = do diff --git a/libs/wire-subsystems/src/Wire/EmailSmsSubsystem.hs b/libs/wire-subsystems/src/Wire/EmailSmsSubsystem.hs index 6ec9a7c3ca9..82d767badfc 100644 --- a/libs/wire-subsystems/src/Wire/EmailSmsSubsystem.hs +++ b/libs/wire-subsystems/src/Wire/EmailSmsSubsystem.hs @@ -12,7 +12,6 @@ import Wire.API.User.Client (Client (..)) data EmailSmsSubsystem m a where SendPasswordResetMail :: Email -> PasswordResetPair -> Maybe Locale -> EmailSmsSubsystem m () - SendPasswordResetSms :: Phone -> PasswordResetPair -> Maybe Locale -> EmailSmsSubsystem m () SendVerificationMail :: Email -> ActivationKey -> ActivationCode -> Maybe Locale -> EmailSmsSubsystem m () SendCreateScimTokenVerificationMail :: Email -> Code.Value -> Maybe Locale -> EmailSmsSubsystem m () SendLoginVerificationMail :: Email -> Code.Value -> Maybe Locale -> EmailSmsSubsystem m () diff --git a/libs/wire-subsystems/src/Wire/EmailSmsSubsystem/Interpreter.hs b/libs/wire-subsystems/src/Wire/EmailSmsSubsystem/Interpreter.hs index ec891d2a6cc..cbde4f6bb98 100644 --- a/libs/wire-subsystems/src/Wire/EmailSmsSubsystem/Interpreter.hs +++ b/libs/wire-subsystems/src/Wire/EmailSmsSubsystem/Interpreter.hs @@ -1,6 +1,10 @@ {-# LANGUAGE RecordWildCards #-} -module Wire.EmailSmsSubsystem.Interpreter where +module Wire.EmailSmsSubsystem.Interpreter + ( emailSmsSubsystemInterpreter, + mkMimeAddress, + ) +where import Data.Code qualified as Code import Data.Json.Util @@ -17,8 +21,22 @@ import Wire.API.User.Activation import Wire.API.User.Client (Client (..)) import Wire.API.User.Password import Wire.EmailSending (EmailSending, sendMail) +import Wire.EmailSmsSubsystem import Wire.EmailSmsSubsystem.Template +emailSmsSubsystemInterpreter :: (Member EmailSending r) => Localised UserTemplates -> TemplateBranding -> InterpreterFor EmailSmsSubsystem r +emailSmsSubsystemInterpreter tpls branding = interpret \case + SendPasswordResetMail email (key, code) mLocale -> sendPasswordResetMailImpl tpls branding email key code mLocale + SendVerificationMail email key code mLocale -> sendVerificationMailImpl tpls branding email key code mLocale + SendTeamDeletionVerificationMail email code mLocale -> sendTeamDeletionVerificationMailImpl tpls branding email code mLocale + SendCreateScimTokenVerificationMail email code mLocale -> sendCreateScimTokenVerificationMailImpl tpls branding email code mLocale + SendLoginVerificationMail email code mLocale -> sendLoginVerificationMailImpl tpls branding email code mLocale + SendActivationMail email name key code mLocale -> sendActivationMailImpl tpls branding email name key code mLocale + SendEmailAddressUpdateMail email name key code mLocale -> sendEmailAddressUpdateMailImpl tpls branding email name key code mLocale + SendTeamActivationMail email name key code mLocale teamName -> sendTeamActivationMailImpl tpls branding email name key code mLocale teamName + SendNewClientEmail email name client locale -> sendNewClientEmailImpl tpls branding email name client locale + SendAccountDeletionEmail email name key code locale -> sendAccountDeletionEmailImpl tpls branding email name key code locale + ------------------------------------------------------------------------------- -- Verification Email for -- - Login diff --git a/libs/wire-subsystems/src/Wire/StoredUser.hs b/libs/wire-subsystems/src/Wire/StoredUser.hs index 31a2373f6b3..b2ace0784cb 100644 --- a/libs/wire-subsystems/src/Wire/StoredUser.hs +++ b/libs/wire-subsystems/src/Wire/StoredUser.hs @@ -115,18 +115,15 @@ toIdentity :: -- | Whether the user is activated Bool -> Maybe Email -> - Maybe Phone -> Maybe UserSSOId -> Maybe UserIdentity -toIdentity True (Just e) (Just p) Nothing = Just $! FullIdentity e p -toIdentity True (Just e) Nothing Nothing = Just $! EmailIdentity e -toIdentity True Nothing (Just p) Nothing = Just $! PhoneIdentity p -toIdentity True email phone (Just ssoid) = Just $! SSOIdentity ssoid email phone -toIdentity True Nothing Nothing Nothing = Nothing -toIdentity False _ _ _ = Nothing +toIdentity True (Just e) Nothing = Just $! EmailIdentity e +toIdentity True email (Just ssoid) = Just $! SSOIdentity ssoid email +toIdentity True Nothing Nothing = Nothing +toIdentity False _ _ = Nothing instance HasField "identity" StoredUser (Maybe UserIdentity) where - getField user = toIdentity user.activated user.email user.phone user.ssoId + getField user = toIdentity user.activated user.email user.ssoId instance HasField "locale" StoredUser (Maybe Locale) where getField user = Locale <$> user.language <*> pure user.country diff --git a/libs/wire-subsystems/src/Wire/UserKeyStore.hs b/libs/wire-subsystems/src/Wire/UserKeyStore.hs index 4bcc6807a5c..5683c25b763 100644 --- a/libs/wire-subsystems/src/Wire/UserKeyStore.hs +++ b/libs/wire-subsystems/src/Wire/UserKeyStore.hs @@ -8,24 +8,6 @@ import Imports import Polysemy import Test.QuickCheck import Wire.API.User -import Wire.Arbitrary - -data PhoneKey = PhoneKey - { -- | canonical form of 'phoneKeyOrig', without whitespace. - phoneKeyUniq :: !Text, - -- | phone number with whitespace. - phoneKeyOrig :: !Phone - } - deriving (Ord) - -instance Show PhoneKey where - showsPrec _ = shows . phoneKeyUniq - -instance Eq PhoneKey where - (PhoneKey k _) == (PhoneKey k' _) = k == k' - -instance Arbitrary PhoneKey where - arbitrary = mkPhoneKey <$> arbitrary -- | An 'EmailKey' is an 'Email' in a form that serves as a unique lookup key. data EmailKey = EmailKey @@ -43,19 +25,6 @@ instance Eq EmailKey where instance Arbitrary EmailKey where arbitrary = mkEmailKey <$> arbitrary --- | A natural identifier (i.e. unique key) of a user. -data UserKey - = UserEmailKey !EmailKey - | UserPhoneKey !PhoneKey - deriving stock (Eq, Show, Ord, Generic) - deriving (Arbitrary) via (GenericUniform UserKey) - -userEmailKey :: Email -> UserKey -userEmailKey = UserEmailKey . mkEmailKey - -userPhoneKey :: Phone -> UserKey -userPhoneKey = UserPhoneKey . mkPhoneKey - -- | Turn an 'Email' into an 'EmailKey'. -- -- The following transformations are performed: @@ -74,45 +43,12 @@ mkEmailKey orig@(Email localPart domain) = | otherwise = localPart trusted = ["wearezeta.com", "wire.com", "simulator.amazonses.com"] -mkPhoneKey :: Phone -> PhoneKey -mkPhoneKey orig = - let uniq = Text.filter (not . isSpace) (fromPhone orig) - in PhoneKey uniq orig - --- | Get the normalised text of a 'UserKey'. -keyText :: UserKey -> Text -keyText (UserEmailKey k) = emailKeyUniq k -keyText (UserPhoneKey k) = phoneKeyUniq k - --- | Get the original text of a 'UserKey', i.e. the original phone number --- or email address. -keyTextOriginal :: UserKey -> Text -keyTextOriginal (UserEmailKey k) = fromEmail (emailKeyOrig k) -keyTextOriginal (UserPhoneKey k) = fromPhone (phoneKeyOrig k) - -foldKey :: (Email -> a) -> (Phone -> a) -> UserKey -> a -foldKey f g k = case k of - UserEmailKey ek -> f (emailKeyOrig ek) - UserPhoneKey pk -> g (phoneKeyOrig pk) - -forEmailKey :: (Applicative f) => UserKey -> (Email -> f a) -> f (Maybe a) -forEmailKey k f = foldKey (fmap Just . f) (const (pure Nothing)) k - -forPhoneKey :: (Applicative f) => UserKey -> (Phone -> f a) -> f (Maybe a) -forPhoneKey k f = foldKey (const (pure Nothing)) (fmap Just . f) k - -fromEither :: Either Email Phone -> UserKey -fromEither = either userEmailKey userPhoneKey - -toEither :: UserKey -> Either Email Phone -toEither = foldKey Left Right - data UserKeyStore m a where - LookupKey :: UserKey -> UserKeyStore m (Maybe UserId) - InsertKey :: UserId -> UserKey -> UserKeyStore m () - DeleteKey :: UserKey -> UserKeyStore m () - DeleteKeyForUser :: UserId -> UserKey -> UserKeyStore m () - KeyAvailable :: UserKey -> Maybe UserId -> UserKeyStore m Bool - ClaimKey :: UserKey -> UserId -> UserKeyStore m Bool + LookupKey :: EmailKey -> UserKeyStore m (Maybe UserId) + InsertKey :: UserId -> EmailKey -> UserKeyStore m () + DeleteKey :: EmailKey -> UserKeyStore m () + DeleteKeyForUser :: UserId -> EmailKey -> UserKeyStore m () + KeyAvailable :: EmailKey -> Maybe UserId -> UserKeyStore m Bool + ClaimKey :: EmailKey -> UserId -> UserKeyStore m Bool makeSem ''UserKeyStore diff --git a/libs/wire-subsystems/src/Wire/UserKeyStore/Cassandra.hs b/libs/wire-subsystems/src/Wire/UserKeyStore/Cassandra.hs index 06a84340df5..a7e65a99ff4 100644 --- a/libs/wire-subsystems/src/Wire/UserKeyStore/Cassandra.hs +++ b/libs/wire-subsystems/src/Wire/UserKeyStore/Cassandra.hs @@ -19,12 +19,12 @@ interpretUserKeyStoreCassandra casClient = ClaimKey key uid -> claimKeyImpl casClient key uid KeyAvailable key uid -> keyAvailableImpl casClient key uid --- | Claim a 'UserKey' for a user. +-- | Claim an 'EmailKey' for a user. claimKeyImpl :: (Member (Embed IO) r, Member UserStore r) => ClientState -> -- | The key to claim. - UserKey -> + EmailKey -> -- | The user claiming the key. UserId -> Sem r Bool @@ -33,14 +33,14 @@ claimKeyImpl client k u = do when free (runClient client $ insertKeyImpl u k) pure free --- | Check whether a 'UserKey' is available. +-- | Check whether an 'EmailKey' is available. -- A key is available if it is not already activated for another user or -- if the other user and the user looking to claim the key are the same. keyAvailableImpl :: (Member (Embed IO) r, Member UserStore r) => ClientState -> -- | The key to check. - UserKey -> + EmailKey -> -- | The user looking to claim the key, if any. Maybe UserId -> Sem r Bool @@ -51,20 +51,20 @@ keyAvailableImpl client k u = do (Just x, Just y) | x == y -> pure True (Just x, _) -> not <$> isActivated x -lookupKeyImpl :: (MonadClient m) => UserKey -> m (Maybe UserId) +lookupKeyImpl :: (MonadClient m) => EmailKey -> m (Maybe UserId) lookupKeyImpl k = fmap runIdentity - <$> retry x1 (query1 keySelect (params LocalQuorum (Identity $ keyText k))) + <$> retry x1 (query1 keySelect (params LocalQuorum (Identity $ emailKeyUniq k))) -insertKeyImpl :: UserId -> UserKey -> Client () +insertKeyImpl :: UserId -> EmailKey -> Client () insertKeyImpl u k = do - retry x5 $ write keyInsert (params LocalQuorum (keyText k, u)) + retry x5 $ write keyInsert (params LocalQuorum (emailKeyUniq k, u)) -deleteKeyImpl :: (MonadClient m) => UserKey -> m () +deleteKeyImpl :: (MonadClient m) => EmailKey -> m () deleteKeyImpl k = do - retry x5 $ write keyDelete (params LocalQuorum (Identity $ keyText k)) + retry x5 $ write keyDelete (params LocalQuorum (Identity $ emailKeyUniq k)) --- | Delete `UserKey` for `UserId` +-- | Delete `EmailKey` for `UserId` -- -- This function ensures that keys of other users aren't accidentally deleted. -- E.g. the email address or phone number of a partially deleted user could @@ -72,7 +72,7 @@ deleteKeyImpl k = do -- executed several times due to cassandra not supporting transactions) -- `deleteKeyImplForUser` does not fail for missing keys or keys that belong to -- another user: It always returns `()` as result. -deleteKeyForUserImpl :: (MonadClient m) => UserId -> UserKey -> m () +deleteKeyForUserImpl :: (MonadClient m) => UserId -> EmailKey -> m () deleteKeyForUserImpl uid k = do mbKeyUid <- lookupKeyImpl k case mbKeyUid of diff --git a/libs/wire-subsystems/src/Wire/UserSubsystem.hs b/libs/wire-subsystems/src/Wire/UserSubsystem.hs index 186dc05985c..52140de5db8 100644 --- a/libs/wire-subsystems/src/Wire/UserSubsystem.hs +++ b/libs/wire-subsystems/src/Wire/UserSubsystem.hs @@ -98,7 +98,7 @@ data UserSubsystem m a where CheckHandles :: [Handle] -> Word -> UserSubsystem m [Handle] -- | parses a handle, this may fail so it's effectful UpdateHandle :: Local UserId -> Maybe ConnId -> UpdateOriginType -> Text {- use Handle here? -} -> UserSubsystem m () - GetLocalUserAccountByUserKey :: Local UserKey -> UserSubsystem m (Maybe UserAccount) + GetLocalUserAccountByUserKey :: Local EmailKey -> UserSubsystem m (Maybe UserAccount) -- | returns the user's locale or the default locale if the users exists LookupLocaleWithDefault :: Local UserId -> UserSubsystem m (Maybe Locale) diff --git a/libs/wire-subsystems/src/Wire/UserSubsystem/Interpreter.hs b/libs/wire-subsystems/src/Wire/UserSubsystem/Interpreter.hs index 6146125ce4b..1e5ed37182b 100644 --- a/libs/wire-subsystems/src/Wire/UserSubsystem/Interpreter.hs +++ b/libs/wire-subsystems/src/Wire/UserSubsystem/Interpreter.hs @@ -398,7 +398,13 @@ mkProfileUpdateHandleEvent :: UserId -> Handle -> UserEvent mkProfileUpdateHandleEvent uid handle = UserUpdated $ (emptyUserUpdatedData uid) {eupHandle = Just handle} -getLocalUserAccountByUserKeyImpl :: (Member UserStore r, Member UserKeyStore r, Member (Input UserSubsystemConfig) r) => Local UserKey -> Sem r (Maybe UserAccount) +getLocalUserAccountByUserKeyImpl :: + ( Member UserStore r, + Member UserKeyStore r, + Member (Input UserSubsystemConfig) r + ) => + Local EmailKey -> + Sem r (Maybe UserAccount) getLocalUserAccountByUserKeyImpl target = runMaybeT $ do config <- lift input uid <- MaybeT $ lookupKey (tUnqualified target) diff --git a/libs/wire-subsystems/test/unit/Wire/AuthenticationSubsystem/InterpreterSpec.hs b/libs/wire-subsystems/test/unit/Wire/AuthenticationSubsystem/InterpreterSpec.hs index 3ffe1732d9e..9a12b831420 100644 --- a/libs/wire-subsystems/test/unit/Wire/AuthenticationSubsystem/InterpreterSpec.hs +++ b/libs/wire-subsystems/test/unit/Wire/AuthenticationSubsystem/InterpreterSpec.hs @@ -16,7 +16,7 @@ import Polysemy.TinyLog import Test.Hspec import Test.Hspec.QuickCheck import Test.QuickCheck -import Wire.API.Allowlists (AllowlistEmailDomains (AllowlistEmailDomains), AllowlistPhonePrefixes) +import Wire.API.Allowlists (AllowlistEmailDomains (AllowlistEmailDomains)) import Wire.API.Password import Wire.API.User import Wire.API.User qualified as User @@ -42,7 +42,6 @@ type AllEffects = State UTCTime, Input (Local ()), Input (Maybe AllowlistEmailDomains), - Input (Maybe AllowlistPhonePrefixes), SessionStore, State (Map UserId [Cookie ()]), PasswordStore, @@ -68,7 +67,6 @@ interpretDependencies localDomain preexistingUsers preexistingPasswords mAllowed . inMemoryPasswordStoreInterpreter . evalState mempty . inMemorySessionStoreInterpreter - . runInputConst Nothing . runInputConst (AllowlistEmailDomains <$> mAllowedEmailDomains) . runInputConst (toLocalUnsafe localDomain ()) . evalState defaultTime @@ -94,7 +92,7 @@ spec = describe "AuthenticationSubsystem.Interpreter" do forM_ mPreviousPassword (hashPassword >=> upsertHashedPassword uid) mapM_ (uncurry (insertCookie uid)) cookiesWithTTL - createPasswordResetCode (userEmailKey email) + createPasswordResetCode (mkEmailKey email) (_, code) <- expect1ResetPasswordEmail email resetPassword (PasswordResetEmailIdentity email) code newPassword @@ -115,7 +113,7 @@ spec = describe "AuthenticationSubsystem.Interpreter" do forM_ mPreviousPassword (hashPassword >=> upsertHashedPassword uid) mapM_ (uncurry (insertCookie uid)) cookiesWithTTL - createPasswordResetCode (userEmailKey email) + createPasswordResetCode (mkEmailKey email) (passwordResetKey, code) <- expect1ResetPasswordEmail email resetPassword (PasswordResetIdentityKey passwordResetKey) code newPassword @@ -129,7 +127,7 @@ spec = describe "AuthenticationSubsystem.Interpreter" do let createPasswordResetCodeResult = interpretDependencies localDomain [] mempty (Just ["example.com"]) . interpretAuthenticationSubsystem - $ createPasswordResetCode (userEmailKey email) + $ createPasswordResetCode (mkEmailKey email) <* expectNoEmailSent in emailDomain email /= "example.com" ==> createPasswordResetCodeResult === Right () @@ -141,7 +139,7 @@ spec = describe "AuthenticationSubsystem.Interpreter" do createPasswordResetCodeResult = interpretDependencies localDomain [UserAccount user Active] mempty (Just [emailDomain email]) . interpretAuthenticationSubsystem - $ createPasswordResetCode (userEmailKey email) + $ createPasswordResetCode (mkEmailKey email) in counterexample ("expected Right, got: " <> show createPasswordResetCodeResult) $ isRight createPasswordResetCodeResult @@ -152,7 +150,7 @@ spec = describe "AuthenticationSubsystem.Interpreter" do createPasswordResetCodeResult = interpretDependencies localDomain [UserAccount user status] mempty Nothing . interpretAuthenticationSubsystem - $ createPasswordResetCode (userEmailKey email) + $ createPasswordResetCode (mkEmailKey email) <* expectNoEmailSent in status /= Active ==> createPasswordResetCodeResult === Right () @@ -162,7 +160,7 @@ spec = describe "AuthenticationSubsystem.Interpreter" do let createPasswordResetCodeResult = interpretDependencies localDomain [] mempty Nothing . interpretAuthenticationSubsystem - $ createPasswordResetCode (userEmailKey email) + $ createPasswordResetCode (mkEmailKey email) <* expectNoEmailSent in createPasswordResetCodeResult === Right () @@ -175,10 +173,10 @@ spec = describe "AuthenticationSubsystem.Interpreter" do interpretDependencies localDomain [UserAccount user Active] mempty Nothing . interpretAuthenticationSubsystem $ do - createPasswordResetCode (userEmailKey email) + createPasswordResetCode (mkEmailKey email) (_, code) <- expect1ResetPasswordEmail email - mCaughtExc <- catchExpectedError $ createPasswordResetCode (userEmailKey email) + mCaughtExc <- catchExpectedError $ createPasswordResetCode (mkEmailKey email) -- Reset password still works with previously generated reset code resetPassword (PasswordResetEmailIdentity email) code newPassword @@ -197,7 +195,7 @@ spec = describe "AuthenticationSubsystem.Interpreter" do . interpretAuthenticationSubsystem $ do upsertHashedPassword uid =<< hashPassword oldPassword - createPasswordResetCode (userEmailKey email) + createPasswordResetCode (mkEmailKey email) (_, code) <- expect1ResetPasswordEmail email passTime (passwordResetCodeTtl + 1) @@ -248,7 +246,7 @@ spec = describe "AuthenticationSubsystem.Interpreter" do . interpretAuthenticationSubsystem $ do upsertHashedPassword uid =<< hashPassword oldPassword - createPasswordResetCode (userEmailKey email) + createPasswordResetCode (mkEmailKey email) (_, generatedResetCode) <- expect1ResetPasswordEmail email wrongResetErrs <- @@ -281,8 +279,8 @@ spec = describe "AuthenticationSubsystem.Interpreter" do interpretDependencies localDomain [UserAccount user Active] mempty Nothing . interpretAuthenticationSubsystem $ do - void $ createPasswordResetCode (userEmailKey email) - mLookupRes <- internalLookupPasswordResetCode (userEmailKey email) + void $ createPasswordResetCode (mkEmailKey email) + mLookupRes <- internalLookupPasswordResetCode (mkEmailKey email) for_ mLookupRes $ \(_, code) -> resetPassword (PasswordResetEmailIdentity email) code newPassword lookupHashedPassword uid in verifyPasswordProp newPassword passwordHashInDB diff --git a/libs/wire-subsystems/test/unit/Wire/MiniBackend.hs b/libs/wire-subsystems/test/unit/Wire/MiniBackend.hs index 92272fc11ac..35bf68b5782 100644 --- a/libs/wire-subsystems/test/unit/Wire/MiniBackend.hs +++ b/libs/wire-subsystems/test/unit/Wire/MiniBackend.hs @@ -97,7 +97,7 @@ type MiniBackendEffects = UserStore, State [StoredUser], UserKeyStore, - State (Map UserKey UserId), + State (Map EmailKey UserId), DeleteQueue, UserEvents, State [InternalNotification], @@ -116,7 +116,7 @@ data MiniBackend = MkMiniBackend { -- | this is morally the same as the users stored in the actual backend -- invariant: for each key, the user.id and the key are the same users :: [StoredUser], - userKeys :: Map UserKey UserId, + userKeys :: Map EmailKey UserId, passwordResetCodes :: Map PasswordResetKey (PRQueryData Identity) } @@ -356,7 +356,7 @@ interpretMaybeFederationStackState maybeFederationAPIAccess localBackend teamMem . miniGalleyAPIAccess teamMember galleyConfigs . runUserSubsystem cfg -liftUserKeyStoreState :: (Member (State MiniBackend) r) => Sem (State (Map UserKey UserId) : r) a -> Sem r a +liftUserKeyStoreState :: (Member (State MiniBackend) r) => Sem (State (Map EmailKey UserId) : r) a -> Sem r a liftUserKeyStoreState = interpret $ \case Polysemy.State.Get -> gets (.userKeys) Put newUserKeys -> modify $ \b -> b {userKeys = newUserKeys} diff --git a/libs/wire-subsystems/test/unit/Wire/MockInterpreters/UserKeyStore.hs b/libs/wire-subsystems/test/unit/Wire/MockInterpreters/UserKeyStore.hs index 1b7ccb94c01..b03108f83f2 100644 --- a/libs/wire-subsystems/test/unit/Wire/MockInterpreters/UserKeyStore.hs +++ b/libs/wire-subsystems/test/unit/Wire/MockInterpreters/UserKeyStore.hs @@ -8,7 +8,7 @@ import Polysemy.State import Wire.UserKeyStore inMemoryUserKeyStoreInterpreter :: - (Member (State (Map UserKey UserId)) r) => + (Member (State (Map EmailKey UserId)) r) => InterpreterFor UserKeyStore r inMemoryUserKeyStoreInterpreter = interpret $ \case LookupKey key -> do diff --git a/libs/wire-subsystems/test/unit/Wire/MockInterpreters/UserSubsystem.hs b/libs/wire-subsystems/test/unit/Wire/MockInterpreters/UserSubsystem.hs index c24f428e12c..b47bfbd7d25 100644 --- a/libs/wire-subsystems/test/unit/Wire/MockInterpreters/UserSubsystem.hs +++ b/libs/wire-subsystems/test/unit/Wire/MockInterpreters/UserSubsystem.hs @@ -11,6 +11,5 @@ userSubsystemTestInterpreter :: [UserAccount] -> InterpreterFor UserSubsystem r userSubsystemTestInterpreter initialUsers = interpret \case GetLocalUserAccountByUserKey localUserKey -> case (tUnqualified localUserKey) of - UserEmailKey (EmailKey _ email) -> pure $ find (\u -> userEmail u.accountUser == Just email) initialUsers - UserPhoneKey _ -> pure Nothing -- Phone stuff is deprecated and soon to be deleted anyway + EmailKey _ email -> pure $ find (\u -> userEmail u.accountUser == Just email) initialUsers _ -> error $ "userSubsystemTestInterpreter: implement on demand" diff --git a/libs/wire-subsystems/test/unit/Wire/UserStoreSpec.hs b/libs/wire-subsystems/test/unit/Wire/UserStoreSpec.hs index 7a4ca034831..b1cbf972f98 100644 --- a/libs/wire-subsystems/test/unit/Wire/UserStoreSpec.hs +++ b/libs/wire-subsystems/test/unit/Wire/UserStoreSpec.hs @@ -16,7 +16,6 @@ spec = do then user.userIdentity === Nothing else (emailIdentity =<< user.userIdentity) === storedUser.email - .&&. (phoneIdentity =<< user.userIdentity) === storedUser.phone .&&. (ssoIdentity =<< user.userIdentity) === storedUser.ssoId prop "user deleted" $ \domain defaultLocale storedUser -> diff --git a/libs/wire-subsystems/test/unit/Wire/UserSubsystem/InterpreterSpec.hs b/libs/wire-subsystems/test/unit/Wire/UserSubsystem/InterpreterSpec.hs index d038149d065..c1e62bf8cb8 100644 --- a/libs/wire-subsystems/test/unit/Wire/UserSubsystem/InterpreterSpec.hs +++ b/libs/wire-subsystems/test/unit/Wire/UserSubsystem/InterpreterSpec.hs @@ -453,7 +453,7 @@ spec = describe "UserSubsystem.Interpreter" do describe "getLocalUserAccountByUserKey" $ do prop "gets users iff they are indexed by the UserKeyStore" $ - \(config :: UserSubsystemConfig) (localDomain :: Domain) (storedUser :: StoredUser) (userKey :: UserKey) -> + \(config :: UserSubsystemConfig) (localDomain :: Domain) (storedUser :: StoredUser) (userKey :: EmailKey) -> let localBackend = def { users = [storedUser], @@ -480,11 +480,11 @@ spec = describe "UserSubsystem.Interpreter" do . runErrorUnsafe . runErrorUnsafe @UserSubsystemError . interpretNoFederationStack localBackend Nothing def config - $ getLocalUserAccountByUserKey (toLocalUnsafe localDomain (userEmailKey email)) + $ getLocalUserAccountByUserKey (toLocalUnsafe localDomain (mkEmailKey email)) in retrievedUser === Nothing prop "doesn't get users if they are not present in the UserStore but somehow are still indexed in UserKeyStore" $ - \(config :: UserSubsystemConfig) (localDomain :: Domain) (nonExistentUserId :: UserId) (userKey :: UserKey) -> + \(config :: UserSubsystemConfig) (localDomain :: Domain) (nonExistentUserId :: UserId) (userKey :: EmailKey) -> let localBackend = def { users = [], diff --git a/nix/local-haskell-packages.nix b/nix/local-haskell-packages.nix index 89527deeb19..133fcd9afae 100644 --- a/nix/local-haskell-packages.nix +++ b/nix/local-haskell-packages.nix @@ -20,7 +20,6 @@ metrics-core = hself.callPackage ../libs/metrics-core/default.nix { inherit gitignoreSource; }; metrics-wai = hself.callPackage ../libs/metrics-wai/default.nix { inherit gitignoreSource; }; polysemy-wire-zoo = hself.callPackage ../libs/polysemy-wire-zoo/default.nix { inherit gitignoreSource; }; - ropes = hself.callPackage ../libs/ropes/default.nix { inherit gitignoreSource; }; schema-profunctor = hself.callPackage ../libs/schema-profunctor/default.nix { inherit gitignoreSource; }; sodium-crypto-sign = hself.callPackage ../libs/sodium-crypto-sign/default.nix { inherit gitignoreSource; }; ssl-util = hself.callPackage ../libs/ssl-util/default.nix { inherit gitignoreSource; }; diff --git a/services/brig/brig.cabal b/services/brig/brig.cabal index f184c0715e1..661edec16d1 100644 --- a/services/brig/brig.cabal +++ b/services/brig/brig.cabal @@ -116,8 +116,6 @@ library Brig.Data.Types Brig.Data.User Brig.DeleteQueue.Interpreter - Brig.Effects.BlacklistPhonePrefixStore - Brig.Effects.BlacklistPhonePrefixStore.Cassandra Brig.Effects.BlacklistStore Brig.Effects.BlacklistStore.Cassandra Brig.Effects.ConnectionStore @@ -141,7 +139,6 @@ library Brig.IO.Journal Brig.IO.Logging Brig.Options - Brig.Phone Brig.Provider.API Brig.Provider.DB Brig.Provider.Email @@ -205,7 +202,6 @@ library Brig.User.Auth.Cookie Brig.User.Auth.Cookie.Limit Brig.User.EJPD - Brig.User.Phone Brig.User.Search.Index Brig.User.Search.Index.Types Brig.User.Search.SearchIndex @@ -301,7 +297,6 @@ library , raw-strings-qq , resourcet >=1.1 , retry >=0.7 - , ropes >=0.4.20 , safe-exceptions >=0.1 , saml2-web-sso , schema-profunctor diff --git a/services/brig/brig.integration.yaml b/services/brig/brig.integration.yaml index b3837d1c66c..e0c76b082ca 100644 --- a/services/brig/brig.integration.yaml +++ b/services/brig/brig.integration.yaml @@ -158,8 +158,6 @@ optSettings: setVerificationTimeout: 10 setTeamInvitationTimeout: 10 setExpiredUserCleanupTimeout: 1 - setTwilio: test/resources/twilio-credentials.yaml - setNexmo: test/resources/nexmo-credentials.yaml # setStomp: test/resources/stomp-credentials.yaml setUserMaxConnections: 16 setCookieInsecure: true @@ -217,9 +215,6 @@ optSettings: # To only allow specific email address domains to register, uncomment and update the setting below # setAllowlistEmailDomains: # - wire.com - # To only allow specific phone number prefixes to register uncomment and update the settings below - # setAllowlistPhonePrefixes: - # - "+1555555" # needs to be kept in sync with services/nginz/integration-test/resources/oauth/ed25519_public.jwk setOAuthJwkKeyPair: test/resources/oauth/ed25519.jwk setOAuthAuthCodeExpirationTimeSecs: 3 # 3 secs diff --git a/services/brig/default.nix b/services/brig/default.nix index 4ebaeb98fc2..4a2369d7813 100644 --- a/services/brig/default.nix +++ b/services/brig/default.nix @@ -100,7 +100,6 @@ , raw-strings-qq , resourcet , retry -, ropes , safe , safe-exceptions , saml2-web-sso @@ -243,7 +242,6 @@ mkDerivation { raw-strings-qq resourcet retry - ropes safe-exceptions saml2-web-sso schema-profunctor diff --git a/services/brig/src/Brig/API/Auth.hs b/services/brig/src/Brig/API/Auth.hs index 92dc20a9cc3..0a50fa7b698 100644 --- a/services/brig/src/Brig/API/Auth.hs +++ b/services/brig/src/Brig/API/Auth.hs @@ -46,6 +46,8 @@ import Network.Wai.Utilities.Error qualified as Wai import Polysemy import Polysemy.Input (Input) import Polysemy.TinyLog (TinyLog) +import Wire.API.Error +import Wire.API.Error.Brig qualified as E import Wire.API.User import Wire.API.User.Auth hiding (access) import Wire.API.User.Auth.LegalHold @@ -56,7 +58,7 @@ import Wire.GalleyAPIAccess import Wire.NotificationSubsystem import Wire.PasswordStore (PasswordStore) import Wire.Sem.Paging.Cassandra (InternalPaging) -import Wire.UserKeyStore hiding (toEither) +import Wire.UserKeyStore import Wire.UserStore import Wire.UserSubsystem @@ -95,19 +97,10 @@ access mcid t mt = traverse mkUserTokenCookie =<< Auth.renewAccess (List1 t) mt mcid !>> zauthError -sendLoginCode :: - ( Member TinyLog r, - Member UserKeyStore r, - Member PasswordStore r, - Member (Input (Local ())) r, - Member UserSubsystem r - ) => - SendLoginCode -> - Handler r LoginCodeTimeout -sendLoginCode (SendLoginCode phone call force) = do - checkAllowlist (Right phone) - c <- Auth.sendLoginCode phone call force !>> sendLoginCodeError - pure $ LoginCodeTimeout (pendingLoginTimeout c) +sendLoginCode :: SendLoginCode -> Handler r LoginCodeTimeout +sendLoginCode _ = + -- Login by phone is unsupported + throwStd (errorToWai @'E.InvalidPhone) login :: ( Member GalleyAPIAccess r, @@ -210,10 +203,8 @@ ssoLogin l (fromMaybe False -> persist) = do c <- Auth.ssoLogin l typ !>> loginError traverse mkUserTokenCookie c -getLoginCode :: (Member TinyLog r, Member UserKeyStore r) => Phone -> Handler r PendingLoginCode -getLoginCode phone = do - code <- lift $ Auth.lookupLoginCode phone - maybe (throwStd loginCodeNotFound) pure code +getLoginCode :: Phone -> Handler r PendingLoginCode +getLoginCode _ = throwStd loginCodeNotFound reauthenticate :: (Member GalleyAPIAccess r) => UserId -> ReAuthUser -> Handler r () reauthenticate uid body = do diff --git a/services/brig/src/Brig/API/Error.hs b/services/brig/src/Brig/API/Error.hs index dd5717c3b8a..c06300659e7 100644 --- a/services/brig/src/Brig/API/Error.hs +++ b/services/brig/src/Brig/API/Error.hs @@ -18,8 +18,7 @@ module Brig.API.Error where import Brig.API.Types -import Brig.Phone (PhoneException (..)) -import Control.Monad.Error.Class (MonadError (..)) +import Control.Monad.Error.Class import Data.Aeson import Data.Aeson.KeyMap qualified as KeyMap import Data.ByteString.Conversion @@ -68,7 +67,7 @@ connError InvalidTransition {} = StdError (errorToWai @'E.InvalidTransition) connError NotConnected {} = StdError (errorToWai @'E.NotConnected) connError InvalidUser {} = StdError (errorToWai @'E.InvalidUser) connError ConnectNoIdentity {} = StdError (errorToWai @'E.NoIdentity) -connError (ConnectBlacklistedUserKey k) = StdError $ foldKey (const blacklistedEmail) (const (errorToWai @'E.BlacklistedPhone)) k +connError (ConnectBlacklistedUserKey _) = StdError blacklistedEmail connError (ConnectInvalidEmail _ _) = StdError (errorToWai @'E.InvalidEmail) connError ConnectInvalidPhone {} = StdError (errorToWai @'E.InvalidPhone) connError ConnectSameBindingTeamUsers = StdError sameBindingTeamUsers @@ -95,14 +94,10 @@ pwResetError (PasswordResetInProgress (Just t)) = [("Retry-After", toByteString' t)] pwResetError ResetPasswordMustDiffer = StdError (errorToWai @'E.ResetPasswordMustDiffer) -sendLoginCodeError :: SendLoginCodeError -> Error -sendLoginCodeError (SendLoginInvalidPhone _) = StdError (errorToWai @'E.InvalidPhone) -sendLoginCodeError SendLoginPasswordExists = StdError (errorToWai @'E.PasswordExists) - sendActCodeError :: SendActivationCodeError -> Error -sendActCodeError (InvalidRecipient k) = StdError $ foldKey (const (errorToWai @'E.InvalidEmail)) (const (errorToWai @'E.InvalidPhone)) k +sendActCodeError (InvalidRecipient _) = StdError $ errorToWai @'E.InvalidEmail sendActCodeError (UserKeyInUse _) = StdError (errorToWai @'E.UserKeyExists) -sendActCodeError (ActivationBlacklistedUserKey k) = StdError $ foldKey (const blacklistedEmail) (const (errorToWai @'E.BlacklistedPhone)) k +sendActCodeError (ActivationBlacklistedUserKey _) = StdError blacklistedEmail changeEmailError :: ChangeEmailError -> Error changeEmailError (InvalidNewEmail _ _) = StdError (errorToWai @'E.InvalidEmail) @@ -263,11 +258,6 @@ accountStatusError :: AccountStatusError -> Error accountStatusError InvalidAccountStatus = StdError invalidAccountStatus accountStatusError AccountNotFound = StdError (notFound "Account not found") -phoneError :: PhoneException -> Error -phoneError PhoneNumberUnreachable = StdError (errorToWai @'E.InvalidPhone) -phoneError PhoneNumberBarred = StdError (errorToWai @'E.BlacklistedPhone) -phoneError (PhoneBudgetExhausted t) = RichError phoneBudgetExhausted (PhoneBudgetTimeout t) [] - updateProfileError :: UpdateProfileError -> Error updateProfileError DisplayNameManagedByScim = StdError (propertyManagedByScim "name") updateProfileError ProfileNotFound = StdError (errorToWai @'E.UserNotFound) @@ -327,7 +317,7 @@ deletionCodePending :: Wai.Error deletionCodePending = Wai.mkError status403 "pending-delete" "A verification code for account deletion is still pending." allowlistError :: Wai.Error -allowlistError = Wai.mkError status403 "unauthorized" "Unauthorized e-mail address or phone number." +allowlistError = Wai.mkError status403 "unauthorized" "Unauthorized e-mail address" blacklistedEmail :: Wai.Error blacklistedEmail = diff --git a/services/brig/src/Brig/API/Handler.hs b/services/brig/src/Brig/API/Handler.hs index 93909286021..8f53a1fd738 100644 --- a/services/brig/src/Brig/API/Handler.hs +++ b/services/brig/src/Brig/API/Handler.hs @@ -34,8 +34,7 @@ import Brig.API.Error import Brig.AWS qualified as AWS import Brig.App import Brig.CanonicalInterpreter (BrigCanonicalEffects, runBrigToIO) -import Brig.Options (setAllowlistEmailDomains, setAllowlistPhonePrefixes) -import Brig.Phone (Phone, PhoneException (..)) +import Brig.Options (setAllowlistEmailDomains) import Control.Error import Control.Exception (throwIO) import Control.Lens (view) @@ -100,13 +99,12 @@ instance Exception UserNotAllowedToJoinTeam brigErrorHandlers :: Logger -> ByteString -> [Catch.Handler IO (Either Error a)] brigErrorHandlers logger reqId = - [ Catch.Handler $ \(ex :: PhoneException) -> - pure (Left (phoneError ex)), - Catch.Handler $ \(ex :: ZV.Failure) -> + [ Catch.Handler $ \(ex :: ZV.Failure) -> pure (Left (zauthError ex)), Catch.Handler $ \(ex :: AWS.Error) -> case ex of - AWS.SESInvalidDomain -> pure (Left (StdError (errorToWai @'InvalidEmail))) + AWS.SESInvalidDomain -> + pure (Left (StdError (errorToWai @'InvalidEmail))) _ -> throwM ex, Catch.Handler $ \(UserNotAllowedToJoinTeam e) -> pure (Left $ StdError e), Catch.Handler $ \(e :: SomeException) -> do @@ -127,16 +125,15 @@ parseJsonBody :: (FromJSON a, MonadIO m) => JsonRequest a -> ExceptT Error m a parseJsonBody req = parseBody req !>> StdError . badRequest -- | If an Allowlist is configured, consult it, otherwise a no-op. {#RefActivationAllowlist} -checkAllowlist :: Either Email Phone -> (Handler r) () +checkAllowlist :: Email -> Handler r () checkAllowlist = wrapHttpClientE . checkAllowlistWithError (StdError allowlistError) --- checkAllowlistWithError :: (MonadReader Env m, MonadIO m, Catch.MonadMask m, MonadHttp m, MonadError e m) => e -> Either Email Phone -> m () -checkAllowlistWithError :: (MonadReader Env m, MonadError e m) => e -> Either Email Phone -> m () +checkAllowlistWithError :: (MonadReader Env m, MonadError e m) => e -> Email -> m () checkAllowlistWithError e key = do ok <- isAllowlisted key unless ok (throwError e) -isAllowlisted :: (MonadReader Env m) => Either Email Phone -> m Bool +isAllowlisted :: (MonadReader Env m) => Email -> m Bool isAllowlisted key = do env <- view settings - pure $ Allowlists.verify (setAllowlistEmailDomains env) (setAllowlistPhonePrefixes env) key + pure $ Allowlists.verify (setAllowlistEmailDomains env) key diff --git a/services/brig/src/Brig/API/Internal.hs b/services/brig/src/Brig/API/Internal.hs index 35ada792c93..5608df7d27c 100644 --- a/services/brig/src/Brig/API/Internal.hs +++ b/services/brig/src/Brig/API/Internal.hs @@ -38,7 +38,6 @@ import Brig.Data.Client qualified as Data import Brig.Data.Connection qualified as Data import Brig.Data.MLS.KeyPackage qualified as Data import Brig.Data.User qualified as Data -import Brig.Effects.BlacklistPhonePrefixStore (BlacklistPhonePrefixStore) import Brig.Effects.BlacklistStore (BlacklistStore) import Brig.Effects.ConnectionStore (ConnectionStore) import Brig.Effects.FederationConfigStore @@ -73,7 +72,6 @@ import Data.Map.Strict qualified as Map import Data.Qualified import Data.Set qualified as Set import Data.Text qualified as T -import Data.Text.Lazy qualified as LT import Data.Time.Clock (UTCTime) import Data.Time.Clock.System import Imports hiding (head) @@ -117,8 +115,7 @@ import Wire.UserSubsystem qualified as UserSubsystem servantSitemap :: forall r p. - ( Member BlacklistPhonePrefixStore r, - Member BlacklistStore r, + ( Member BlacklistStore r, Member DeleteQueue r, Member (Concurrency 'Unsafe) r, Member (ConnectionStore InternalPaging) r, @@ -172,7 +169,6 @@ mlsAPI = getMLSClients accountAPI :: ( Member BlacklistStore r, - Member BlacklistPhonePrefixStore r, Member GalleyAPIAccess r, Member AuthenticationSubsystem r, Member DeleteQueue r, @@ -203,15 +199,12 @@ accountAPI = :<|> Named @"iGetUserStatus" getAccountStatusH :<|> Named @"iGetUsersByVariousKeys" listActivatedAccountsH :<|> Named @"iGetUserContacts" getContactListH - :<|> Named @"iGetUserActivationCode" getActivationCodeH + :<|> Named @"iGetUserActivationCode" getActivationCode :<|> Named @"iGetUserPasswordResetCode" getPasswordResetCodeH :<|> Named @"iRevokeIdentity" revokeIdentityH - :<|> Named @"iHeadBlacklist" checkBlacklistH - :<|> Named @"iDeleteBlacklist" deleteFromBlacklistH - :<|> Named @"iPostBlacklist" addBlacklistH - :<|> Named @"iGetPhonePrefix" (callsFed (exposeAnnotations getPhonePrefixesH)) - :<|> Named @"iDeletePhonePrefix" deleteFromPhonePrefixH - :<|> Named @"iPostPhonePrefix" addPhonePrefixH + :<|> Named @"iHeadBlacklist" checkBlacklist + :<|> Named @"iDeleteBlacklist" deleteFromBlacklist + :<|> Named @"iPostBlacklist" addBlacklist :<|> Named @"iPutUserSsoId" updateSSOIdH :<|> Named @"iDeleteUserSsoId" deleteSSOIdH :<|> Named @"iPutManagedBy" updateManagedByH @@ -268,7 +261,6 @@ authAPI :: Member NotificationSubsystem r, Member (Input (Local ())) r, Member (Input UTCTime) r, - Member UserKeyStore r, Member (ConnectionStore InternalPaging) r ) => ServerT BrigIRoutes.AuthAPI (Handler r) @@ -385,7 +377,7 @@ getVerificationCode uid action = do where lookupCode :: VerificationAction -> Email -> (Handler r) (Maybe Code.Value) lookupCode a e = do - key <- Code.mkKey (Code.ForEmail e) + key <- Code.mkKey e code <- wrapClientE $ Code.lookup key (Code.scopeFromAction a) pure $ Code.codeValue <$> code @@ -478,8 +470,7 @@ createUserNoVerify uData = lift . runExceptT $ do let usr = accountUser acc let uid = userId usr let eac = createdEmailActivation result - let pac = createdPhoneActivation result - for_ (catMaybes [eac, pac]) $ \adata -> + for_ eac $ \adata -> let key = ActivateKey $ activationKey adata code = activationCode adata in API.activate key code (Just uid) !>> activationErrorToRegisterError @@ -504,8 +495,7 @@ createUserNoVerifySpar uData = let usr = accountUser acc let uid = userId usr let eac = createdEmailActivation result - let pac = createdPhoneActivation result - for_ (catMaybes [eac, pac]) $ \adata -> + for_ eac $ \adata -> let key = ActivateKey $ activationKey adata code = activationCode adata in API.activate key code (Just uid) !>> CreateUserSparRegistrationError . activationErrorToRegisterError @@ -557,23 +547,20 @@ listActivatedAccountsH :: Maybe (CommaSeparatedList UserId) -> Maybe (CommaSeparatedList Handle) -> Maybe (CommaSeparatedList Email) -> - Maybe (CommaSeparatedList Phone) -> Maybe Bool -> - (Handler r) [UserAccount] + Handler r [UserAccount] listActivatedAccountsH (maybe [] fromCommaSeparatedList -> uids) (maybe [] fromCommaSeparatedList -> handles) (maybe [] fromCommaSeparatedList -> emails) - (maybe [] fromCommaSeparatedList -> phones) (fromMaybe False -> includePendingInvitations) = do - when (length uids + length handles + length emails + length phones == 0) $ do + when (length uids + length handles + length emails == 0) $ do throwStd (notFound "no user keys") lift $ do u1 <- listActivatedAccounts (Left uids) includePendingInvitations u2 <- listActivatedAccounts (Right handles) includePendingInvitations - u3 <- (\email -> API.lookupAccountsByIdentity (Left email) includePendingInvitations) `mapM` emails - u4 <- (\phone -> API.lookupAccountsByIdentity (Right phone) includePendingInvitations) `mapM` phones - pure $ u1 <> u2 <> join u3 <> join u4 + u3 <- (\email -> API.lookupAccountsByIdentity email includePendingInvitations) `mapM` emails + pure $ u1 <> u2 <> join u3 -- FUTUREWORK: this should use UserStore only through UserSubsystem. listActivatedAccounts :: @@ -611,43 +598,26 @@ listActivatedAccounts elh includePendingInvitations = do (Deleted, _, _) -> pure True (Ephemeral, _, _) -> pure True -getActivationCodeH :: Maybe Email -> Maybe Phone -> (Handler r) GetActivationCodeResp -getActivationCodeH (Just email) Nothing = getActivationCode (Left email) -getActivationCodeH Nothing (Just phone) = getActivationCode (Right phone) -getActivationCodeH bade badp = - throwStd - ( badRequest - ( "need exactly one of email, phone: " - <> LT.pack (show (bade, badp)) - ) - ) - -getActivationCode :: Either Email Phone -> (Handler r) GetActivationCodeResp -getActivationCode emailOrPhone = do - apair <- lift . wrapClient $ API.lookupActivationCode emailOrPhone +getActivationCode :: Email -> Handler r GetActivationCodeResp +getActivationCode email = do + apair <- lift . wrapClient $ API.lookupActivationCode email maybe (throwStd activationKeyNotFound) (pure . GetActivationCodeResp) apair getPasswordResetCodeH :: ( Member AuthenticationSubsystem r ) => - Maybe Email -> - Maybe Phone -> - (Handler r) GetPasswordResetCodeResp -getPasswordResetCodeH (Just email) Nothing = getPasswordResetCode (Left email) -getPasswordResetCodeH Nothing (Just phone) = getPasswordResetCode (Right phone) -getPasswordResetCodeH bade badp = - throwStd - ( badRequest - ("need exactly one of email, phone: " <> LT.pack (show (bade, badp))) - ) + Email -> + Handler r GetPasswordResetCodeResp +getPasswordResetCodeH email = getPasswordResetCode email getPasswordResetCode :: ( Member AuthenticationSubsystem r ) => - Either Email Phone -> - (Handler r) GetPasswordResetCodeResp -getPasswordResetCode emailOrPhone = - (GetPasswordResetCodeResp <$$> lift (API.lookupPasswordResetCode emailOrPhone)) >>= maybe (throwStd (errorToWai @'E.InvalidPasswordResetKey)) pure + Email -> + Handler r GetPasswordResetCodeResp +getPasswordResetCode email = + (GetPasswordResetCodeResp <$$> lift (API.lookupPasswordResetCode email)) + >>= maybe (throwStd (errorToWai @'E.InvalidPasswordResetKey)) pure changeAccountStatusH :: ( Member (Embed HttpClientIO) r, @@ -698,25 +668,12 @@ getConnectionsStatus (ConnectionsStatusRequestV2 froms mtos mrel) = do filterByRelation l rel = filter ((== rel) . csv2Status) l revokeIdentityH :: - ( Member (Embed HttpClientIO) r, - Member NotificationSubsystem r, - Member TinyLog r, - Member (Input (Local ())) r, - Member (Input UTCTime) r, - Member UserKeyStore r, - Member (ConnectionStore InternalPaging) r, - Member UserSubsystem r + ( Member UserSubsystem r, + Member UserKeyStore r ) => - Maybe Email -> - Maybe Phone -> - (Handler r) NoContent -revokeIdentityH (Just email) Nothing = lift $ NoContent <$ API.revokeIdentity (Left email) -revokeIdentityH Nothing (Just phone) = lift $ NoContent <$ API.revokeIdentity (Right phone) -revokeIdentityH bade badp = - throwStd - ( badRequest - ("need exactly one of email, phone: " <> LT.pack (show (bade, badp))) - ) + Email -> + Handler r NoContent +revokeIdentityH email = lift $ NoContent <$ API.revokeIdentity email updateConnectionInternalH :: ( Member GalleyAPIAccess r, @@ -730,57 +687,14 @@ updateConnectionInternalH updateConn = do API.updateConnectionInternal updateConn !>> connError pure NoContent -checkBlacklistH :: (Member BlacklistStore r) => Maybe Email -> Maybe Phone -> (Handler r) CheckBlacklistResponse -checkBlacklistH (Just email) Nothing = checkBlacklist (Left email) -checkBlacklistH Nothing (Just phone) = checkBlacklist (Right phone) -checkBlacklistH bade badp = - throwStd - ( badRequest - ("need exactly one of email, phone: " <> LT.pack (show (bade, badp))) - ) - -checkBlacklist :: (Member BlacklistStore r) => Either Email Phone -> (Handler r) CheckBlacklistResponse -checkBlacklist emailOrPhone = lift $ bool NotBlacklisted YesBlacklisted <$> API.isBlacklisted emailOrPhone - -deleteFromBlacklistH :: (Member BlacklistStore r) => Maybe Email -> Maybe Phone -> (Handler r) NoContent -deleteFromBlacklistH (Just email) Nothing = deleteFromBlacklist (Left email) -deleteFromBlacklistH Nothing (Just phone) = deleteFromBlacklist (Right phone) -deleteFromBlacklistH bade badp = - throwStd - ( badRequest - ("need exactly one of email, phone: " <> LT.pack (show (bade, badp))) - ) - -deleteFromBlacklist :: (Member BlacklistStore r) => Either Email Phone -> (Handler r) NoContent -deleteFromBlacklist emailOrPhone = lift $ NoContent <$ API.blacklistDelete emailOrPhone - -addBlacklistH :: (Member BlacklistStore r) => Maybe Email -> Maybe Phone -> (Handler r) NoContent -addBlacklistH (Just email) Nothing = addBlacklist (Left email) -addBlacklistH Nothing (Just phone) = addBlacklist (Right phone) -addBlacklistH bade badp = - throwStd - ( badRequest - ("need exactly one of email, phone: " <> LT.pack (show (bade, badp))) - ) - -addBlacklist :: (Member BlacklistStore r) => Either Email Phone -> (Handler r) NoContent -addBlacklist emailOrPhone = lift $ NoContent <$ API.blacklistInsert emailOrPhone - --- | Get any matching prefixes. Also try for shorter prefix matches, --- i.e. checking for +123456 also checks for +12345, +1234, ... -getPhonePrefixesH :: (Member BlacklistPhonePrefixStore r) => PhonePrefix -> (Handler r) GetPhonePrefixResponse -getPhonePrefixesH prefix = lift $ do - results <- API.phonePrefixGet prefix - pure $ case results of - [] -> PhonePrefixNotFound - (_ : _) -> PhonePrefixesFound results - --- | Delete a phone prefix entry (must be an exact match) -deleteFromPhonePrefixH :: (Member BlacklistPhonePrefixStore r) => PhonePrefix -> (Handler r) NoContent -deleteFromPhonePrefixH prefix = lift $ NoContent <$ API.phonePrefixDelete prefix - -addPhonePrefixH :: (Member BlacklistPhonePrefixStore r) => ExcludedPrefix -> (Handler r) NoContent -addPhonePrefixH prefix = lift $ NoContent <$ API.phonePrefixInsert prefix +checkBlacklist :: (Member BlacklistStore r) => Email -> Handler r CheckBlacklistResponse +checkBlacklist email = lift $ bool NotBlacklisted YesBlacklisted <$> API.isBlacklisted email + +deleteFromBlacklist :: (Member BlacklistStore r) => Email -> Handler r NoContent +deleteFromBlacklist email = lift $ NoContent <$ API.blacklistDelete email + +addBlacklist :: (Member BlacklistStore r) => Email -> Handler r NoContent +addBlacklist email = lift $ NoContent <$ API.blacklistInsert email updateSSOIdH :: ( Member (Embed HttpClientIO) r, diff --git a/services/brig/src/Brig/API/Public.hs b/services/brig/src/Brig/API/Public.hs index f363f7f1e9a..ed2d88f293d 100644 --- a/services/brig/src/Brig/API/Public.hs +++ b/services/brig/src/Brig/API/Public.hs @@ -43,7 +43,6 @@ import Brig.Code qualified as Code import Brig.Data.Connection qualified as Data import Brig.Data.Nonce as Nonce import Brig.Data.User qualified as Data -import Brig.Effects.BlacklistPhonePrefixStore (BlacklistPhonePrefixStore) import Brig.Effects.BlacklistStore (BlacklistStore) import Brig.Effects.ConnectionStore (ConnectionStore) import Brig.Effects.FederationConfigStore (FederationConfigStore) @@ -62,7 +61,6 @@ import Brig.User.API.Handle qualified as Handle import Brig.User.API.Search (teamUserSearch) import Brig.User.API.Search qualified as Search import Brig.User.Auth.Cookie qualified as Auth -import Brig.User.Phone import Cassandra qualified as C import Cassandra qualified as Data import Control.Error hiding (bool, note) @@ -165,7 +163,7 @@ import Wire.Sem.Concurrency import Wire.Sem.Jwk (Jwk) import Wire.Sem.Now (Now) import Wire.Sem.Paging.Cassandra (InternalPaging) -import Wire.UserKeyStore hiding (keyText) +import Wire.UserKeyStore import Wire.UserStore (UserStore) import Wire.UserSubsystem hiding (checkHandle, checkHandles) import Wire.UserSubsystem qualified as UserSubsystem @@ -280,8 +278,7 @@ internalEndpointsSwaggerDocsAPI service examplePort swagger Nothing = servantSitemap :: forall r p. - ( Member BlacklistPhonePrefixStore r, - Member BlacklistStore r, + ( Member BlacklistStore r, Member DeleteQueue r, Member (Concurrency 'Unsafe) r, Member (ConnectionStore InternalPaging) r, @@ -750,18 +747,21 @@ createUser :: Member EmailSending r ) => Public.NewUserPublic -> - (Handler r) (Either Public.RegisterError Public.RegisterSuccess) + Handler r (Either Public.RegisterError Public.RegisterSuccess) createUser (Public.NewUserPublic new) = lift . runExceptT $ do API.checkRestrictedUserCreation new - for_ (Public.newUserEmail new) $ mapExceptT wrapHttp . checkAllowlistWithError RegisterErrorAllowlistError . Left - for_ (Public.newUserPhone new) $ mapExceptT wrapHttp . checkAllowlistWithError RegisterErrorAllowlistError . Right + for_ (Public.newUserEmail new) $ + mapExceptT wrapHttp . checkAllowlistWithError RegisterErrorAllowlistError + + -- prevent registration with a phone number + when (isJust (Public.newUserPhone new)) $ + throwE Public.RegisterErrorInvalidPhone + result <- API.createUser new let acc = createdAccount result let eac = createdEmailActivation result - let pac = createdPhoneActivation result let epair = (,) <$> (activationKey <$> eac) <*> (activationCode <$> eac) - let ppair = (,) <$> (activationKey <$> pac) <*> (activationCode <$> pac) let newUserLabel = Public.newUserLabel new let newUserTeam = Public.newUserTeam new let usr = accountUser acc @@ -781,13 +781,10 @@ createUser (Public.NewUserPublic new) = lift . runExceptT $ do let Public.User {userLocale, userDisplayName} = usr userEmail = Public.userEmail usr - userPhone = Public.userPhone usr userId = Public.userId usr lift $ do for_ (liftM2 (,) userEmail epair) $ \(e, p) -> sendActivationEmail e userDisplayName p (Just userLocale) newUserTeam - for_ (liftM2 (,) userPhone ppair) $ \(p, c) -> - wrapHttp $ sendActivationSms p c (Just userLocale) for_ (liftM3 (,,) userEmail (createdUserTeam result) newUserTeam) $ \(e, ct, ut) -> sendWelcomeEmail e ct ut (Just userLocale) cok <- @@ -951,55 +948,31 @@ updateUser uid conn uu = do lift . liftSem $ updateUserProfile uid (Just conn) UpdateOriginWireClient update +-- | Phone based functionality is not supported any more, but the handler is +-- kept here so long as client API version 5 is supported. changePhone :: - ( Member BlacklistStore r, - Member UserKeyStore r, - Member BlacklistPhonePrefixStore r, - Member (Input (Local ())) r, - Member UserSubsystem r - ) => UserId -> ConnId -> Public.PhoneUpdate -> (Handler r) (Maybe Public.ChangePhoneError) -changePhone u _ (Public.puPhone -> phone) = lift . exceptTToMaybe $ do - (adata, pn) <- API.changePhone u phone - loc <- lift $ liftSem $ qualifyLocal' u >>= lookupLocaleWithDefault - let apair = (activationKey adata, activationCode adata) - lift . wrapHttp $ sendActivationSms pn apair loc +changePhone _ _ _ = pure . Just $ Public.InvalidNewPhone -removePhone :: - ( Member (Embed HttpClientIO) r, - Member NotificationSubsystem r, - Member UserKeyStore r, - Member TinyLog r, - Member PasswordStore r, - Member (Input (Local ())) r, - Member (Input UTCTime) r, - Member (ConnectionStore InternalPaging) r, - Member UserSubsystem r - ) => - UserId -> - ConnId -> - (Handler r) (Maybe Public.RemoveIdentityError) -removePhone self conn = - lift . exceptTToMaybe $ API.removePhone self conn +removePhone :: UserId -> Handler r (Maybe Public.RemoveIdentityError) +removePhone self = lift . exceptTToMaybe $ API.removePhone self removeEmail :: ( Member (Embed HttpClientIO) r, Member NotificationSubsystem r, + Member UserKeyStore r, Member TinyLog r, Member (Input (Local ())) r, Member (Input UTCTime) r, - Member UserKeyStore r, Member (ConnectionStore InternalPaging) r, Member UserSubsystem r ) => UserId -> - ConnId -> - (Handler r) (Maybe Public.RemoveIdentityError) -removeEmail self conn = - lift . exceptTToMaybe $ API.removeEmail self conn + Handler r (Maybe Public.RemoveIdentityError) +removeEmail self = lift . exceptTToMaybe $ API.removeEmail self checkPasswordExists :: (Member PasswordStore r) => UserId -> (Handler r) Bool checkPasswordExists = fmap isJust . lift . liftSem . lookupHashedPassword @@ -1071,14 +1044,16 @@ beginPasswordReset :: (Member AuthenticationSubsystem r) => Public.NewPasswordReset -> Handler r () +beginPasswordReset Public.NewPasswordResetUnsupportedPhone = + throwStd (errorToWai @'E.InvalidPhone) beginPasswordReset (Public.NewPasswordReset target) = - lift (liftSem $ createPasswordResetCode (fromEither target)) + lift (liftSem $ createPasswordResetCode $ mkEmailKey target) completePasswordReset :: ( Member AuthenticationSubsystem r ) => Public.CompletePasswordReset -> - (Handler r) () + Handler r () completePasswordReset req = do lift . liftSem $ resetPassword @@ -1090,17 +1065,19 @@ completePasswordReset req = do -- docs/reference/user/registration.md {#RefRegistration} sendActivationCode :: ( Member BlacklistStore r, - Member BlacklistPhonePrefixStore r, - Member UserKeyStore r, + Member EmailSmsSubsystem r, Member GalleyAPIAccess r, - Member EmailSmsSubsystem r + Member UserKeyStore r ) => Public.SendActivationCode -> - (Handler r) () + Handler r () sendActivationCode Public.SendActivationCode {..} = do - either customerExtensionCheckBlockedDomains (const $ pure ()) saUserKey - checkAllowlist saUserKey - API.sendActivationCode saUserKey saLocale saCall !>> sendActCodeError + email <- case saUserKey of + Left email -> pure email + Right _ -> throwStd (errorToWai @'E.InvalidPhone) + customerExtensionCheckBlockedDomains email + checkAllowlist email + API.sendActivationCode email saLocale saCall !>> sendActCodeError -- | If the user presents an email address from a blocked domain, throw an error. -- @@ -1364,7 +1341,7 @@ sendVerificationCode req = do featureEnabled <- getFeatureStatus mbAccount case (mbAccount, featureEnabled) of (Just account, True) -> do - gen <- Code.mk6DigitGen $ Code.ForEmail email + gen <- Code.mk6DigitGen email timeout <- setVerificationTimeout <$> view settings code <- Code.generate @@ -1379,7 +1356,7 @@ sendVerificationCode req = do where getAccount :: Public.Email -> (Handler r) (Maybe UserAccount) getAccount email = lift $ do - mbUserId <- liftSem $ lookupKey $ userEmailKey email + mbUserId <- liftSem $ lookupKey $ mkEmailKey email join <$> wrapClient (Data.lookupAccount `traverse` mbUserId) sendMail :: Public.Email -> Code.Value -> Maybe Public.Locale -> Public.VerificationAction -> (Handler r) () diff --git a/services/brig/src/Brig/API/Types.hs b/services/brig/src/Brig/API/Types.hs index 60bb89adccc..2152214961c 100644 --- a/services/brig/src/Brig/API/Types.hs +++ b/services/brig/src/Brig/API/Types.hs @@ -28,7 +28,6 @@ module Brig.API.Types LegalHoldLoginError (..), RetryAfter (..), ListUsersById (..), - foldKey, ) where @@ -46,7 +45,7 @@ import Imports import Network.Wai.Utilities.Error qualified as Wai import Wire.API.Federation.Error import Wire.API.User -import Wire.UserKeyStore (UserKey, foldKey) +import Wire.UserKeyStore ------------------------------------------------------------------------------- -- Successes @@ -56,8 +55,6 @@ data CreateUserResult = CreateUserResult createdAccount :: !UserAccount, -- | Activation data for the registered email address, if any. createdEmailActivation :: !(Maybe Activation), - -- | Activation data for the registered phone number, if any. - createdPhoneActivation :: !(Maybe Activation), -- | Info of a team just created/joined createdUserTeam :: !(Maybe CreateUserTeam) } @@ -92,8 +89,8 @@ data CreateUserError | PhoneActivationError ActivationError | InvalidEmail Email String | InvalidPhone Phone - | DuplicateUserKey UserKey - | BlacklistedUserKey UserKey + | DuplicateUserKey EmailKey + | BlacklistedUserKey EmailKey | TooManyTeamMembers | UserCreationRestricted | -- | Some precondition on another Wire service failed. We propagate this error. @@ -118,7 +115,7 @@ data ConnectionError -- no verified user identity. ConnectNoIdentity | -- | An attempt at creating an invitation to a blacklisted user key. - ConnectBlacklistedUserKey UserKey + ConnectBlacklistedUserKey EmailKey | -- | An attempt at creating an invitation to an invalid email address. ConnectInvalidEmail Email String | -- | An attempt at creating an invitation to an invalid phone nbumber. @@ -169,13 +166,9 @@ data ChangeEmailError | EmailManagedByScim data SendActivationCodeError - = InvalidRecipient UserKey - | UserKeyInUse UserKey - | ActivationBlacklistedUserKey UserKey - -data SendLoginCodeError - = SendLoginInvalidPhone Phone - | SendLoginPasswordExists + = InvalidRecipient EmailKey + | UserKeyInUse EmailKey + | ActivationBlacklistedUserKey EmailKey data ClientError = ClientNotFound diff --git a/services/brig/src/Brig/API/User.hs b/services/brig/src/Brig/API/User.hs index 27c9940dc03..7dcc669eb44 100644 --- a/services/brig/src/Brig/API/User.hs +++ b/services/brig/src/Brig/API/User.hs @@ -26,7 +26,6 @@ module Brig.API.User checkRestrictedUserCreation, changeSelfEmail, changeEmail, - changePhone, CheckHandleResp (..), checkHandle, lookupHandle, @@ -70,11 +69,6 @@ module Brig.API.User blacklistDelete, blacklistInsert, - -- * Phone Prefix blocking - phonePrefixGet, - phonePrefixDelete, - phonePrefixInsert, - -- * Utilities fetchUserIdentity, ) @@ -94,8 +88,6 @@ import Brig.Data.Connection qualified as Data import Brig.Data.Properties qualified as Data import Brig.Data.User import Brig.Data.User qualified as Data -import Brig.Effects.BlacklistPhonePrefixStore (BlacklistPhonePrefixStore) -import Brig.Effects.BlacklistPhonePrefixStore qualified as BlacklistPhonePrefixStore import Brig.Effects.BlacklistStore (BlacklistStore) import Brig.Effects.BlacklistStore qualified as BlacklistStore import Brig.Effects.ConnectionStore (ConnectionStore) @@ -105,10 +97,8 @@ import Brig.IO.Intra qualified as Intra import Brig.Options hiding (Timeout, internalEvents) import Brig.Team.DB qualified as Team import Brig.Types.Activation (ActivationPair) -import Brig.Types.Connection import Brig.Types.Intra import Brig.User.Auth.Cookie qualified as Auth -import Brig.User.Phone import Brig.User.Search.Index (reindex) import Brig.User.Search.TeamSize qualified as TeamSize import Cassandra hiding (Set) @@ -174,30 +164,28 @@ import Wire.UserSubsystem.HandleBlacklist data IdentityError = IdentityErrorBlacklistedEmail - | IdentityErrorBlacklistedPhone | IdentityErrorUserKeyExists identityErrorToRegisterError :: IdentityError -> RegisterError identityErrorToRegisterError = \case IdentityErrorBlacklistedEmail -> RegisterErrorBlacklistedEmail - IdentityErrorBlacklistedPhone -> RegisterErrorBlacklistedPhone IdentityErrorUserKeyExists -> RegisterErrorUserKeyExists identityErrorToBrigError :: IdentityError -> Error.Error identityErrorToBrigError = \case IdentityErrorBlacklistedEmail -> Error.StdError $ errorToWai @'E.BlacklistedEmail - IdentityErrorBlacklistedPhone -> Error.StdError $ errorToWai @'E.BlacklistedPhone IdentityErrorUserKeyExists -> Error.StdError $ errorToWai @'E.UserKeyExists verifyUniquenessAndCheckBlacklist :: - (Member BlacklistStore r, Member UserKeyStore r) => - UserKey -> + ( Member BlacklistStore r, + Member UserKeyStore r + ) => + EmailKey -> ExceptT IdentityError (AppT r) () verifyUniquenessAndCheckBlacklist uk = do checkKey Nothing uk blacklisted <- lift $ liftSem $ BlacklistStore.exists uk - when blacklisted $ - throwE (foldKey (const IdentityErrorBlacklistedEmail) (const IdentityErrorBlacklistedPhone) uk) + when blacklisted $ throwE IdentityErrorBlacklistedEmail where checkKey u k = do av <- lift $ liftSem $ keyAvailable k u @@ -240,7 +228,7 @@ createUserSpar new = do pure account -- Add to team - userTeam <- withExceptT CreateUserSparRegistrationError $ addUserToTeamSSO account tid (SSOIdentity ident Nothing Nothing) (newUserSparRole new) + userTeam <- withExceptT CreateUserSparRegistrationError $ addUserToTeamSSO account tid (SSOIdentity ident Nothing) (newUserSparRole new) -- Set up feature flags luid <- lift $ ensureLocal (userQualifiedId (accountUser account)) @@ -249,7 +237,7 @@ createUserSpar new = do -- Set handle lift $ updateHandle' luid handle' - pure $! CreateUserResult account Nothing Nothing (Just userTeam) + pure $! CreateUserResult account Nothing (Just userTeam) where updateHandle' :: Local UserId -> Maybe Handle -> AppT r () updateHandle' _ Nothing = pure () @@ -290,13 +278,13 @@ createUser :: NewUser -> ExceptT RegisterError (AppT r) CreateUserResult createUser new = do - (email, phone) <- validateEmailAndPhone new + email <- validateEmailAndPhone new -- get invitation and existing account (mNewTeamUser, teamInvitation, tid) <- case newUserTeam new of Just (NewTeamMember i) -> do - mbTeamInv <- findTeamInvitation (userEmailKey <$> email) i + mbTeamInv <- findTeamInvitation (mkEmailKey <$> email) i case mbTeamInv of Just (inv, info, tid) -> pure (Nothing, Just (inv, info), Just tid) @@ -313,7 +301,7 @@ createUser new = do let (new', mbHandle) = case mbExistingAccount of Nothing -> - ( new {newUserIdentity = newIdentity email phone (newUserSSOId new)}, + ( new {newUserIdentity = newIdentity email (newUserSSOId new)}, Nothing ) Just existingAccount -> @@ -327,7 +315,7 @@ createUser new = do _ -> newUserSSOId new in ( new { newUserManagedBy = Just (userManagedBy existingUser), - newUserIdentity = newIdentity email phone mbSSOid + newUserIdentity = newIdentity email mbSSOid }, userHandle existingUser ) @@ -365,13 +353,13 @@ createUser new = do joinedTeamInvite <- case teamInvitation of Just (inv, invInfo) -> do let em = Team.inInviteeEmail inv - acceptTeamInvitation account inv invInfo (userEmailKey em) (EmailIdentity em) + acceptTeamInvitation account inv invInfo (mkEmailKey em) (EmailIdentity em) Team.TeamName nm <- lift $ liftSem $ GalleyAPIAccess.getTeamName (Team.inTeam inv) pure (Just $ CreateUserTeam (Team.inTeam inv) nm) Nothing -> pure Nothing joinedTeamSSO <- case (newUserIdentity new', tid) of - (Just ident@(SSOIdentity (UserSSOId _) _ _), Just tid') -> Just <$> addUserToTeamSSO account tid' ident + (Just ident@(SSOIdentity (UserSSOId _) _), Just tid') -> Just <$> addUserToTeamSSO account tid' ident _ -> pure Nothing pure (activatedTeam <|> joinedTeamInvite <|> joinedTeamSSO) @@ -381,15 +369,13 @@ createUser new = do then pure Nothing else handleEmailActivation email uid mNewTeamUser - pdata <- handlePhoneActivation phone uid - lift $ initAccountFeatureConfig uid - pure $! CreateUserResult account edata pdata createUserTeam + pure $! CreateUserResult account edata createUserTeam where -- NOTE: all functions in the where block don't use any arguments of createUser - validateEmailAndPhone :: NewUser -> ExceptT RegisterError (AppT r) (Maybe Email, Maybe Phone) + validateEmailAndPhone :: NewUser -> ExceptT RegisterError (AppT r) (Maybe Email) validateEmailAndPhone newUser = do -- Validate e-mail email <- for (newUserEmail newUser) $ \e -> @@ -398,19 +384,16 @@ createUser new = do pure (validateEmail e) - -- Validate phone - phone <- for (newUserPhone newUser) $ \p -> - maybe - (throwE RegisterErrorInvalidPhone) - pure - =<< lift (wrapClient $ validatePhone p) + -- Disallow registering a user with a phone number + when (isJust (newUserPhone newUser)) $ + throwE RegisterErrorInvalidPhone - for_ (catMaybes [userEmailKey <$> email, userPhoneKey <$> phone]) $ \k -> + for_ (mkEmailKey <$> email) $ \k -> verifyUniquenessAndCheckBlacklist k !>> identityErrorToRegisterError - pure (email, phone) + pure email - findTeamInvitation :: Maybe UserKey -> InvitationCode -> ExceptT RegisterError (AppT r) (Maybe (Team.Invitation, Team.InvitationInfo, TeamId)) + findTeamInvitation :: Maybe EmailKey -> InvitationCode -> ExceptT RegisterError (AppT r) (Maybe (Team.Invitation, Team.InvitationInfo, TeamId)) findTeamInvitation Nothing _ = throwE RegisterErrorMissingIdentity findTeamInvitation (Just e) c = lift (wrapClient $ Team.lookupInvitationInfo c) >>= \case @@ -418,7 +401,7 @@ createUser new = do inv <- lift . wrapClient $ Team.lookupInvitation HideInvitationUrl (Team.iiTeam ii) (Team.iiInvId ii) case (inv, Team.inInviteeEmail <$> inv) of (Just invite, Just em) - | e == userEmailKey em -> do + | e == mkEmailKey em -> do _ <- ensureMemberCanJoin (Team.iiTeam ii) pure $ Just (invite, ii, Team.iiTeam ii) _ -> throwE RegisterErrorInvalidInvitationCode @@ -441,7 +424,7 @@ createUser new = do UserAccount -> Team.Invitation -> Team.InvitationInfo -> - UserKey -> + EmailKey -> UserIdentity -> ExceptT RegisterError (AppT r) () acceptTeamInvitation account inv ii uk ident = do @@ -486,7 +469,7 @@ createUser new = do -- Handle e-mail activation (deprecated, see #RefRegistrationNoPreverification in /docs/reference/user/registration.md) handleEmailActivation :: Maybe Email -> UserId -> Maybe BindingNewTeamUser -> ExceptT RegisterError (AppT r) (Maybe Activation) handleEmailActivation email uid newTeam = do - fmap join . for (userEmailKey <$> email) $ \ek -> case newUserEmailCode new of + fmap join . for (mkEmailKey <$> email) $ \ek -> case newUserEmailCode new of Nothing -> do timeout <- setActivationTimeout <$> view settings edata <- lift . wrapClient $ Data.newActivation ek timeout (Just uid) @@ -502,23 +485,6 @@ createUser new = do !>> activationErrorToRegisterError pure Nothing - -- Handle phone activation (deprecated, see #RefRegistrationNoPreverification in /docs/reference/user/registration.md) - handlePhoneActivation :: Maybe Phone -> UserId -> ExceptT RegisterError (AppT r) (Maybe Activation) - handlePhoneActivation phone uid = do - fmap join . for (userPhoneKey <$> phone) $ \pk -> case newUserPhoneCode new of - Nothing -> do - timeout <- setActivationTimeout <$> view settings - pdata <- lift . wrapClient $ Data.newActivation pk timeout (Just uid) - lift . liftSem . Log.info $ - field "user" (toByteString uid) - . field "activation.key" (toByteString $ activationKey pdata) - . msg (val "Created phone activation key/code pair") - pure $ Just pdata - Just c -> do - ak <- liftIO $ Data.mkActivationKey pk - void $ activate (ActivateKey ak) c (Just uid) !>> activationErrorToRegisterError - pure Nothing - initAccountFeatureConfig :: UserId -> (AppT r) () initAccountFeatureConfig uid = do mbCciDefNew <- view (settings . getAfcConferenceCallingDefNewMaybe) @@ -537,7 +503,7 @@ createUserInviteViaScim :: ExceptT Error.Error (AppT r) UserAccount createUserInviteViaScim (NewUserScimInvitation tid uid loc name rawEmail _) = do email <- either (const . throwE . Error.StdError $ errorToWai @'E.InvalidEmail) pure (validateEmail rawEmail) - let emKey = userEmailKey email + let emKey = mkEmailKey email verifyUniquenessAndCheckBlacklist emKey !>> identityErrorToBrigError account <- lift . wrapClient $ newAccountInviteViaScim uid tid loc name email lift . liftSem . Log.debug $ field "user" (toByteString . userId . accountUser $ account) . field "action" (val "User.createUserInviteViaScim") @@ -620,7 +586,7 @@ changeEmail u email updateOrigin = do (throwE . InvalidNewEmail email) pure (validateEmail email) - let ek = userEmailKey em + let ek = mkEmailKey em blacklisted <- lift . liftSem $ BlacklistStore.exists ek when blacklisted $ throwE (ChangeBlacklistedEmail email) @@ -639,38 +605,6 @@ changeEmail u email updateOrigin = do act <- lift . wrapClient $ Data.newActivation ek timeout (Just u) pure $ ChangeEmailNeedsActivation (usr, act, em) -------------------------------------------------------------------------------- --- Change Phone - -changePhone :: - ( Member BlacklistStore r, - Member UserKeyStore r, - Member BlacklistPhonePrefixStore r - ) => - UserId -> - Phone -> - ExceptT ChangePhoneError (AppT r) (Activation, Phone) -changePhone u phone = do - canonical <- - maybe - (throwE InvalidNewPhone) - pure - =<< lift (wrapClient $ validatePhone phone) - let pk = userPhoneKey canonical - available <- lift $ liftSem $ keyAvailable pk (Just u) - unless available $ - throwE PhoneExists - timeout <- setActivationTimeout <$> view settings - blacklisted <- lift . liftSem $ BlacklistStore.exists pk - when blacklisted $ - throwE BlacklistedNewPhone - -- check if any prefixes of this phone number are blocked - prefixExcluded <- lift . liftSem $ BlacklistPhonePrefixStore.existsAny canonical - when prefixExcluded $ - throwE BlacklistedNewPhone - act <- lift . wrapClient $ Data.newActivation pk timeout (Just u) - pure (act, canonical) - ------------------------------------------------------------------------------- -- Remove Email @@ -685,95 +619,40 @@ removeEmail :: Member UserSubsystem r ) => UserId -> - ConnId -> ExceptT RemoveIdentityError (AppT r) () -removeEmail uid conn = do +removeEmail uid = do ident <- lift $ fetchUserIdentity uid case ident of - Just (FullIdentity e _) -> lift $ do - liftSem $ deleteKey $ userEmailKey e + Just (SSOIdentity (UserSSOId _) (Just e)) -> lift $ do + liftSem $ deleteKey $ mkEmailKey e wrapClient $ Data.deleteEmail uid - liftSem $ Intra.onUserEvent uid (Just conn) (emailRemoved uid e) + liftSem $ Intra.onUserEvent uid Nothing (emailRemoved uid e) Just _ -> throwE LastIdentity Nothing -> throwE NoIdentity ------------------------------------------------------------------------------- -- Remove Phone -removePhone :: - ( Member (Embed HttpClientIO) r, - Member NotificationSubsystem r, - Member UserKeyStore r, - Member PasswordStore r, - Member TinyLog r, - Member (Input (Local ())) r, - Member (Input UTCTime) r, - Member (ConnectionStore InternalPaging) r, - Member UserSubsystem r - ) => - UserId -> - ConnId -> - ExceptT RemoveIdentityError (AppT r) () -removePhone uid conn = do - ident <- lift $ fetchUserIdentity uid - case ident of - Just (FullIdentity _ p) -> do - pw <- lift $ liftSem $ lookupHashedPassword uid - unless (isJust pw) $ - throwE NoPassword - lift $ do - liftSem $ deleteKey $ userPhoneKey p - wrapClient $ Data.deletePhone uid - liftSem $ Intra.onUserEvent uid (Just conn) (phoneRemoved uid p) - Just _ -> throwE LastIdentity - Nothing -> throwE NoIdentity +-- | Phones are not supported any longer. +removePhone :: UserId -> ExceptT RemoveIdentityError (AppT r) () +removePhone _uid = pure () ------------------------------------------------------------------------------- -- Forcefully revoke a verified identity +-- | Now that a user can only have an email-based identity, revoking an identity +-- boils down to deactivating the user. revokeIdentity :: - forall r. - ( Member (Embed HttpClientIO) r, - Member NotificationSubsystem r, - Member TinyLog r, - Member UserKeyStore r, - Member (Input (Local ())) r, - Member (Input UTCTime) r, - Member (ConnectionStore InternalPaging) r, - Member UserSubsystem r + ( Member UserSubsystem r, + Member UserKeyStore r ) => - Either Email Phone -> + Email -> AppT r () revokeIdentity key = do - let uk = either userEmailKey userPhoneKey key - mu <- liftSem $ lookupKey uk - case mu of - Nothing -> pure () - Just u -> - fetchUserIdentity u >>= \case - Just (FullIdentity _ _) -> revokeKey u uk - Just (EmailIdentity e) | Left e == key -> do - revokeKey u uk - wrapClient $ Data.deactivateUser u - Just (PhoneIdentity p) | Right p == key -> do - revokeKey u uk - wrapClient $ Data.deactivateUser u - _ -> pure () - where - revokeKey :: UserId -> UserKey -> AppT r () - revokeKey u uk = do - liftSem $ deleteKey uk - wrapClient $ - foldKey - (\(_ :: Email) -> Data.deleteEmail u) - (\(_ :: Phone) -> Data.deletePhone u) - uk - liftSem $ - Intra.onUserEvent u Nothing $ - foldKey - (emailRemoved u) - (phoneRemoved u) - uk + mu <- liftSem . lookupKey . mkEmailKey $ key + for_ mu $ \u -> do + deactivate <- maybe False (not . isSSOIdentity) <$> fetchUserIdentity u + when deactivate . wrapClient . Data.deactivateUser $ u ------------------------------------------------------------------------------- -- Change Account Status @@ -908,7 +787,7 @@ onActivated :: Member (ConnectionStore InternalPaging) r ) => ActivationEvent -> - (AppT r) (UserId, Maybe UserIdentity, Bool) + AppT r (UserId, Maybe UserIdentity, Bool) onActivated (AccountActivated account) = liftSem $ do let uid = userId (accountUser account) Log.debug $ field "user" (toByteString uid) . field "action" (val "User.onActivated") @@ -919,66 +798,36 @@ onActivated (EmailActivated uid email) = do liftSem $ Intra.onUserEvent uid Nothing (emailUpdated uid email) wrapHttpClient $ Data.deleteEmailUnvalidated uid pure (uid, Just (EmailIdentity email), False) -onActivated (PhoneActivated uid phone) = do - liftSem $ Intra.onUserEvent uid Nothing (phoneUpdated uid phone) - pure (uid, Just (PhoneIdentity phone), False) -- docs/reference/user/activation.md {#RefActivationRequest} sendActivationCode :: ( Member BlacklistStore r, - Member BlacklistPhonePrefixStore r, - Member UserKeyStore r, + Member EmailSmsSubsystem r, Member GalleyAPIAccess r, - Member EmailSmsSubsystem r + Member UserKeyStore r ) => - Either Email Phone -> + Email -> Maybe Locale -> Bool -> ExceptT SendActivationCodeError (AppT r) () -sendActivationCode emailOrPhone loc call = case emailOrPhone of - Left email -> do - ek <- - either - (const . throwE . InvalidRecipient $ userEmailKey email) - (pure . userEmailKey) - (validateEmail email) - exists <- lift $ liftSem $ isJust <$> lookupKey ek - when exists $ - throwE $ - UserKeyInUse ek - blacklisted <- lift . liftSem $ BlacklistStore.exists ek - when blacklisted $ - throwE (ActivationBlacklistedUserKey ek) - uc <- lift . wrapClient $ Data.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 - Just (Just uid, c) -> sendActivationEmail ek c uid -- User re-requesting activation - Right phone -> do - -- validatePhone returns the canonical E.164 phone number format - canonical <- - maybe - (throwE $ InvalidRecipient (userPhoneKey phone)) - pure - =<< lift (wrapClient $ validatePhone phone) - let pk = userPhoneKey canonical - exists <- lift $ liftSem $ isJust <$> lookupKey pk - when exists $ - throwE $ - UserKeyInUse pk - blacklisted <- lift . liftSem $ BlacklistStore.exists pk - when blacklisted $ - throwE (ActivationBlacklistedUserKey pk) - -- check if any prefixes of this phone number are blocked - prefixExcluded <- lift . liftSem $ BlacklistPhonePrefixStore.existsAny canonical - when prefixExcluded $ - throwE (ActivationBlacklistedUserKey pk) - c <- lift . wrapClient $ fmap snd <$> Data.lookupActivationCode pk - p <- wrapClientE $ mkPair pk c Nothing - void . lift . wrapHttp $ forPhoneKey pk $ \ph -> - if call - then sendActivationCall ph p loc - else sendActivationSms ph p loc +sendActivationCode email loc _call = do + ek <- + either + (const . throwE . InvalidRecipient $ mkEmailKey email) + (pure . mkEmailKey) + (validateEmail email) + exists <- lift $ liftSem $ isJust <$> lookupKey ek + when exists $ + throwE $ + UserKeyInUse ek + blacklisted <- lift . liftSem $ BlacklistStore.exists ek + when blacklisted $ + throwE (ActivationBlacklistedUserKey ek) + uc <- lift . wrapClient $ Data.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 + Just (Just uid, c) -> sendActivationEmail ek c uid -- User re-requesting activation where notFound = throwM . UserDisplayNameNotFound mkPair k c u = do @@ -990,10 +839,8 @@ sendActivationCode emailOrPhone loc call = case emailOrPhone of pure (activationKey dat, activationCode dat) sendVerificationEmail ek uc = do (key, code) <- wrapClientE $ mkPair ek uc Nothing - void . forEmailKey ek $ \em -> - lift $ - liftSem $ - sendVerificationMail em key code loc + let em = emailKeyOrig ek + lift $ liftSem $ sendVerificationMail em key code loc sendActivationEmail ek uc uid = do -- FUTUREWORK(fisx): we allow for 'PendingInvitations' here, but I'm not sure this -- top-level function isn't another piece of a deprecated onboarding flow? @@ -1002,7 +849,8 @@ sendActivationCode emailOrPhone loc call = case emailOrPhone of let ident = userIdentity u name = userDisplayName u loc' = loc <|> Just (userLocale u) - void . forEmailKey ek $ \em -> lift $ do + em = emailKeyOrig ek + lift $ do -- Get user's team, if any. mbTeam <- mapM (fmap Team.tdTeam . liftSem . GalleyAPIAccess.getTeam) (userTeam u) -- Depending on whether the user is a team creator, send either @@ -1022,16 +870,10 @@ mkActivationKey (ActivateEmail e) = do ek <- either (throwE . InvalidActivationEmail e) - (pure . userEmailKey) + (pure . mkEmailKey) (validateEmail e) liftIO $ Data.mkActivationKey ek -mkActivationKey (ActivatePhone p) = do - pk <- - maybe - (throwE $ InvalidActivationPhone p) - (pure . userPhoneKey) - =<< lift (validatePhone p) - liftIO $ Data.mkActivationKey pk +mkActivationKey (ActivatePhone p) = throwE $ InvalidActivationPhone p ------------------------------------------------------------------------------- -- Password Management @@ -1105,14 +947,7 @@ deleteSelfUser uid pwd = do isOwner <- lift $ liftSem $ GalleyAPIAccess.memberIsTeamOwner tid uid when isOwner $ throwE DeleteUserOwnerDeletingSelf go a = maybe (byIdentity a) (byPassword a) pwd - getEmailOrPhone :: UserIdentity -> Maybe (Either Email Phone) - getEmailOrPhone (FullIdentity e _) = Just $ Left e - getEmailOrPhone (EmailIdentity e) = Just $ Left e - getEmailOrPhone (SSOIdentity _ (Just e) _) = Just $ Left e - getEmailOrPhone (PhoneIdentity p) = Just $ Right p - getEmailOrPhone (SSOIdentity _ _ (Just p)) = Just $ Right p - getEmailOrPhone (SSOIdentity _ Nothing Nothing) = Nothing - byIdentity a = case getEmailOrPhone =<< userIdentity (accountUser a) of + byIdentity a = case emailIdentity =<< userIdentity (accountUser a) of Just emailOrPhone -> sendCode a emailOrPhone Nothing -> case pwd of Just _ -> throwE DeleteUserMissingPassword @@ -1130,7 +965,7 @@ deleteSelfUser uid pwd = do throwE DeleteUserInvalidPassword lift . liftSem $ deleteAccount a >> pure Nothing sendCode a target = do - gen <- Code.mkGen (either Code.ForEmail Code.ForPhone target) + gen <- Code.mkGen target pending <- lift . wrapClient $ Code.lookup (Code.genKey gen) Code.AccountDeletion case pending of Just c -> throwE $! DeleteUserPendingCode (Code.codeTTL c) @@ -1150,10 +985,7 @@ deleteSelfUser uid pwd = do let v = Code.codeValue c let l = userLocale (accountUser a) let n = userDisplayName (accountUser a) - either - (\e -> lift $ liftSem $ sendAccountDeletionEmail e n k v l) - (\p -> lift $ wrapHttp $ sendDeletionSms p k v l) - target + lift (liftSem $ sendAccountDeletionEmail target n k v l) `onException` wrapClientE (Code.delete k Code.AccountDeletion) pure $! Just $! Code.codeTTL c @@ -1254,8 +1086,7 @@ deleteAccount (accountUser -> user) = do Log.info $ field "user" (toByteString uid) . msg (val "Deleting account") do -- Free unique keys - for_ (userEmail user) $ deleteKeyForUser uid . userEmailKey - for_ (userPhone user) $ deleteKeyForUser uid . userPhoneKey + for_ (userEmail user) $ deleteKeyForUser uid . mkEmailKey embed $ Data.clearProperties uid @@ -1276,10 +1107,10 @@ deleteAccount (accountUser -> user) = do lookupActivationCode :: (MonadClient m) => - Either Email Phone -> + Email -> m (Maybe ActivationPair) -lookupActivationCode emailOrPhone = do - let uk = either userEmailKey userPhoneKey emailOrPhone +lookupActivationCode email = do + let uk = mkEmailKey email k <- liftIO $ Data.mkActivationKey uk c <- fmap snd <$> Data.lookupActivationCode uk pure $ (k,) <$> c @@ -1287,11 +1118,10 @@ lookupActivationCode emailOrPhone = do lookupPasswordResetCode :: ( Member AuthenticationSubsystem r ) => - Either Email Phone -> + Email -> (AppT r) (Maybe PasswordResetPair) -lookupPasswordResetCode emailOrPhone = do - let uk = either userEmailKey userPhoneKey emailOrPhone - liftSem $ internalLookupPasswordResetCode uk +lookupPasswordResetCode = + liftSem . internalLookupPasswordResetCode . mkEmailKey deleteUserNoVerify :: (Member DeleteQueue r) => @@ -1358,9 +1188,13 @@ getLegalHoldStatus' user = -- | Find user accounts for a given identity, both activated and those -- currently pending activation. -lookupAccountsByIdentity :: (Member UserKeyStore r) => Either Email Phone -> Bool -> AppT r [UserAccount] -lookupAccountsByIdentity emailOrPhone includePendingInvitations = do - let uk = either userEmailKey userPhoneKey emailOrPhone +lookupAccountsByIdentity :: + (Member UserKeyStore r) => + Email -> + Bool -> + AppT r [UserAccount] +lookupAccountsByIdentity email includePendingInvitations = do + let uk = mkEmailKey email activeUid <- liftSem $ lookupKey uk uidFromKey <- (>>= fst) <$> wrapClient (Data.lookupActivationCode uk) result <- wrapClient $ Data.lookupAccounts (nub $ catMaybes [activeUid, uidFromKey]) @@ -1368,26 +1202,17 @@ lookupAccountsByIdentity emailOrPhone includePendingInvitations = do then pure result else pure $ filter ((/= PendingInvitation) . accountStatus) result -isBlacklisted :: (Member BlacklistStore r) => Either Email Phone -> AppT r Bool -isBlacklisted emailOrPhone = do - let uk = either userEmailKey userPhoneKey emailOrPhone +isBlacklisted :: (Member BlacklistStore r) => Email -> AppT r Bool +isBlacklisted email = do + let uk = mkEmailKey email liftSem $ BlacklistStore.exists uk -blacklistInsert :: (Member BlacklistStore r) => Either Email Phone -> AppT r () -blacklistInsert emailOrPhone = do - let uk = either userEmailKey userPhoneKey emailOrPhone +blacklistInsert :: (Member BlacklistStore r) => Email -> AppT r () +blacklistInsert email = do + let uk = mkEmailKey email liftSem $ BlacklistStore.insert uk -blacklistDelete :: (Member BlacklistStore r) => Either Email Phone -> AppT r () -blacklistDelete emailOrPhone = do - let uk = either userEmailKey userPhoneKey emailOrPhone +blacklistDelete :: (Member BlacklistStore r) => Email -> AppT r () +blacklistDelete email = do + let uk = mkEmailKey email liftSem $ BlacklistStore.delete uk - -phonePrefixGet :: (Member BlacklistPhonePrefixStore r) => PhonePrefix -> (AppT r) [ExcludedPrefix] -phonePrefixGet = liftSem . BlacklistPhonePrefixStore.getAll - -phonePrefixDelete :: (Member BlacklistPhonePrefixStore r) => PhonePrefix -> (AppT r) () -phonePrefixDelete = liftSem . BlacklistPhonePrefixStore.delete - -phonePrefixInsert :: (Member BlacklistPhonePrefixStore r) => ExcludedPrefix -> (AppT r) () -phonePrefixInsert = liftSem . BlacklistPhonePrefixStore.insert diff --git a/services/brig/src/Brig/AWS/SesNotification.hs b/services/brig/src/Brig/AWS/SesNotification.hs index d107b1551a5..9902d260830 100644 --- a/services/brig/src/Brig/AWS/SesNotification.hs +++ b/services/brig/src/Brig/AWS/SesNotification.hs @@ -29,7 +29,7 @@ import Polysemy (Member) import System.Logger.Class (field, msg, (~~)) import System.Logger.Class qualified as Log import Wire.API.User.Identity -import Wire.UserKeyStore (userEmailKey) +import Wire.UserKeyStore onEvent :: (Member BlacklistStore r) => SESNotification -> AppT r () onEvent (MailBounce BouncePermanent es) = onPermanentBounce es @@ -40,7 +40,7 @@ onEvent (MailComplaint es) = onComplaint es onPermanentBounce :: (Member BlacklistStore r) => [Email] -> AppT r () onPermanentBounce = mapM_ $ \e -> do logEmailEvent "Permanent bounce" e - liftSem $ BlacklistStore.insert (userEmailKey e) + liftSem $ BlacklistStore.insert (mkEmailKey e) onTransientBounce :: [Email] -> AppT r () onTransientBounce = mapM_ (logEmailEvent "Transient bounce") @@ -51,7 +51,7 @@ onUndeterminedBounce = mapM_ (logEmailEvent "Undetermined bounce") onComplaint :: (Member BlacklistStore r) => [Email] -> AppT r () onComplaint = mapM_ $ \e -> do logEmailEvent "Complaint" e - liftSem $ BlacklistStore.insert (userEmailKey e) + liftSem $ BlacklistStore.insert (mkEmailKey e) logEmailEvent :: Text -> Email -> AppT r () logEmailEvent t e = Log.info $ field "email" (fromEmail e) ~~ msg t diff --git a/services/brig/src/Brig/App.hs b/services/brig/src/Brig/App.hs index f1f522b5e33..4f8d67e3a7e 100644 --- a/services/brig/src/Brig/App.hs +++ b/services/brig/src/Brig/App.hs @@ -48,8 +48,6 @@ module Brig.App httpManager, http2Manager, extGetManager, - nexmoCreds, - twilioCreds, settings, currentTime, zauthEnv, @@ -144,8 +142,6 @@ import Polysemy import Polysemy.Final import Polysemy.Input (Input, input) import Prometheus -import Ropes.Nexmo qualified as Nexmo -import Ropes.Twilio qualified as Twilio import Ssl.Util import System.FSNotify qualified as FS import System.Logger.Class hiding (Settings, settings) @@ -193,8 +189,6 @@ data Env = Env _http2Manager :: Http2Manager, _extGetManager :: (Manager, [Fingerprint Rsa] -> SSL.SSL -> IO ()), _settings :: Settings, - _nexmoCreds :: Nexmo.Credentials, - _twilioCreds :: Twilio.Credentials, _fsWatcher :: FS.WatchManager, _turnEnv :: Calling.TurnEnv, _sftEnv :: Maybe Calling.SFTEnv, @@ -245,8 +239,6 @@ newEnv o = do turnSecret <- Text.encodeUtf8 . Text.strip <$> Text.readFile (Opt.secret turnOpts) turn <- Calling.mkTurnEnv (Opt.serversSource turnOpts) (Opt.tokenTTL turnOpts) (Opt.configTTL turnOpts) turnSecret sha512 let sett = Opt.optSettings o - nxm <- initCredentials (Opt.setNexmo sett) - twl <- initCredentials (Opt.setTwilio sett) eventsQueue :: QueueEnv <- case Opt.internalEventsQueue (Opt.internalEvents o) of StompQueueOpts q -> do stomp :: Stomp.Env <- case (Opt.stomp o, Opt.setStomp sett) of @@ -293,8 +285,6 @@ newEnv o = do _http2Manager = h2Mgr, _extGetManager = ext, _settings = sett, - _nexmoCreds = nxm, - _twilioCreds = twl, _turnEnv = turn, _sftEnv = mSFTEnv, _fsWatcher = w, diff --git a/services/brig/src/Brig/CanonicalInterpreter.hs b/services/brig/src/Brig/CanonicalInterpreter.hs index cbb2e26611d..6f0d99f1c89 100644 --- a/services/brig/src/Brig/CanonicalInterpreter.hs +++ b/services/brig/src/Brig/CanonicalInterpreter.hs @@ -3,8 +3,6 @@ module Brig.CanonicalInterpreter where import Brig.AWS (amazonkaEnv) import Brig.App as App import Brig.DeleteQueue.Interpreter as DQ -import Brig.Effects.BlacklistPhonePrefixStore (BlacklistPhonePrefixStore) -import Brig.Effects.BlacklistPhonePrefixStore.Cassandra (interpretBlacklistPhonePrefixStoreToCassandra) import Brig.Effects.BlacklistStore (BlacklistStore) import Brig.Effects.BlacklistStore.Cassandra (interpretBlacklistStoreToCassandra) import Brig.Effects.ConnectionStore (ConnectionStore) @@ -19,7 +17,6 @@ import Brig.Effects.UserPendingActivationStore.Cassandra (userPendingActivationS import Brig.IO.Intra (runUserEvents) import Brig.Options (ImplicitNoFederationRestriction (federationDomainConfig), federationDomainConfigs, federationStrategy) import Brig.Options qualified as Opt -import Brig.User.Phone qualified as Brig import Cassandra qualified as Cas import Control.Exception (ErrorCall) import Control.Lens (to, (^.)) @@ -35,7 +32,7 @@ import Polysemy.Embed (runEmbedded) import Polysemy.Error (Error, errorToIOFinal, mapError, runError) import Polysemy.Input (Input, runInputConst, runInputSem) import Polysemy.TinyLog (TinyLog) -import Wire.API.Allowlists (AllowlistEmailDomains, AllowlistPhonePrefixes) +import Wire.API.Allowlists (AllowlistEmailDomains) import Wire.API.Federation.Client qualified import Wire.API.Federation.Error import Wire.AuthenticationSubsystem @@ -46,7 +43,6 @@ import Wire.EmailSending.SES import Wire.EmailSending.SMTP import Wire.EmailSmsSubsystem import Wire.EmailSmsSubsystem.Interpreter -import Wire.EmailSmsSubsystem.Template (Localised, TemplateBranding, UserTemplates) import Wire.FederationAPIAccess qualified import Wire.FederationAPIAccess.Interpreter (FederationAPIAccessConfig (..), interpretFederationAPIAccess) import Wire.GalleyAPIAccess (GalleyAPIAccess) @@ -100,14 +96,12 @@ type BrigCanonicalEffects = Input UTCTime, Input (Local ()), Input (Maybe AllowlistEmailDomains), - Input (Maybe AllowlistPhonePrefixes), NotificationSubsystem, GundeckAPIAccess, FederationConfigStore, Jwk, PublicKeyBundle, JwtTools, - BlacklistPhonePrefixStore, BlacklistStore, UserPendingActivationStore InternalPaging, Now, @@ -163,14 +157,12 @@ runBrigToIO e (AppT ma) = do . nowToIOAction (e ^. currentTime) . userPendingActivationStoreToCassandra . interpretBlacklistStoreToCassandra @Cas.Client - . interpretBlacklistPhonePrefixStoreToCassandra @Cas.Client . interpretJwtTools . interpretPublicKeyBundle . interpretJwk . interpretFederationDomainConfig (e ^. settings . federationStrategy) (foldMap (remotesMapFromCfgFile . fmap (.federationDomainConfig)) (e ^. settings . federationDomainConfigs)) . runGundeckAPIAccess (e ^. gundeckEndpoint) . runNotificationSubsystemGundeck (defaultNotificationSubsystemConfig (e ^. App.requestId)) - . runInputConst (e ^. settings . Opt.allowlistPhonePrefixes) . runInputConst (e ^. settings . Opt.allowlistEmailDomains) . runInputConst (toLocalUnsafe (e ^. settings . Opt.federationDomain) ()) . runInputSem (embed getCurrentTime) @@ -188,7 +180,7 @@ runBrigToIO e (AppT ma) = do . mapError userSubsystemErrorToWai . runUserEvents . runDeleteQueue (e ^. internalEvents) - . emailSmsSubsystemInterpreter e (e ^. usrTemplates) (e ^. templateBranding) + . emailSmsSubsystemInterpreter (e ^. usrTemplates) (e ^. templateBranding) . runUserSubsystem userSubsystemConfig . interpretAuthenticationSubsystem ) @@ -207,19 +199,3 @@ emailSendingInterpreter e = do case (e ^. smtpEnv) of Just smtp -> emailViaSMTPInterpreter (e ^. applog) smtp Nothing -> emailViaSESInterpreter (e ^. awsEnv . amazonkaEnv) - --- FUTUREWORK: Env can be removed once phone users are removed, and then this interpreter should go to wire-subsystems -emailSmsSubsystemInterpreter :: (Member (Final IO) r, Member EmailSending r) => Env -> Localised UserTemplates -> TemplateBranding -> InterpreterFor EmailSmsSubsystem r -emailSmsSubsystemInterpreter e tpls branding = interpret \case - SendPasswordResetMail email (key, code) mLocale -> sendPasswordResetMailImpl tpls branding email key code mLocale - SendPasswordResetSms phone keyCodePair mLocale -> flip runReaderT e $ unAppT $ wrapHttp do - Brig.sendPasswordResetSms phone keyCodePair mLocale - SendVerificationMail email key code mLocale -> sendVerificationMailImpl tpls branding email key code mLocale - SendTeamDeletionVerificationMail email code mLocale -> sendTeamDeletionVerificationMailImpl tpls branding email code mLocale - SendCreateScimTokenVerificationMail email code mLocale -> sendCreateScimTokenVerificationMailImpl tpls branding email code mLocale - SendLoginVerificationMail email code mLocale -> sendLoginVerificationMailImpl tpls branding email code mLocale - SendActivationMail email name key code mLocale -> sendActivationMailImpl tpls branding email name key code mLocale - SendEmailAddressUpdateMail email name key code mLocale -> sendEmailAddressUpdateMailImpl tpls branding email name key code mLocale - SendTeamActivationMail email name key code mLocale teamName -> sendTeamActivationMailImpl tpls branding email name key code mLocale teamName - SendNewClientEmail email name client locale -> sendNewClientEmailImpl tpls branding email name client locale - SendAccountDeletionEmail email name key code locale -> sendAccountDeletionEmailImpl tpls branding email name key code locale diff --git a/services/brig/src/Brig/Code.hs b/services/brig/src/Brig/Code.hs index 0ceed992ff4..c35695a9e2e 100644 --- a/services/brig/src/Brig/Code.hs +++ b/services/brig/src/Brig/Code.hs @@ -28,7 +28,6 @@ module Brig.Code ( -- * Code Code, - CodeFor (..), Key (..), Scope (..), Value (..), @@ -36,8 +35,6 @@ module Brig.Code Timeout (..), Retries (..), codeFor, - codeForEmail, - codeForPhone, codeKey, codeValue, codeToKeyValuePair, @@ -87,26 +84,11 @@ data Code = Code codeValue :: !Value, codeRetries :: !Retries, codeTTL :: !Timeout, - codeFor :: !CodeFor, + codeFor :: !Email, codeAccount :: !(Maybe UUID) } deriving (Eq, Show) -data CodeFor - = ForEmail !Email - | ForPhone !Phone - deriving (Eq, Show) - -codeForEmail :: Code -> Maybe Email -codeForEmail c - | ForEmail e <- codeFor c = Just e - | otherwise = Nothing - -codeForPhone :: Code -> Maybe Phone -codeForPhone c - | ForPhone p <- codeFor c = Just p - | otherwise = Nothing - scopeFromAction :: User.VerificationAction -> Scope scopeFromAction = \case User.CreateScimToken -> CreateScimToken @@ -161,42 +143,35 @@ instance Cql Retries where -- Generation -- | A contextual string that is hashed into the key to yield distinct keys in --- different contexts for the same email address or phone number. +-- different contexts for the same email address. -- TODO: newtype KeyContext = KeyContext ByteString data Gen = Gen - { genFor :: !CodeFor, + { genFor :: !Email, genKey :: !Key, -- Note [Unique keys] genValue :: IO Value } -mkKey :: (MonadIO m) => CodeFor -> m Key +mkKey :: (MonadIO m) => Email -> m Key mkKey cfor = liftIO $ do Just sha256 <- getDigestByName "SHA256" - let uniqueK = case cfor of - ForEmail e -> emailKeyUniq (mkEmailKey e) - ForPhone p -> phoneKeyUniq (mkPhoneKey p) + let uniqueK = emailKeyUniq (mkEmailKey cfor) pure $ mkKey' sha256 (Text.encodeUtf8 uniqueK) -- | Initialise a 'Code' 'Gen'erator for a given natural key. This generates a link for emails and a 6-digit code for phone. See also: `mk6DigitGen`. -mkGen :: (MonadIO m) => CodeFor -> m Gen +mkGen :: (MonadIO m) => Email -> m Gen mkGen cfor = liftIO $ do Just sha256 <- getDigestByName "SHA256" - pure (initGen sha256 cfor) - where - initGen d (ForEmail e) = mkEmailLinkGen e d - initGen d _ = mk6DigitGen' cfor d + pure (mkEmailLinkGen cfor sha256) -- | Initialise a 'Code' 'Gen'erator for a given natural key. This generates a 6-digit code, matter whether it is sent to a phone or to an email address. See also: `mkGen`. -mk6DigitGen :: (MonadIO m) => CodeFor -> m Gen +mk6DigitGen :: (MonadIO m) => Email -> m Gen mk6DigitGen cfor = liftIO $ do Just sha256 <- getDigestByName "SHA256" pure $ mk6DigitGen' cfor sha256 -mk6DigitGen' :: CodeFor -> Digest -> Gen +mk6DigitGen' :: Email -> Digest -> Gen mk6DigitGen' cfor d = - let uniqueK = case cfor of - ForEmail e -> emailKeyUniq (mkEmailKey e) - ForPhone p -> phoneKeyUniq (mkPhoneKey p) + let uniqueK = emailKeyUniq (mkEmailKey cfor) key = mkKey' d $ Text.encodeUtf8 uniqueK val = Value . unsafeRange . Ascii.unsafeFromText . Text.pack . printf "%06d" <$> randIntegerZeroToNMinusOne (10 ^ (6 :: Int)) in Gen cfor key val @@ -205,7 +180,7 @@ mkEmailLinkGen :: Email -> Digest -> Gen mkEmailLinkGen e d = let key = mkKey' d (Text.encodeUtf8 (emailKeyUniq (mkEmailKey e))) val = Value . unsafeRange . Ascii.encodeBase64Url <$> randBytes 15 - in Gen (ForEmail e) key val + in Gen e key val mkKey' :: Digest -> ByteString -> Key mkKey' d = Key . unsafeRange . Ascii.encodeBase64Url . BS.take 15 . digestBS d @@ -299,15 +274,14 @@ insertInternal c = do let v = codeValue c let r = fromIntegral (codeRetries c) let a = codeAccount c - let e = codeForEmail c - let p = codeForPhone c + let e = codeFor c let t = round (codeTTL c) - retry x5 (write cql (params LocalQuorum (k, s, v, r, e, p, a, t))) + retry x5 (write cql (params LocalQuorum (k, s, v, r, e, a, t))) where - cql :: PrepQuery W (Key, Scope, Value, Retries, Maybe Email, Maybe Phone, Maybe UUID, Int32) () + cql :: PrepQuery W (Key, Scope, Value, Retries, Email, Maybe UUID, Int32) () cql = - "INSERT INTO vcodes (key, scope, value, retries, email, phone, account) \ - \VALUES (?, ?, ?, ?, ?, ?, ?) USING TTL ?" + "INSERT INTO vcodes (key, scope, value, retries, email, account) \ + \VALUES (?, ?, ?, ?, ?, ?) USING TTL ?" -- | Check if code generation should be throttled. lookupThrottle :: (MonadClient m) => Key -> Scope -> m (Maybe RetryAfter) @@ -323,9 +297,9 @@ lookupThrottle k s = do lookup :: (MonadClient m) => Key -> Scope -> m (Maybe Code) lookup k s = fmap (toCode k s) <$> retry x1 (query1 cql (params LocalQuorum (k, s))) where - cql :: PrepQuery R (Key, Scope) (Value, Int32, Retries, Maybe Email, Maybe Phone, Maybe UUID) + cql :: PrepQuery R (Key, Scope) (Value, Int32, Retries, Maybe Email, Maybe UUID) cql = - "SELECT value, ttl(value), retries, email, phone, account \ + "SELECT value, ttl(value), retries, email, account \ \FROM vcodes WHERE key = ? AND scope = ?" -- | Lookup and verify the code for the given key and scope @@ -350,20 +324,16 @@ delete k s = retry x5 $ write cql (params LocalQuorum (k, s)) -------------------------------------------------------------------------------- -- Internal -toCode :: Key -> Scope -> (Value, Int32, Retries, Maybe Email, Maybe Phone, Maybe UUID) -> Code -toCode k s (val, ttl, retries, email, phone, account) = - let ek = ForEmail <$> email - pk = ForPhone <$> phone - to = Timeout (fromIntegral ttl) - in case ek <|> pk of - Nothing -> error "toCode: email or phone must be present" - Just cf -> - Code - { codeKey = k, - codeScope = s, - codeValue = val, - codeTTL = to, - codeRetries = retries, - codeFor = cf, - codeAccount = account - } +toCode :: Key -> Scope -> (Value, Int32, Retries, Maybe Email, Maybe UUID) -> Code +toCode k s (val, ttl, retries, email, account) = case email of + Nothing -> error "toCode: email or phone must be present" + Just e -> + Code + { codeKey = k, + codeScope = s, + codeValue = val, + codeTTL = Timeout (fromIntegral ttl), + codeRetries = retries, + codeFor = e, + codeAccount = account + } diff --git a/services/brig/src/Brig/Data/Activation.hs b/services/brig/src/Brig/Data/Activation.hs index 7efe8c1080a..d665051b8ce 100644 --- a/services/brig/src/Brig/Data/Activation.hs +++ b/services/brig/src/Brig/Data/Activation.hs @@ -79,7 +79,6 @@ activationErrorToRegisterError = \case data ActivationEvent = AccountActivated !UserAccount | EmailActivated !UserId !Email - | PhoneActivated !UserId !Phone -- | Max. number of activation attempts per 'ActivationKey'. maxAttempts :: Int32 @@ -96,40 +95,36 @@ activateKey :: activateKey k c u = verifyCode k c >>= pickUser >>= activate where pickUser (uk, u') = maybe (throwE invalidUser) (pure . (uk,)) (u <|> u') - activate (key, uid) = do + activate (key :: EmailKey, uid) = do a <- lift (lookupAccount uid) >>= maybe (throwE invalidUser) pure unless (accountStatus a == Active) $ -- this is never 'PendingActivation' in the flow this function is used in. throwE invalidCode case userIdentity (accountUser a) of Nothing -> do claim key uid - let ident = foldKey EmailIdentity PhoneIdentity key + let ident = EmailIdentity (emailKeyOrig key) lift $ activateUser uid ident let a' = a {accountUser = (accountUser a) {userIdentity = Just ident}} pure . Just $ AccountActivated a' Just _ -> do let usr = accountUser a - (profileNeedsUpdate, oldKey) = - foldKey - (\(e :: Email) -> (Just e /= userEmail usr,) . fmap userEmailKey . userEmail) - (\(p :: Phone) -> (Just p /= userPhone usr,) . fmap userPhoneKey . userPhone) - key - usr + profileNeedsUpdate = Just (emailKeyOrig key) /= userEmail usr + oldKey :: Maybe EmailKey = mkEmailKey <$> userEmail usr in handleExistingIdentity uid profileNeedsUpdate oldKey key handleExistingIdentity uid profileNeedsUpdate oldKey key | oldKey == Just key && not profileNeedsUpdate = pure Nothing -- activating existing key and exactly same profile -- (can happen when a user clicks on activation links more than once) | oldKey == Just key && profileNeedsUpdate = do - lift $ foldKey (updateEmailAndDeleteEmailUnvalidated uid) (updatePhone uid) key - pure . Just $ foldKey (EmailActivated uid) (PhoneActivated uid) key + lift $ updateEmailAndDeleteEmailUnvalidated uid (emailKeyOrig key) + pure . Just $ EmailActivated uid (emailKeyOrig key) -- if the key is the same, we only want to update our profile | otherwise = do lift (runM (passwordResetCodeStoreToCassandra @m @'[Embed m] (E.codeDelete (mkPasswordResetKey uid)))) claim key uid - lift $ foldKey (updateEmailAndDeleteEmailUnvalidated uid) (updatePhone uid) key + lift $ updateEmailAndDeleteEmailUnvalidated uid (emailKeyOrig key) for_ oldKey $ lift . adhocUserKeyStoreInterpreter . deleteKey - pure . Just $ foldKey (EmailActivated uid) (PhoneActivated uid) key + pure . Just $ EmailActivated uid (emailKeyOrig key) where updateEmailAndDeleteEmailUnvalidated :: UserId -> Email -> m () updateEmailAndDeleteEmailUnvalidated u' email = @@ -138,24 +133,21 @@ activateKey k c u = verifyCode k c >>= pickUser >>= activate ok <- lift $ adhocUserKeyStoreInterpreter (claimKey key uid) unless ok $ throwE . UserKeyExists . LT.fromStrict $ - foldKey fromEmail fromPhone key + fromEmail (emailKeyOrig key) --- | Create a new pending activation for a given 'UserKey'. +-- | Create a new pending activation for a given 'EmailKey'. newActivation :: (MonadClient m) => - UserKey -> + EmailKey -> -- | The timeout for the activation code. Timeout -> -- | The user with whom to associate the activation code. Maybe UserId -> m Activation newActivation uk timeout u = do - (typ, key, code) <- - liftIO $ - foldKey - (\e -> ("email",fromEmail e,) <$> genCode) - (\p -> ("phone",fromPhone p,) <$> genCode) - uk + let typ = "email" + key = fromEmail (emailKeyOrig uk) + code <- liftIO $ genCode insert typ key code where insert t k c = do @@ -167,7 +159,7 @@ newActivation uk timeout u = do <$> randIntegerZeroToNMinusOne 1000000 -- | Lookup an activation code and it's associated owner (if any) for a 'UserKey'. -lookupActivationCode :: (MonadClient m) => UserKey -> m (Maybe (Maybe UserId, ActivationCode)) +lookupActivationCode :: (MonadClient m) => EmailKey -> m (Maybe (Maybe UserId, ActivationCode)) lookupActivationCode k = liftIO (mkActivationKey k) >>= retry x1 . query1 codeSelect . params LocalQuorum . Identity @@ -177,7 +169,7 @@ verifyCode :: (MonadClient m) => ActivationKey -> ActivationCode -> - ExceptT ActivationError m (UserKey, Maybe UserId) + ExceptT ActivationError m (EmailKey, Maybe UserId) verifyCode key code = do s <- lift . retry x1 . query1 keySelect $ params LocalQuorum (Identity key) case s of @@ -189,20 +181,17 @@ verifyCode key code = do Nothing -> throwE invalidCode where mkScope "email" k u = case parseEmail k of - Just e -> pure (userEmailKey e, u) - Nothing -> throwE invalidCode - mkScope "phone" k u = case parsePhone k of - Just p -> pure (userPhoneKey p, u) + Just e -> pure (mkEmailKey e, u) Nothing -> throwE invalidCode mkScope _ _ _ = throwE invalidCode countdown = lift . retry x5 . write keyInsert . params LocalQuorum revoke = lift $ deleteActivationPair key -mkActivationKey :: UserKey -> IO ActivationKey +mkActivationKey :: EmailKey -> IO ActivationKey mkActivationKey k = do d <- liftIO $ getDigestByName "SHA256" d' <- maybe (fail "SHA256 not found") pure d - let bs = digestBS d' (T.encodeUtf8 $ keyText k) + let bs = digestBS d' (T.encodeUtf8 $ emailKeyUniq k) pure . ActivationKey $ Ascii.encodeBase64Url bs deleteActivationPair :: (MonadClient m) => ActivationKey -> m () diff --git a/services/brig/src/Brig/Data/User.hs b/services/brig/src/Brig/Data/User.hs index 27987c5ce5d..7dcd1ed89d5 100644 --- a/services/brig/src/Brig/Data/User.hs +++ b/services/brig/src/Brig/Data/User.hs @@ -48,7 +48,6 @@ module Brig.Data.User -- * Updates updateEmail, updateEmailUnvalidated, - updatePhone, updateSSOId, updateManagedBy, activateUser, @@ -60,7 +59,6 @@ module Brig.Data.User -- * Deletions deleteEmail, deleteEmailUnvalidated, - deletePhone, deleteServiceUser, ) where @@ -224,7 +222,7 @@ isSamlUser :: (MonadClient m, MonadReader Env m) => UserId -> m Bool isSamlUser uid = do account <- lookupAccount uid case userIdentity . accountUser =<< account of - Just (SSOIdentity (UserSSOId _) _ _) -> pure True + Just (SSOIdentity (UserSSOId _) _) -> pure True _ -> pure False insertAccount :: @@ -248,7 +246,6 @@ insertAccount (UserAccount u status) mbConv password activated = retry x5 . batc userPict u, userAssets u, userEmail u, - userPhone u, userSSOId u, userAccentId u, password, @@ -286,9 +283,6 @@ updateEmail u e = retry x5 $ write userEmailUpdate (params LocalQuorum (e, u)) updateEmailUnvalidated :: (MonadClient m) => UserId -> Email -> m () updateEmailUnvalidated u e = retry x5 $ write userEmailUnvalidatedUpdate (params LocalQuorum (e, u)) -updatePhone :: (MonadClient m) => UserId -> Phone -> m () -updatePhone u p = retry x5 $ write userPhoneUpdate (params LocalQuorum (p, u)) - updateSSOId :: (MonadClient m) => UserId -> Maybe UserSSOId -> m Bool updateSSOId u ssoid = do mteamid <- lookupUserTeam u @@ -319,9 +313,6 @@ deleteEmail u = retry x5 $ write userEmailDelete (params LocalQuorum (Identity u deleteEmailUnvalidated :: (MonadClient m) => UserId -> m () deleteEmailUnvalidated u = retry x5 $ write userEmailUnvalidatedDelete (params LocalQuorum (Identity u)) -deletePhone :: (MonadClient m) => UserId -> m () -deletePhone u = retry x5 $ write userPhoneDelete (params LocalQuorum (Identity u)) - deleteServiceUser :: (MonadClient m) => ProviderId -> ServiceId -> BotId -> m () deleteServiceUser pid sid bid = do lookupServiceUser pid sid bid >>= \case @@ -364,8 +355,7 @@ lookupUser hpi u = listToMaybe <$> lookupUsers hpi [u] activateUser :: (MonadClient m) => UserId -> UserIdentity -> m () activateUser u ident = do let email = emailIdentity ident - let phone = phoneIdentity ident - retry x5 $ write userActivatedUpdate (params LocalQuorum (email, phone, u)) + retry x5 $ write userActivatedUpdate (params LocalQuorum (email, u)) deactivateUser :: (MonadClient m) => UserId -> m () deactivateUser u = @@ -475,7 +465,6 @@ type UserRow = Name, Maybe Pict, Maybe Email, - Maybe Phone, Maybe UserSSOId, ColourId, Maybe [Asset], @@ -498,7 +487,6 @@ type UserRowInsert = Pict, [Asset], Maybe Email, - Maybe Phone, Maybe UserSSOId, ColourId, Maybe Password, @@ -522,7 +510,7 @@ type AccountRow = UserRow usersSelect :: PrepQuery R (Identity [UserId]) UserRow usersSelect = - "SELECT id, name, picture, email, phone, sso_id, accent_id, assets, \ + "SELECT id, name, picture, email, sso_id, accent_id, assets, \ \activated, status, expires, language, country, provider, service, \ \handle, team, managed_by, supported_protocols \ \FROM user where id IN ?" @@ -550,17 +538,17 @@ teamSelect = "SELECT team FROM user WHERE id = ?" accountsSelect :: PrepQuery R (Identity [UserId]) AccountRow accountsSelect = - "SELECT id, name, picture, email, phone, sso_id, accent_id, assets, \ + "SELECT id, name, picture, email, sso_id, accent_id, assets, \ \activated, status, expires, language, country, provider, \ \service, handle, team, managed_by, supported_protocols \ \FROM user WHERE id IN ?" userInsert :: PrepQuery W UserRowInsert () userInsert = - "INSERT INTO user (id, name, picture, assets, email, phone, sso_id, \ + "INSERT INTO user (id, name, picture, assets, email, sso_id, \ \accent_id, password, activated, status, expires, language, \ \country, provider, service, handle, team, managed_by, supported_protocols) \ - \VALUES (?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?)" + \VALUES (?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?)" userEmailUpdate :: PrepQuery W (Email, UserId) () userEmailUpdate = {- `IF EXISTS`, but that requires benchmarking -} "UPDATE user SET email = ? WHERE id = ?" @@ -571,9 +559,6 @@ userEmailUnvalidatedUpdate = {- `IF EXISTS`, but that requires benchmarking -} " userEmailUnvalidatedDelete :: PrepQuery W (Identity UserId) () userEmailUnvalidatedDelete = {- `IF EXISTS`, but that requires benchmarking -} "UPDATE user SET email_unvalidated = null WHERE id = ?" -userPhoneUpdate :: PrepQuery W (Phone, UserId) () -userPhoneUpdate = {- `IF EXISTS`, but that requires benchmarking -} "UPDATE user SET phone = ? WHERE id = ?" - userSSOIdUpdate :: PrepQuery W (Maybe UserSSOId, UserId) () userSSOIdUpdate = {- `IF EXISTS`, but that requires benchmarking -} "UPDATE user SET sso_id = ? WHERE id = ?" @@ -586,15 +571,12 @@ userStatusUpdate = {- `IF EXISTS`, but that requires benchmarking -} "UPDATE use userDeactivatedUpdate :: PrepQuery W (Identity UserId) () userDeactivatedUpdate = {- `IF EXISTS`, but that requires benchmarking -} "UPDATE user SET activated = false WHERE id = ?" -userActivatedUpdate :: PrepQuery W (Maybe Email, Maybe Phone, UserId) () -userActivatedUpdate = {- `IF EXISTS`, but that requires benchmarking -} "UPDATE user SET activated = true, email = ?, phone = ? WHERE id = ?" +userActivatedUpdate :: PrepQuery W (Maybe Email, UserId) () +userActivatedUpdate = {- `IF EXISTS`, but that requires benchmarking -} "UPDATE user SET activated = true, email = ? WHERE id = ?" userEmailDelete :: PrepQuery W (Identity UserId) () userEmailDelete = {- `IF EXISTS`, but that requires benchmarking -} "UPDATE user SET email = null WHERE id = ?" -userPhoneDelete :: PrepQuery W (Identity UserId) () -userPhoneDelete = {- `IF EXISTS`, but that requires benchmarking -} "UPDATE user SET phone = null WHERE id = ?" - userRichInfoUpdate :: PrepQuery W (RichInfoAssocList, UserId) () userRichInfoUpdate = {- `IF EXISTS`, but that requires benchmarking -} "UPDATE rich_info SET json = ? WHERE user = ?" @@ -610,7 +592,6 @@ toUserAccount name, pict, email, - phone, ssoid, accent, assets, @@ -626,7 +607,7 @@ toUserAccount managed_by, prots ) = - let ident = toIdentity activated email phone ssoid + let ident = toIdentity activated email ssoid deleted = Just Deleted == status expiration = if status == Just Ephemeral then expires else Nothing loc = toLocale defaultLocale (lan, con) @@ -662,7 +643,6 @@ toUsers domain defaultLocale havePendingInvitations = fmap mk . filter fp _name, _pict, _email, - _phone, _ssoid, _accent, _assets, @@ -686,7 +666,6 @@ toUsers domain defaultLocale havePendingInvitations = fmap mk . filter fp name, pict, email, - phone, ssoid, accent, assets, @@ -702,7 +681,7 @@ toUsers domain defaultLocale havePendingInvitations = fmap mk . filter fp managed_by, prots ) = - let ident = toIdentity activated email phone ssoid + let ident = toIdentity activated email ssoid deleted = Just Deleted == status expiration = if status == Just Ephemeral then expires else Nothing loc = toLocale defaultLocale (lan, con) @@ -739,12 +718,9 @@ toIdentity :: -- | Whether the user is activated Bool -> Maybe Email -> - Maybe Phone -> Maybe UserSSOId -> Maybe UserIdentity -toIdentity True (Just e) (Just p) Nothing = Just $! FullIdentity e p -toIdentity True (Just e) Nothing Nothing = Just $! EmailIdentity e -toIdentity True Nothing (Just p) Nothing = Just $! PhoneIdentity p -toIdentity True email phone (Just ssoid) = Just $! SSOIdentity ssoid email phone -toIdentity True Nothing Nothing Nothing = Nothing -toIdentity False _ _ _ = Nothing +toIdentity True (Just e) Nothing = Just $! EmailIdentity e +toIdentity True email (Just ssoid) = Just $! SSOIdentity ssoid email +toIdentity True Nothing Nothing = Nothing +toIdentity False _ _ = Nothing diff --git a/services/brig/src/Brig/Effects/BlacklistPhonePrefixStore.hs b/services/brig/src/Brig/Effects/BlacklistPhonePrefixStore.hs deleted file mode 100644 index 8f5463067d4..00000000000 --- a/services/brig/src/Brig/Effects/BlacklistPhonePrefixStore.hs +++ /dev/null @@ -1,16 +0,0 @@ -{-# LANGUAGE TemplateHaskell #-} - -module Brig.Effects.BlacklistPhonePrefixStore where - -import Brig.Phone (Phone) -import Brig.Types.Common (ExcludedPrefix, PhonePrefix) -import Imports -import Polysemy - -data BlacklistPhonePrefixStore m a where - Insert :: ExcludedPrefix -> BlacklistPhonePrefixStore m () - Delete :: PhonePrefix -> BlacklistPhonePrefixStore m () - ExistsAny :: Phone -> BlacklistPhonePrefixStore m Bool - GetAll :: PhonePrefix -> BlacklistPhonePrefixStore m [ExcludedPrefix] - -makeSem ''BlacklistPhonePrefixStore diff --git a/services/brig/src/Brig/Effects/BlacklistPhonePrefixStore/Cassandra.hs b/services/brig/src/Brig/Effects/BlacklistPhonePrefixStore/Cassandra.hs deleted file mode 100644 index aab51f2831f..00000000000 --- a/services/brig/src/Brig/Effects/BlacklistPhonePrefixStore/Cassandra.hs +++ /dev/null @@ -1,57 +0,0 @@ -module Brig.Effects.BlacklistPhonePrefixStore.Cassandra - ( interpretBlacklistPhonePrefixStoreToCassandra, - ) -where - -import Brig.Effects.BlacklistPhonePrefixStore -import Brig.Types.Common -import Cassandra -import Imports -import Polysemy -import Wire.API.User.Identity - -interpretBlacklistPhonePrefixStoreToCassandra :: - forall m r a. - (MonadClient m, Member (Embed m) r) => - Sem (BlacklistPhonePrefixStore ': r) a -> - Sem r a -interpretBlacklistPhonePrefixStoreToCassandra = - interpret $ - embed @m . \case - Insert ep -> insertPrefix ep - Delete pp -> deletePrefix pp - ExistsAny uk -> existsAnyPrefix uk - GetAll pp -> getAllPrefixes pp - --------------------------------------------------------------------------------- --- Excluded phone prefixes - -insertPrefix :: (MonadClient m) => ExcludedPrefix -> m () -insertPrefix prefix = retry x5 $ write ins (params LocalQuorum (phonePrefix prefix, comment prefix)) - where - ins :: PrepQuery W (PhonePrefix, Text) () - ins = "INSERT INTO excluded_phones (prefix, comment) VALUES (?, ?)" - -deletePrefix :: (MonadClient m) => PhonePrefix -> m () -deletePrefix prefix = retry x5 $ write del (params LocalQuorum (Identity prefix)) - where - del :: PrepQuery W (Identity PhonePrefix) () - del = "DELETE FROM excluded_phones WHERE prefix = ?" - -getAllPrefixes :: (MonadClient m) => PhonePrefix -> m [ExcludedPrefix] -getAllPrefixes prefix = do - let prefixes = fromPhonePrefix <$> allPrefixes (fromPhonePrefix prefix) - selectPrefixes prefixes - -existsAnyPrefix :: (MonadClient m) => Phone -> m Bool -existsAnyPrefix phone = do - let prefixes = fromPhonePrefix <$> allPrefixes (fromPhone phone) - not . null <$> selectPrefixes prefixes - -selectPrefixes :: (MonadClient m) => [Text] -> m [ExcludedPrefix] -selectPrefixes prefixes = do - results <- retry x1 (query sel (params LocalQuorum (Identity $ prefixes))) - pure $ uncurry ExcludedPrefix <$> results - where - sel :: PrepQuery R (Identity [Text]) (PhonePrefix, Text) - sel = "SELECT prefix, comment FROM excluded_phones WHERE prefix IN ?" diff --git a/services/brig/src/Brig/Effects/BlacklistStore.hs b/services/brig/src/Brig/Effects/BlacklistStore.hs index 3eca04e72df..e888194d7a3 100644 --- a/services/brig/src/Brig/Effects/BlacklistStore.hs +++ b/services/brig/src/Brig/Effects/BlacklistStore.hs @@ -7,8 +7,8 @@ import Polysemy import Wire.UserKeyStore data BlacklistStore m a where - Insert :: UserKey -> BlacklistStore m () - Exists :: UserKey -> BlacklistStore m Bool - Delete :: UserKey -> BlacklistStore m () + Insert :: EmailKey -> BlacklistStore m () + Exists :: EmailKey -> BlacklistStore m Bool + Delete :: EmailKey -> BlacklistStore m () makeSem ''BlacklistStore diff --git a/services/brig/src/Brig/Effects/BlacklistStore/Cassandra.hs b/services/brig/src/Brig/Effects/BlacklistStore/Cassandra.hs index 4a426b69efb..45ada1cebc9 100644 --- a/services/brig/src/Brig/Effects/BlacklistStore/Cassandra.hs +++ b/services/brig/src/Brig/Effects/BlacklistStore/Cassandra.hs @@ -24,16 +24,16 @@ interpretBlacklistStoreToCassandra = -------------------------------------------------------------------------------- -- UserKey blacklisting -insert :: (MonadClient m) => UserKey -> m () -insert uk = retry x5 $ write keyInsert (params LocalQuorum (Identity $ keyText uk)) +insert :: (MonadClient m) => EmailKey -> m () +insert uk = retry x5 $ write keyInsert (params LocalQuorum (Identity $ emailKeyUniq uk)) -exists :: (MonadClient m) => UserKey -> m Bool +exists :: (MonadClient m) => EmailKey -> m Bool exists uk = (pure . isJust) . fmap runIdentity - =<< retry x1 (query1 keySelect (params LocalQuorum (Identity $ keyText uk))) + =<< retry x1 (query1 keySelect (params LocalQuorum (Identity $ emailKeyUniq uk))) -delete :: (MonadClient m) => UserKey -> m () -delete uk = retry x5 $ write keyDelete (params LocalQuorum (Identity $ keyText uk)) +delete :: (MonadClient m) => EmailKey -> m () +delete uk = retry x5 $ write keyDelete (params LocalQuorum (Identity $ emailKeyUniq uk)) keyInsert :: PrepQuery W (Identity Text) () keyInsert = "INSERT INTO blacklist (key) VALUES (?)" diff --git a/services/brig/src/Brig/Options.hs b/services/brig/src/Brig/Options.hs index b82865c42ad..66e4ea9d69e 100644 --- a/services/brig/src/Brig/Options.hs +++ b/services/brig/src/Brig/Options.hs @@ -54,7 +54,7 @@ import Network.AMQP.Extended import Network.DNS qualified as DNS import System.Logger.Extended (Level, LogFormat) import Util.Options -import Wire.API.Allowlists (AllowlistEmailDomains (..), AllowlistPhonePrefixes (..)) +import Wire.API.Allowlists (AllowlistEmailDomains (..)) import Wire.API.Routes.FederationDomainConfig import Wire.API.Routes.Version import Wire.API.Team.Feature qualified as Public @@ -457,15 +457,10 @@ data Settings = Settings setTeamInvitationTimeout :: !Timeout, -- | Check for expired users every so often, in seconds setExpiredUserCleanupTimeout :: !(Maybe Timeout), - -- | Twilio credentials - setTwilio :: !FilePathSecrets, - -- | Nexmo credentials - setNexmo :: !FilePathSecrets, -- | STOMP broker credentials setStomp :: !(Maybe FilePathSecrets), -- | Whitelist of allowed emails/phones setAllowlistEmailDomains :: !(Maybe AllowlistEmailDomains), - setAllowlistPhonePrefixes :: !(Maybe AllowlistPhonePrefixes), -- | Max. number of sent/accepted -- connections per user setUserMaxConnections :: !Int64, diff --git a/services/brig/src/Brig/Phone.hs b/services/brig/src/Brig/Phone.hs deleted file mode 100644 index 6f7e79d9265..00000000000 --- a/services/brig/src/Brig/Phone.hs +++ /dev/null @@ -1,323 +0,0 @@ -{-# LANGUAGE RecordWildCards #-} - --- This file is part of the Wire Server implementation. --- --- Copyright (C) 2022 Wire Swiss GmbH --- --- This program is free software: you can redistribute it and/or modify it under --- the terms of the GNU Affero General Public License as published by the Free --- Software Foundation, either version 3 of the License, or (at your option) any --- later version. --- --- This program is distributed in the hope that it will be useful, but WITHOUT --- ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS --- FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for more --- details. --- --- You should have received a copy of the GNU Affero General Public License along --- with this program. If not, see . - -module Brig.Phone - ( SMSMessage (..), - PhoneException (..), - sendCall, - sendSms, - - -- * Validation - validatePhone, - - -- * Unique Keys - PhoneKey, - mkPhoneKey, - phoneKeyUniq, - phoneKeyOrig, - - -- * Re-exports - Phone (..), - ) -where - -import Bilge.Retry (httpHandlers) -import Brig.App -import Brig.Budget -import Cassandra (MonadClient) -import Control.Lens (view) -import Control.Monad.Catch -import Control.Retry -import Data.LanguageCodes -import Data.Text qualified as Text -import Data.Time.Clock (NominalDiffTime) -import Imports -import Network.HTTP.Client (HttpException, Manager) -import Prometheus qualified as Prom -import Ropes.Nexmo qualified as Nexmo -import Ropes.Twilio (LookupDetail (..)) -import Ropes.Twilio qualified as Twilio -import System.Logger.Class qualified as Log -import System.Logger.Message (field, msg, val, (~~)) -import Wire.API.User -import Wire.UserKeyStore - -------------------------------------------------------------------------------- --- Sending SMS and Voice Calls - -data SMSMessage = SMSMessage - { smsFrom :: !Text, - smsTo :: !Text, - smsText :: !Text - } - -data PhoneException - = PhoneNumberUnreachable - | PhoneNumberBarred - | PhoneBudgetExhausted NominalDiffTime - deriving (Show, Typeable) - -instance Exception PhoneException - -sendCall :: - (MonadClient m, MonadReader Env m, Log.MonadLogger m, Prom.MonadMonitor m) => - Nexmo.Call -> - m () -sendCall call = unless (isTestPhone $ Nexmo.callTo call) $ do - m <- view httpManager - cred <- view nexmoCreds - withCallBudget (Nexmo.callTo call) $ do - r <- - liftIO . try @_ @Nexmo.CallErrorResponse . recovering x3 nexmoHandlers $ - const $ - Nexmo.sendCall cred m call - case r of - Left ex -> case Nexmo.caStatus ex of - Nexmo.CallDestinationNotPermitted -> unreachable ex - Nexmo.CallInvalidDestinationAddress -> unreachable ex - Nexmo.CallUnroutable -> unreachable ex - Nexmo.CallDestinationBarred -> barred ex - _ -> throwM ex - Right _ -> pure () - where - nexmoHandlers = - httpHandlers - ++ [ const . Handler $ \(ex :: Nexmo.CallErrorResponse) -> - pure $ case Nexmo.caStatus ex of - Nexmo.CallThrottled -> True - Nexmo.CallInternal -> True - _ -> False - ] - unreachable ex = warn (toException ex) >> throwM PhoneNumberUnreachable - barred ex = warn (toException ex) >> throwM PhoneNumberBarred - warn ex = - Log.warn $ - msg (val "Voice call failed.") - ~~ field "error" (show ex) - ~~ field "phone" (Nexmo.callTo call) - -sendSms :: - ( MonadClient m, - MonadCatch m, - Log.MonadLogger m, - MonadReader Env m, - Prom.MonadMonitor m - ) => - Locale -> - SMSMessage -> - m () -sendSms loc SMSMessage {..} = unless (isTestPhone smsTo) $ do - m <- view httpManager - withSmsBudget smsTo $ do - -- We try Nexmo first (cheaper and specialised to SMS) - f <- (sendNexmoSms m $> Nothing) `catches` nexmoFailed - for_ f $ \ex -> do - warn ex - r <- try @_ @Twilio.ErrorResponse $ sendTwilioSms m - case r of - Left ex' -> case Twilio.errStatus ex' of - -- Invalid "To" number for SMS - 14101 -> unreachable ex' - -- 'To' number is not a valid mobile number - 21614 -> unreachable ex' - -- "To" number is not currently reachable - 21612 -> unreachable ex' - -- Customer replied with "STOP" - 21610 -> barred ex' - -- A real problem - _ -> throwM ex' - Right () -> pure () - where - sendNexmoSms :: (MonadIO f, MonadReader Env f) => Manager -> f () - sendNexmoSms mgr = do - crd <- view nexmoCreds - void . liftIO . recovering x3 nexmoHandlers $ - const $ - Nexmo.sendMessage crd mgr $ - Nexmo.Message "Wire" smsTo smsText (toNexmoCharset loc) - toNexmoCharset :: Locale -> Nexmo.Charset - toNexmoCharset l = case fromLanguage (lLanguage l) of - RU -> Nexmo.UCS2 - AR -> Nexmo.UCS2 - UK -> Nexmo.UCS2 - FA -> Nexmo.UCS2 - TR -> Nexmo.UCS2 - ES -> Nexmo.UCS2 - ZH -> Nexmo.UCS2 - _ -> Nexmo.GSM7 - sendTwilioSms :: (MonadIO f, MonadReader Env f) => Manager -> f () - sendTwilioSms mgr = do - crd <- view twilioCreds - void . liftIO . recovering x3 twilioHandlers $ - const $ - Twilio.sendMessage crd mgr (Twilio.Message smsFrom smsTo smsText) - nexmoFailed = - [ Handler $ \(ex :: HttpException) -> - pure (Just (SomeException ex)), - Handler $ \(ex :: Nexmo.MessageErrorResponse) -> - pure (Just (SomeException ex)) - ] - nexmoHandlers = - httpHandlers - ++ [ const . Handler $ \(ex :: Nexmo.MessageErrorResponse) -> - pure $ case Nexmo.erStatus ex of - Nexmo.MessageThrottled -> True - Nexmo.MessageInternal -> True - Nexmo.MessageCommunicationFailed -> True - _ -> False - ] - twilioHandlers = - httpHandlers - ++ [ const . Handler $ \(ex :: Twilio.ErrorResponse) -> - pure $ case Twilio.errStatus ex of - 20429 -> True -- Too Many Requests - 20500 -> True -- Internal Server Error - 20503 -> True -- Temporarily Unavailable - _ -> False - ] - unreachable ex = warn (toException ex) >> throwM PhoneNumberUnreachable - barred ex = warn (toException ex) >> throwM PhoneNumberBarred - warn ex = - Log.warn $ - msg (val "SMS failed.") - ~~ field "error" (show ex) - ~~ field "phone" smsTo - -------------------------------------------------------------------------------- --- Phone Number Validation - --- | Validate a phone number. Returns the canonical --- E.164 format of the given phone number on success. -validatePhone :: (MonadClient m, MonadReader Env m) => Phone -> m (Maybe Phone) -validatePhone (Phone p) - | isTestPhone p = pure (Just (Phone p)) - | otherwise = do - c <- view twilioCreds - m <- view httpManager - r <- - liftIO . try @_ @Twilio.ErrorResponse $ - recovering x3 httpHandlers $ - const $ - Twilio.lookupPhone c m p LookupNoDetail Nothing - case r of - Right x -> pure (Just (Phone (Twilio.lookupE164 x))) - Left e | Twilio.errStatus e == 404 -> pure Nothing - Left e -> throwM e - -isTestPhone :: Text -> Bool -isTestPhone = Text.isPrefixOf "+0" - --------------------------------------------------------------------------------- --- SMS Budgeting - -smsBudget :: Budget -smsBudget = - Budget - { budgetTimeout = 3600 * 24, -- 24 hours - budgetValue = 5 -- # of SMS within timeout - } - -withSmsBudget :: - ( MonadClient m, - Log.MonadLogger m, - Prom.MonadMonitor m - ) => - Text -> - m a -> - m a -withSmsBudget phone go = do - let k = BudgetKey ("sms#" <> phone) - r <- withBudget k smsBudget go - case r of - BudgetExhausted t -> do - Log.info $ - msg (val "SMS budget exhausted.") - ~~ field "phone" phone - Prom.incCounter smsBudgetExhaustedCounter - throwM (PhoneBudgetExhausted t) - BudgetedValue a b -> do - Log.debug $ - msg (val "SMS budget deducted.") - ~~ field "budget" b - ~~ field "phone" phone - pure a - --------------------------------------------------------------------------------- --- Voice Call Budgeting - -callBudget :: Budget -callBudget = - Budget - { budgetTimeout = 3600 * 24 * 7, -- 7 days - budgetValue = 2 -- # of voice calls within timeout - } - -withCallBudget :: - ( MonadClient m, - Log.MonadLogger m, - Prom.MonadMonitor m - ) => - Text -> - m a -> - m a -withCallBudget phone go = do - let k = BudgetKey ("call#" <> phone) - r <- withBudget k callBudget go - case r of - BudgetExhausted t -> do - Log.info $ - msg (val "Voice call budget exhausted.") - ~~ field "phone" phone - Prom.incCounter callBudgetExhaustedCounter - throwM (PhoneBudgetExhausted t) - BudgetedValue a b -> do - Log.debug $ - msg (val "Voice call budget deducted.") - ~~ field "budget" b - ~~ field "phone" phone - pure a - -------------------------------------------------------------------------------- --- Retry Settings - -x3 :: RetryPolicy -x3 = limitRetries 3 <> exponentialBackoff 100000 - -------------------------------------------------------------------------------- --- Metrics - -{-# NOINLINE callBudgetExhaustedCounter #-} -callBudgetExhaustedCounter :: Prom.Counter -callBudgetExhaustedCounter = - Prom.unsafeRegister $ - Prom.counter - Prom.Info - { Prom.metricName = "budget.call.exhausted", - Prom.metricHelp = "Number of times budget for calls got exhausted" - } - -{-# NOINLINE smsBudgetExhaustedCounter #-} -smsBudgetExhaustedCounter :: Prom.Counter -smsBudgetExhaustedCounter = - Prom.unsafeRegister $ - Prom.counter - Prom.Info - { Prom.metricName = "budget.sms.exhausted", - Prom.metricHelp = "Number of times budget for sending SMS got exhausted" - } diff --git a/services/brig/src/Brig/Provider/API.hs b/services/brig/src/Brig/Provider/API.hs index 66297e3c000..10ad0a73870 100644 --- a/services/brig/src/Brig/Provider/API.hs +++ b/services/brig/src/Brig/Provider/API.hs @@ -200,7 +200,7 @@ newAccount new = do safePass <- mkSafePasswordScrypt newPass pure (safePass, Just newPass) pid <- wrapClientE $ DB.insertAccount name safePass url descr - gen <- Code.mkGen (Code.ForEmail email) + gen <- Code.mkGen email code <- Code.generate gen @@ -218,7 +218,7 @@ activateAccountKey :: (Member GalleyAPIAccess r, Member EmailSending r) => Code. activateAccountKey key val = do guardSecondFactorDisabled Nothing c <- wrapClientE (Code.verify key Code.IdentityVerification val) >>= maybeInvalidCode - (pid, email) <- case (Code.codeAccount c, Code.codeForEmail c) of + (pid, email) <- case (Code.codeAccount c, Just (Code.codeFor c)) of (Just p, Just e) -> pure (Id p, e) _ -> throwStd (errorToWai @'E.InvalidCode) (name, memail, _url, _descr) <- wrapClientE (DB.lookupAccountData pid) >>= maybeInvalidCode @@ -226,7 +226,7 @@ activateAccountKey key val = do Just email' | email == email' -> pure Nothing Just email' -> do -- Ensure we remove any pending password reset - gen <- Code.mkGen (Code.ForEmail email') + gen <- Code.mkGen email' lift $ wrapClient $ Code.delete (Code.genKey gen) Code.PasswordReset -- Activate the new and remove the old key activate pid (Just email') email @@ -243,7 +243,7 @@ getActivationCodeH e = do email <- case validateEmail e of Right em -> pure em Left _ -> throwStd (errorToWai @'E.InvalidEmail) - gen <- Code.mkGen (Code.ForEmail email) + gen <- Code.mkGen email code <- wrapClientE $ Code.lookup (Code.genKey gen) Code.IdentityVerification maybe (throwStd activationKeyNotFound) (pure . Code.codeToKeyValuePair) code @@ -262,7 +262,7 @@ beginPasswordReset :: (Member GalleyAPIAccess r, Member EmailSending r) => Publi beginPasswordReset (Public.PasswordReset target) = do guardSecondFactorDisabled Nothing pid <- wrapClientE (DB.lookupKey (mkEmailKey target)) >>= maybeBadCredentials - gen <- Code.mkGen (Code.ForEmail target) + gen <- Code.mkGen target pending <- lift . wrapClient $ Code.lookup (Code.genKey gen) Code.PasswordReset code <- case pending of Just p -> throwE $ pwResetError (PasswordResetInProgress . Just $ Code.codeTTL p) @@ -317,7 +317,7 @@ updateAccountEmail pid (Public.EmailUpdate new) = do Left _ -> throwStd (errorToWai @'E.InvalidEmail) let emailKey = mkEmailKey email wrapClientE (DB.lookupKey emailKey) >>= mapM_ (const $ throwStd emailExists) - gen <- Code.mkGen (Code.ForEmail email) + gen <- Code.mkGen email code <- Code.generate gen diff --git a/services/brig/src/Brig/Team/API.hs b/services/brig/src/Brig/Team/API.hs index 3b342f233c2..68b1328b8b4 100644 --- a/services/brig/src/Brig/Team/API.hs +++ b/services/brig/src/Brig/Team/API.hs @@ -37,7 +37,6 @@ import Brig.Effects.BlacklistStore qualified as BlacklistStore import Brig.Effects.ConnectionStore (ConnectionStore) import Brig.Effects.UserPendingActivationStore (UserPendingActivationStore) import Brig.Options (setMaxTeamSize, setTeamInvitationTimeout) -import Brig.Phone qualified as Phone import Brig.Team.DB qualified as DB import Brig.Team.Email import Brig.Team.Util (ensurePermissionToAddUser, ensurePermissions) @@ -243,7 +242,7 @@ createInvitation' tid mUid inviteeRole mbInviterUid fromEmail body = do -- Validate e-mail inviteeEmail <- either (const $ throwStd (errorToWai @'E.InvalidEmail)) pure (Email.validateEmail (irInviteeEmail body)) - let uke = userEmailKey inviteeEmail + let uke = mkEmailKey inviteeEmail blacklistedEm <- lift $ liftSem $ BlacklistStore.exists uke when blacklistedEm $ throwStd blacklistedEmail @@ -251,17 +250,6 @@ createInvitation' tid mUid inviteeRole mbInviterUid fromEmail body = do when emailTaken $ throwStd emailExists - -- Validate phone - inviteePhone <- for (irInviteePhone body) $ \p -> do - validatedPhone <- maybe (throwStd (errorToWai @'E.InvalidPhone)) pure =<< lift (wrapClient $ Phone.validatePhone p) - let ukp = userPhoneKey validatedPhone - blacklistedPh <- lift $ liftSem $ BlacklistStore.exists ukp - when blacklistedPh $ - throwStd (errorToWai @'E.BlacklistedPhone) - phoneTaken <- lift $ liftSem $ isJust <$> lookupKey ukp - when phoneTaken $ - throwStd phoneExists - pure validatedPhone maxSize <- setMaxTeamSize <$> view settings pending <- lift $ wrapClient $ DB.countInvitations tid when (fromIntegral pending >= maxSize) $ @@ -286,7 +274,7 @@ createInvitation' tid mUid inviteeRole mbInviterUid fromEmail body = do mbInviterUid inviteeEmail inviteeName - inviteePhone + Nothing -- ignore phone timeout (newInv, code) <$ sendInvitationMail inviteeEmail tid fromEmail code locale diff --git a/services/brig/src/Brig/User/Auth.hs b/services/brig/src/Brig/User/Auth.hs index 7f0a6c26e8d..362d5ac3c46 100644 --- a/services/brig/src/Brig/User/Auth.hs +++ b/services/brig/src/Brig/User/Auth.hs @@ -18,7 +18,6 @@ -- | High-level user authentication and access control. module Brig.User.Auth ( Access, - sendLoginCode, login, logout, renewAccess, @@ -27,7 +26,6 @@ module Brig.User.Auth verifyCode, -- * Internal - lookupLoginCode, ssoLogin, legalHoldLogin, @@ -43,14 +41,11 @@ import Brig.Budget import Brig.Code qualified as Code import Brig.Data.Activation qualified as Data import Brig.Data.Client -import Brig.Data.LoginCode qualified as Data import Brig.Data.User qualified as Data import Brig.Effects.ConnectionStore (ConnectionStore) import Brig.Options qualified as Opt -import Brig.Phone import Brig.Types.Intra import Brig.User.Auth.Cookie -import Brig.User.Phone import Brig.ZAuth qualified as ZAuth import Cassandra import Control.Error hiding (bool) @@ -81,56 +76,10 @@ import Wire.API.User.Auth.Sso import Wire.GalleyAPIAccess (GalleyAPIAccess) import Wire.GalleyAPIAccess qualified as GalleyAPIAccess import Wire.NotificationSubsystem -import Wire.PasswordStore (PasswordStore, lookupHashedPassword) +import Wire.PasswordStore (PasswordStore) import Wire.Sem.Paging.Cassandra (InternalPaging) import Wire.UserKeyStore import Wire.UserStore -import Wire.UserSubsystem (UserSubsystem, lookupLocaleWithDefault) - -sendLoginCode :: - ( Member TinyLog r, - Member UserKeyStore r, - Member PasswordStore r, - Member (Input (Local ())) r, - Member UserSubsystem r - ) => - Phone -> - Bool -> - Bool -> - ExceptT SendLoginCodeError (AppT r) PendingLoginCode -sendLoginCode phone call force = do - pk <- - maybe - (throwE $ SendLoginInvalidPhone phone) - (pure . userPhoneKey) - =<< lift (wrapHttpClient $ validatePhone phone) - user <- lift $ liftSem $ lookupKey pk - case user of - Nothing -> throwE $ SendLoginInvalidPhone phone - Just u -> do - lift . liftSem . Log.debug $ field "user" (toByteString u) . field "action" (val "User.sendLoginCode") - pw <- lift $ liftSem $ lookupHashedPassword u - unless (isNothing pw || force) $ - throwE SendLoginPasswordExists - l <- lift $ liftSem $ qualifyLocal' u >>= lookupLocaleWithDefault - lift $ wrapHttpClient $ do - c <- Data.createLoginCode u - void . forPhoneKey pk $ \ph -> - if call - then sendLoginCall ph (pendingLoginCode c) l - else sendLoginSms ph (pendingLoginCode c) l - pure c - -lookupLoginCode :: - (Member TinyLog r, Member UserKeyStore r) => - Phone -> - AppT r (Maybe PendingLoginCode) -lookupLoginCode phone = - liftSem (lookupKey (userPhoneKey phone)) >>= \case - Nothing -> pure Nothing - Just u -> do - liftSem $ Log.debug $ field "user" (toByteString u) . field "action" (val "User.lookupLoginCode") - wrapHttpClient $ Data.lookupLoginCode u login :: forall r. @@ -168,15 +117,9 @@ login (PasswordLogin (PasswordLoginData li pw label code)) typ = do VerificationCodeNoPendingCode -> wrapHttpClientE $ loginFailedWith LoginCodeInvalid uid VerificationCodeRequired -> wrapHttpClientE $ loginFailedWith LoginCodeRequired uid VerificationCodeNoEmail -> wrapHttpClientE $ loginFailed uid -login (SmsLogin (SmsLoginData phone code label)) typ = do - uid <- resolveLoginId (LoginByPhone phone) - lift . liftSem . Log.debug $ field "user" (toByteString uid) . field "action" (val "User.login") - wrapHttpClientE $ checkRetryLimit uid - ok <- wrapHttpClientE $ Data.verifyLoginCode uid code - unless ok $ - wrapHttpClientE $ - loginFailed uid - newAccess @ZAuth.User @ZAuth.Access uid Nothing typ label +login (SmsLogin _) _ = do + -- sms login not supported + throwE LoginFailed verifyCode :: forall r. @@ -194,7 +137,7 @@ verifyCode mbCode action uid = do when (featureEnabled && not isSsoUser) $ do case (mbCode, mbEmail) of (Just code, Just email) -> do - key <- Code.mkKey $ Code.ForEmail email + key <- Code.mkKey email codeValid <- isJust <$> wrapHttpClientE (Code.verify key (Code.scopeFromAction action) code) unless codeValid $ throwE VerificationCodeNoPendingCode (Nothing, _) -> throwE VerificationCodeRequired @@ -347,25 +290,23 @@ resolveLoginId li = do else LoginFailed Just uid -> pure uid -validateLoginId :: (MonadClient m, MonadReader Env m) => LoginId -> ExceptT LoginError m (Either UserKey Handle) +validateLoginId :: (MonadReader Env m) => LoginId -> ExceptT LoginError m (Either EmailKey Handle) validateLoginId (LoginByEmail email) = either (const $ throwE LoginFailed) - (pure . Left . userEmailKey) + (pure . Left . mkEmailKey) (validateEmail email) -validateLoginId (LoginByPhone phone) = - maybe - (throwE LoginFailed) - (pure . Left . userPhoneKey) - =<< lift (validatePhone phone) +validateLoginId (LoginByPhone _) = do + -- phone logins are not supported + throwE LoginFailed validateLoginId (LoginByHandle h) = pure (Right h) isPendingActivation :: (MonadClient m, MonadReader Env m) => LoginId -> m Bool isPendingActivation ident = case ident of (LoginByHandle _) -> pure False - (LoginByEmail e) -> checkKey (userEmailKey e) - (LoginByPhone p) -> checkKey (userPhoneKey p) + (LoginByEmail e) -> checkKey (mkEmailKey e) + (LoginByPhone _) -> pure False where checkKey k = do usr <- (>>= fst) <$> Data.lookupActivationCode k @@ -381,9 +322,7 @@ isPendingActivation ident = case ident of Ephemeral -> False PendingInvitation -> True in statusAdmitsPending && case i of - Just (EmailIdentity e) -> userEmailKey e /= k - Just (PhoneIdentity p) -> userPhoneKey p /= k - Just (FullIdentity e p) -> userEmailKey e /= k && userPhoneKey p /= k + Just (EmailIdentity e) -> mkEmailKey e /= k Just SSOIdentity {} -> False -- sso-created users are activated immediately. Nothing -> True diff --git a/services/brig/src/Brig/User/EJPD.hs b/services/brig/src/Brig/User/EJPD.hs index 4b9ec8fcb4b..880fc7d4618 100644 --- a/services/brig/src/Brig/User/EJPD.hs +++ b/services/brig/src/Brig/User/EJPD.hs @@ -147,7 +147,7 @@ ejpdRequest (fromMaybe False -> includeContacts) (EJPDRequestBody handles) = do ejpdResponseRootName = userDisplayName target, ejpdResponseRootHandle = userHandle target, ejpdResponseRootEmail = userEmail target, - ejpdResponseRootPhone = userPhone target, + ejpdResponseRootPhone = Nothing, ejpdResponseRootPushTokens = Set.fromList ptoks, ejpdResponseRootContacts = mbContacts, ejpdResponseRootTeamContacts = mbTeamContacts, diff --git a/services/brig/src/Brig/User/Phone.hs b/services/brig/src/Brig/User/Phone.hs deleted file mode 100644 index 8616c000ea2..00000000000 --- a/services/brig/src/Brig/User/Phone.hs +++ /dev/null @@ -1,279 +0,0 @@ -{-# LANGUAGE RecordWildCards #-} - --- This file is part of the Wire Server implementation. --- --- Copyright (C) 2022 Wire Swiss GmbH --- --- This program is free software: you can redistribute it and/or modify it under --- the terms of the GNU Affero General Public License as published by the Free --- Software Foundation, either version 3 of the License, or (at your option) any --- later version. --- --- This program is distributed in the hope that it will be useful, but WITHOUT --- ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS --- FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for more --- details. --- --- You should have received a copy of the GNU Affero General Public License along --- with this program. If not, see . - -module Brig.User.Phone - ( ActivationSms (..), - sendActivationSms, - PasswordResetSms (..), - sendPasswordResetSms, - LoginSms (..), - sendLoginSms, - ActivationCall (..), - sendActivationCall, - LoginCall (..), - sendLoginCall, - DeletionSms (..), - sendDeletionSms, - - -- * Re-exports - validatePhone, - ) -where - -import Brig.App -import Brig.Phone -import Brig.Template -import Brig.Types.Activation -import Brig.Types.User -import Brig.User.Template -import Cassandra (MonadClient) -import Control.Lens (view) -import Control.Monad.Catch -import Data.Code qualified as Code -import Data.Range -import Data.Text qualified as Text -import Data.Text.Ascii qualified as Ascii -import Data.Text.Lazy (toStrict) -import Data.Text.Template (render) -import Imports -import Prometheus (MonadMonitor) -import Ropes.Nexmo qualified as Nexmo -import System.Logger.Class qualified as Log -import Wire.API.User -import Wire.API.User.Activation -import Wire.API.User.Auth -import Wire.API.User.Password -import Wire.EmailSmsSubsystem.Template (TemplateBranding, renderTextWithBranding) - -sendActivationSms :: - ( MonadClient m, - MonadReader Env m, - MonadCatch m, - Log.MonadLogger m, - MonadMonitor m - ) => - Phone -> - ActivationPair -> - Maybe Locale -> - m () -sendActivationSms to (_, c) loc = do - branding <- view templateBranding - (loc', tpl) <- userTemplates loc - sendSms loc' $ renderActivationSms (ActivationSms to c) (activationSms tpl) branding - -sendPasswordResetSms :: - ( MonadClient m, - MonadReader Env m, - MonadCatch m, - Log.MonadLogger m, - MonadMonitor m - ) => - Phone -> - PasswordResetPair -> - Maybe Locale -> - m () -sendPasswordResetSms to (_, c) loc = do - branding <- view templateBranding - (loc', tpl) <- userTemplates loc - sendSms loc' $ renderPasswordResetSms (PasswordResetSms to c) (passwordResetSms tpl) branding - -sendLoginSms :: - ( MonadClient m, - MonadReader Env m, - MonadCatch m, - Log.MonadLogger m, - MonadMonitor m - ) => - Phone -> - LoginCode -> - Maybe Locale -> - m () -sendLoginSms to code loc = do - branding <- view templateBranding - (loc', tpl) <- userTemplates loc - sendSms loc' $ renderLoginSms (LoginSms to code) (loginSms tpl) branding - -sendDeletionSms :: - ( MonadClient m, - MonadReader Env m, - MonadCatch m, - Log.MonadLogger m, - MonadMonitor m - ) => - Phone -> - Code.Key -> - Code.Value -> - Locale -> - m () -sendDeletionSms to key code loc = do - branding <- view templateBranding - (loc', tpl) <- userTemplates (Just loc) - sendSms loc' $ renderDeletionSms (DeletionSms to key code) (deletionSms tpl) branding - -sendActivationCall :: - ( MonadClient m, - MonadReader Env m, - Log.MonadLogger m, - MonadMonitor m - ) => - Phone -> - ActivationPair -> - Maybe Locale -> - m () -sendActivationCall to (_, c) loc = do - branding <- view templateBranding - (loc', tpl) <- userTemplates loc - sendCall $ renderActivationCall (ActivationCall to c) (activationCall tpl) loc' branding - -sendLoginCall :: - ( MonadClient m, - MonadReader Env m, - Log.MonadLogger m, - MonadMonitor m - ) => - Phone -> - LoginCode -> - Maybe Locale -> - m () -sendLoginCall to c loc = do - branding <- view templateBranding - (loc', tpl) <- userTemplates loc - sendCall $ renderLoginCall (LoginCall to c) (loginCall tpl) loc' branding - -------------------------------------------------------------------------------- --- Activation SMS - -data ActivationSms = ActivationSms - { actSmsTo :: !Phone, - actSmsCode :: !ActivationCode - } - -renderActivationSms :: ActivationSms -> ActivationSmsTemplate -> TemplateBranding -> SMSMessage -renderActivationSms ActivationSms {..} (ActivationSmsTemplate url t from) branding = - SMSMessage from (fromPhone actSmsTo) (toStrict $ renderTextWithBranding t replace branding) - where - replace "code" = codeText - replace "url" = renderSmsActivationUrl url codeText - replace x = x - codeText = Ascii.toText (fromActivationCode actSmsCode) - -------------------------------------------------------------------------------- --- Password Reset SMS - -data PasswordResetSms = PasswordResetSms - { pwrSmsTo :: !Phone, - pwrSmsCode :: !PasswordResetCode - } - -renderPasswordResetSms :: PasswordResetSms -> PasswordResetSmsTemplate -> TemplateBranding -> SMSMessage -renderPasswordResetSms PasswordResetSms {..} (PasswordResetSmsTemplate t from) branding = - SMSMessage from (fromPhone pwrSmsTo) (toStrict $ renderTextWithBranding t replace branding) - where - replace "code" = Ascii.toText (fromPasswordResetCode pwrSmsCode) - replace x = x - -------------------------------------------------------------------------------- --- Login SMS - -data LoginSms = LoginSms - { loginSmsTo :: !Phone, - loginSmsCode :: !LoginCode - } - -renderLoginSms :: LoginSms -> LoginSmsTemplate -> TemplateBranding -> SMSMessage -renderLoginSms LoginSms {..} (LoginSmsTemplate url t from) branding = - SMSMessage from (fromPhone loginSmsTo) (toStrict $ renderTextWithBranding t replace branding) - where - replace "code" = fromLoginCode loginSmsCode - replace "url" = renderSmsActivationUrl url (fromLoginCode loginSmsCode) - replace x = x - -------------------------------------------------------------------------------- --- Deletion SMS - -data DeletionSms = DeletionSms - { delSmsTo :: !Phone, - delSmsKey :: !Code.Key, - delSmsCode :: !Code.Value - } - -renderDeletionSms :: DeletionSms -> DeletionSmsTemplate -> TemplateBranding -> SMSMessage -renderDeletionSms DeletionSms {..} (DeletionSmsTemplate url txt from) branding = - SMSMessage from (fromPhone delSmsTo) (toStrict $ renderTextWithBranding txt replace1 branding) - where - replace1 "code" = Ascii.toText (fromRange (Code.asciiValue delSmsCode)) - replace1 "url" = toStrict (render url replace2) - replace1 x = x - replace2 "key" = Ascii.toText (fromRange (Code.asciiKey delSmsKey)) - replace2 "code" = Ascii.toText (fromRange (Code.asciiValue delSmsCode)) - replace2 x = x - -------------------------------------------------------------------------------- --- Activation Call - -data ActivationCall = ActivationCall - { actCallTo :: !Phone, - actCallCode :: !ActivationCode - } - -renderActivationCall :: ActivationCall -> ActivationCallTemplate -> Locale -> TemplateBranding -> Nexmo.Call -renderActivationCall ActivationCall {..} (ActivationCallTemplate t) loc branding = - Nexmo.Call - Nothing - (fromPhone actCallTo) - (toStrict $ renderTextWithBranding t replace branding) - (Just . Text.toLower $ locToText loc) - (Just 1) - where - replace "code" = toPinPrompt $ Ascii.toText (fromActivationCode actCallCode) - replace x = x - -------------------------------------------------------------------------------- --- Login Call - -data LoginCall = LoginCall - { loginCallTo :: !Phone, - loginCallCode :: !LoginCode - } - -renderLoginCall :: LoginCall -> LoginCallTemplate -> Locale -> TemplateBranding -> Nexmo.Call -renderLoginCall LoginCall {..} (LoginCallTemplate t) loc branding = - Nexmo.Call - Nothing - (fromPhone loginCallTo) - (toStrict $ renderTextWithBranding t replace branding) - (Just . Text.toLower $ locToText loc) - (Just 1) - where - replace "code" = toPinPrompt $ fromLoginCode loginCallCode - replace x = x - --- Common Prompt rendering - -toPinPrompt :: Text -> Text -toPinPrompt = Text.intercalate "" . Text.chunksOf 1 - --- Common URL rendering - -renderSmsActivationUrl :: Template -> Text -> Text -renderSmsActivationUrl t c = - toStrict $ render t replace - where - replace "code" = c - replace x = x diff --git a/services/brig/test/integration/API/Provider.hs b/services/brig/test/integration/API/Provider.hs index f3a0873d447..9f9b3b342cf 100644 --- a/services/brig/test/integration/API/Provider.hs +++ b/services/brig/test/integration/API/Provider.hs @@ -263,7 +263,7 @@ testPasswordResetProvider db brig = do resetPw :: PlainTextPassword6 -> Email -> Http ResponseLBS resetPw newPw email = do -- Get the code directly from the DB - gen <- Code.mkGen (Code.ForEmail email) + gen <- Code.mkGen email Just vcode <- lookupCode db gen Code.PasswordReset let passwordResetData = CompletePasswordReset @@ -281,7 +281,7 @@ testPasswordResetAfterEmailUpdateProvider db brig = do initiateEmailUpdateProvider brig pid (EmailUpdate newEmail) !!! const 202 === statusCode initiatePasswordResetProvider brig (PasswordReset origEmail) !!! const 201 === statusCode -- Get password reset code directly from the DB - genOrig <- Code.mkGen (Code.ForEmail origEmail) + genOrig <- Code.mkGen origEmail Just vcodePw <- lookupCode db genOrig Code.PasswordReset let passwordResetData = CompletePasswordReset @@ -289,7 +289,7 @@ testPasswordResetAfterEmailUpdateProvider db brig = do (Code.codeValue vcodePw) (plainTextPassword6Unsafe "doesnotmatter") -- Activate the new email - genNew <- Code.mkGen (Code.ForEmail newEmail) + genNew <- Code.mkGen newEmail Just vcodeEm <- lookupCode db genNew Code.IdentityVerification activateProvider brig (Code.codeKey vcodeEm) (Code.codeValue vcodeEm) !!! const 200 === statusCode @@ -1675,7 +1675,7 @@ testRegisterProvider db' brig = do case db' of Just db -> do -- Activate email - gen <- Code.mkGen (Code.ForEmail email) + gen <- Code.mkGen email Just vcode <- lookupCode db gen Code.IdentityVerification activateProvider brig (Code.codeKey vcode) (Code.codeValue vcode) !!! const 200 === statusCode @@ -1713,7 +1713,7 @@ testRegisterProvider db' brig = do randomProvider :: (HasCallStack) => DB.ClientState -> Brig -> Http Provider randomProvider db brig = do email <- randomEmail - gen <- Code.mkGen (Code.ForEmail email) + gen <- Code.mkGen email -- Register let new = defNewProvider email _rs <- diff --git a/services/brig/test/integration/API/Team.hs b/services/brig/test/integration/API/Team.hs index bac96f9d766..6eafdb1ed9c 100644 --- a/services/brig/test/integration/API/Team.hs +++ b/services/brig/test/integration/API/Team.hs @@ -100,7 +100,6 @@ tests conf m n b c g aws = do test m "post /teams/:tid/invitations - roles" $ testInvitationRoles b g, test m "post /register - 201 accepted" $ testInvitationEmailAccepted b g, test m "post /register - 201 accepted (with domain blocking customer extension)" $ testInvitationEmailAcceptedInBlockedDomain conf b g, - test m "post /register - 201 extended accepted" $ testInvitationEmailAndPhoneAccepted b g, test m "post /register user & team - 201 accepted" $ testCreateTeam b g aws, test m "post /register user & team - 201 preverified" $ testCreateTeamPreverified b g aws, test m "post /register - 400 no passwordless" $ testTeamNoPassword b, @@ -445,25 +444,6 @@ testInvitationEmailAcceptedInBlockedDomain opts brig galley = do replacementBrigApp = withDomainsBlockedForRegistration opts [emailDomain inviteeEmail] void $ createAndVerifyInvitation' (Just replacementBrigApp) (accept (irInviteeEmail invite)) invite brig galley -testInvitationEmailAndPhoneAccepted :: Brig -> Galley -> Http () -testInvitationEmailAndPhoneAccepted brig galley = do - inviteeEmail <- randomEmail - inviteePhone <- randomPhone - -- Prepare the extended invitation - let stdInvite = stdInvitationRequest inviteeEmail - inviteeName = Name "Invited Member" - extInvite = stdInvite {irInviteePhone = Just inviteePhone, irInviteeName = Just inviteeName} - -- Register the same (pre verified) phone number - let phoneReq = RequestBodyLBS . encode $ object ["phone" .= fromPhone inviteePhone] - post (brig . path "/activate/send" . contentJson . body phoneReq) !!! (const 200 === statusCode) - Just (_, phoneCode) <- getActivationCode brig (Right inviteePhone) - -- Register the user with the extra supplied information - (profile, invitation) <- createAndVerifyInvitation (extAccept inviteeEmail inviteeName inviteePhone phoneCode) extInvite brig galley - liftIO $ assertEqual "Wrong name in profile" (Just inviteeName) (userDisplayName . selfUser <$> profile) - liftIO $ assertEqual "Wrong name in invitation" (Just inviteeName) (inInviteeName invitation) - liftIO $ assertEqual "Wrong phone number in profile" (Just inviteePhone) ((userPhone . selfUser) =<< profile) - liftIO $ assertEqual "Wrong phone number in invitation" (Just inviteePhone) (inInviteePhone invitation) - -- | FUTUREWORK: this is an alternative helper to 'createPopulatedBindingTeam'. it has been -- added concurrently, and the two should probably be consolidated. createAndVerifyInvitation :: diff --git a/services/brig/test/integration/API/TeamUserSearch.hs b/services/brig/test/integration/API/TeamUserSearch.hs index a1ac62c58b3..b70f59a4b17 100644 --- a/services/brig/test/integration/API/TeamUserSearch.hs +++ b/services/brig/test/integration/API/TeamUserSearch.hs @@ -53,7 +53,7 @@ tests opts mgr _galley brig = do where testWithNewIndex name f = test mgr name $ withSettingsOverrides opts f -testSearchByEmail :: (TestConstraints m) => Brig -> m (TeamId, UserId, User) -> Bool -> m () +testSearchByEmail :: (HasCallStack, TestConstraints m) => Brig -> m (TeamId, UserId, User) -> Bool -> m () testSearchByEmail brig mkSearcherAndSearchee canFind = do (tid, searcher, searchee) <- mkSearcherAndSearchee eml <- randomEmail @@ -63,7 +63,7 @@ testSearchByEmail brig mkSearcherAndSearchee canFind = do let check = if canFind then assertTeamUserSearchCanFind else assertTeamUserSearchCannotFind check brig tid searcher (userId searchee) (fromEmail eml) -testSearchByEmailSameTeam :: (TestConstraints m) => Brig -> m () +testSearchByEmailSameTeam :: (HasCallStack, TestConstraints m) => Brig -> m () testSearchByEmailSameTeam brig = do let mkSearcherAndSearchee = do (tid, userId -> ownerId, [u1]) <- createPopulatedBindingTeamWithNamesAndHandles brig 1 diff --git a/services/brig/test/integration/API/User/Account.hs b/services/brig/test/integration/API/User/Account.hs index 3a9047d1f92..8e46b4437dd 100644 --- a/services/brig/test/integration/API/User/Account.hs +++ b/services/brig/test/integration/API/User/Account.hs @@ -31,7 +31,6 @@ import Brig.AWS qualified as AWS import Brig.AWS.Types import Brig.Options qualified as Opt import Brig.Types.Activation -import Brig.Types.Common import Brig.Types.Intra import Control.Arrow ((&&&)) import Control.Exception (throw) @@ -51,7 +50,6 @@ import Data.Json.Util (fromUTCTimeMillis) import Data.LegalHold import Data.List.NonEmpty qualified as NonEmpty import Data.List1 (singleton) -import Data.List1 qualified as List1 import Data.Misc (plainTextPassword6Unsafe) import Data.Proxy import Data.Qualified @@ -86,7 +84,6 @@ import Wire.API.Asset hiding (Asset) import Wire.API.Asset qualified as Asset import Wire.API.Connection import Wire.API.Conversation -import Wire.API.Internal.Notification import Wire.API.Routes.MultiTablePaging import Wire.API.Team.Feature (ExposeInvitationURLsToTeamAdminConfig (..), FeatureStatus (..), FeatureTTL' (..), LockStatus (LockStatusLocked), withStatus) import Wire.API.Team.Invitation (Invitation (inInvitation)) @@ -104,7 +101,7 @@ tests _ at opts p b c ch g aws userJournalWatcher = [ test p "post /register - 201 (with preverified)" $ testCreateUserWithPreverified opts b userJournalWatcher, test p "testCreateUserWithInvalidVerificationCode - post /register - 400 (with preverified)" $ testCreateUserWithInvalidVerificationCode b, test p "post /register - 201" $ testCreateUser b g, - test p "post /register - 201 + no email" $ testCreateUserNoEmailNoPassword b, + test p "post /register - 400 + no email" $ testCreateUserNoEmailNoPassword b, test p "post /register - 201 anonymous" $ testCreateUserAnon b g, test p "testCreateUserEmptyName - post /register - 400 empty name" $ testCreateUserEmptyName b, test p "testCreateUserLongName - post /register - 400 name too long" $ testCreateUserLongName b, @@ -132,22 +129,17 @@ tests _ at opts p b c ch g aws userJournalWatcher = test p "post /list-users - 200" $ testMultipleUsers opts b, test p "put /self - 200" $ testUserUpdate b c userJournalWatcher, test p "put /access/self/email - 2xx" $ testEmailUpdate b userJournalWatcher, - test p "put /self/phone - 202" $ testPhoneUpdate b, - test p "put /self/phone - 403" $ testPhoneUpdateBlacklisted b, - test p "put /self/phone - 409" $ testPhoneUpdateConflict b, + test p "put /self/phone - 400" $ testPhoneUpdate b, test p "head /self/password - 200/404" $ testPasswordSet b, test p "put /self/password - 400" $ testPasswordSetInvalidPasswordLength b, test p "put /self/password - 200" $ testPasswordChange b, test p "put /self/locale - 200" $ testUserLocaleUpdate b userJournalWatcher, test p "post /activate/send - 200" $ testSendActivationCode opts b, test p "post /activate/send - 400 invalid input" $ testSendActivationCodeInvalidEmailOrPhone b, - test p "post /activate/send - 403 prefix excluded" $ testSendActivationCodePrefixExcluded b, - test p "post /i/users/phone-prefix" $ testInternalPhonePrefixes b, test p "put /i/users/:uid/status (suspend)" $ testSuspendUser b, - test p "get /i/users?:(email|phone) - 200" $ testGetByIdentity b, + test p "get /i/users?:email - 200" $ testGetByIdentity b, -- "get /i/users?:ids=...&includePendingInvitations=..." is tested in 'testCreateUserNoIdP', 'testCreateUserTimeout' -- in spar's integration tests, module "Test.Spar.Scim.UserSpec" - test p "delete/phone-email" $ testEmailPhoneDelete b c, test p "delete/by-password" $ testDeleteUserByPassword b c userJournalWatcher, test p "delete/with-legalhold" $ testDeleteUserWithLegalHold b c userJournalWatcher, test p "delete/by-code" $ testDeleteUserByCode b, @@ -185,7 +177,10 @@ testCreateUserWithInvalidVerificationCode brig = do "phone" .= fromPhone p, "phone_code" .= code ] - postUserRegister' regPhone brig !!! const 404 === statusCode + postUserRegister' regPhone brig !!! do + const 400 === statusCode + const (Just "invalid-phone") === fmap Wai.label . responseJsonMaybe + -- Attempt to register (pre verified) user with email e <- randomEmail let Object regEmail = @@ -247,29 +242,10 @@ testCreateUserWithPreverified opts brig userJournalWatcher = do p <- randomPhone let phoneReq = RequestBodyLBS . encode $ object ["phone" .= fromPhone p] post (brig . path "/activate/send" . contentJson . body phoneReq) - !!! (const 200 === statusCode) - getActivationCode brig (Right p) >>= \case - Nothing -> liftIO $ assertFailure "missing activation key/code" - Just (_, c) -> do - let Object reg = - object - [ "name" .= Name "Alice", - "phone" .= fromPhone p, - "phone_code" .= c - ] - if Opt.setRestrictUserCreation (Opt.optSettings opts) == Just True - then do - postUserRegister' reg brig !!! const 403 === statusCode - else do - usr <- postUserRegister reg brig - let uid = userId usr - let domain = Opt.setFederationDomain $ Opt.optSettings opts - get (brig . path "/self" . zUser uid) !!! do - const 200 === statusCode - const (Just p) === (userPhone <=< responseJsonMaybe) - -- check /self returns the qualified_id field in the response - const (Just (Qualified uid domain)) === (fmap userQualifiedId . responseJsonMaybe) - Util.assertUserActivateJournaled userJournalWatcher usr "user activate" + !!! do + const 400 === statusCode + const (Just "invalid-phone") === fmap Wai.label . responseJsonMaybe + -- Register (pre verified) user with email e <- randomEmail let emailReq = RequestBodyLBS . encode $ object ["email" .= fromEmail e] @@ -422,16 +398,11 @@ testCreateUserNoEmailNoPassword brig = do [ "name" .= ("Alice" :: Text), "phone" .= fromPhone p ] - rs <- - post (brig . path "/i/users" . contentJson . body newUser) - responseJsonMaybe rs - e <- randomEmail - Just code <- do - sendLoginCode brig p LoginCodeSMS False !!! const 200 === statusCode - getPhoneLoginCode brig p - initiateEmailUpdateLogin brig e (SmsLogin (SmsLoginData p code Nothing)) uid - !!! (const 202 === statusCode) + post + (brig . path "/i/users" . contentJson . body newUser) + !!! do + const 400 === statusCode + (const (Just "invalid-phone") === fmap Error.label . responseJsonMaybe) -- The testCreateUserConflict test conforms to the following testing standards: -- @@ -995,37 +966,6 @@ testPhoneUpdate brig = do -- check new phone get (brig . path "/self" . zUser uid) !!! do const 200 === statusCode - const (Just phn) === (userPhone <=< responseJsonMaybe) - -testPhoneUpdateBlacklisted :: Brig -> Http () -testPhoneUpdateBlacklisted brig = do - uid <- userId <$> randomUser brig - phn <- randomPhone - let prefix = mkPrefix $ T.take 5 (fromPhone phn) - - insertPrefix brig prefix - let phoneUpdate = RequestBodyLBS . encode $ PhoneUpdate phn - put (brig . path "/self/phone" . contentJson . zUser uid . zConn "c" . body phoneUpdate) - !!! (const 403 === statusCode) - - -- check that phone is not updated - get (brig . path "/self" . zUser uid) !!! do - const 200 === statusCode - const (Right Nothing) === fmap userPhone . responseJsonEither - - -- cleanup to avoid other tests failing sporadically - deletePrefix brig (phonePrefix prefix) - -testPhoneUpdateConflict :: Brig -> Http () -testPhoneUpdateConflict brig = do - uid1 <- userId <$> randomUser brig - phn <- randomPhone - updatePhone brig uid1 phn - - uid2 <- userId <$> randomUser brig - let phoneUpdate = RequestBodyLBS . encode $ PhoneUpdate phn - put (brig . path "/self/phone" . contentJson . zUser uid2 . zConn "c" . body phoneUpdate) - !!! (const 409 === statusCode) testCreateAccountPendingActivationKey :: Opt.Opts -> Brig -> Http () testCreateAccountPendingActivationKey (Opt.setRestrictUserCreation . Opt.optSettings -> Just True) _ = pure () @@ -1035,23 +975,9 @@ testCreateAccountPendingActivationKey _ brig = do -- update phone let phoneUpdate = RequestBodyLBS . encode $ PhoneUpdate phn put (brig . path "/self/phone" . contentJson . zUser uid . zConn "c" . body phoneUpdate) - !!! (const 202 === statusCode) - -- create a new user with that phone/code - act <- getActivationCode brig (Right phn) - case act of - Nothing -> liftIO $ assertFailure "missing activation key/code" - Just kc@(_, c) -> do - let p = - RequestBodyLBS . encode $ - object - [ "name" .= ("foo" :: Text), - "phone" .= phn, - "phone_code" .= c - ] - post (brig . path "/register" . contentJson . body p) - !!! const 201 === statusCode - -- try to activate already active phone - activate brig kc !!! const 409 === statusCode + !!! do + const 400 === statusCode + const (Just "invalid-phone") === fmap Error.label . responseJsonMaybe testUserLocaleUpdate :: Brig -> UserJournalWatcher -> Http () testUserLocaleUpdate brig userJournalWatcher = do @@ -1105,15 +1031,12 @@ testSuspendUser brig = do testGetByIdentity :: Brig -> Http () testGetByIdentity brig = do - p <- randomPhone e <- randomEmail let emailBs = T.encodeUtf8 $ fromEmail e - phoneBs = T.encodeUtf8 $ fromPhone p newUser = RequestBodyLBS . encode $ object [ "name" .= ("Alice" :: Text), - "phone" .= fromPhone p, "email" .= fromEmail e ] rs <- @@ -1123,20 +1046,17 @@ testGetByIdentity brig = do get (brig . zUser uid . path "i/users" . queryItem "email" emailBs) !!! do const 200 === statusCode const (Just [uid]) === getUids - get (brig . zUser uid . path "i/users" . queryItem "phone" phoneBs) !!! do - const 200 === statusCode - const (Just [uid]) === getUids where getUids r = fmap (userId . accountUser) <$> responseJsonMaybe r testPasswordSet :: Brig -> Http () testPasswordSet brig = do - p <- randomPhone + e <- randomEmail let newUser = RequestBodyLBS . encode $ object [ "name" .= ("Alice" :: Text), - "phone" .= fromPhone p + "email" .= fromEmail e ] rs <- post (brig . path "/i/users" . contentJson . body newUser) @@ -1160,12 +1080,12 @@ testPasswordSet brig = do testPasswordSetInvalidPasswordLength :: Brig -> Http () testPasswordSetInvalidPasswordLength brig = do - p <- randomPhone + e <- randomEmail let newUser = RequestBodyLBS . encode $ object [ "name" .= ("Alice" :: Text), - "phone" .= fromPhone p + "email" .= fromEmail e ] rs <- post (brig . path "/i/users" . contentJson . body newUser) @@ -1221,7 +1141,7 @@ testPasswordChange brig = do testSendActivationCode :: Opt.Opts -> Brig -> Http () testSendActivationCode opts brig = do -- Code for phone pre-verification - requestActivationCode brig 200 . Right =<< randomPhone + requestActivationCode brig 400 . Right =<< randomPhone -- Code for email pre-verification requestActivationCode brig 200 . Left =<< randomEmail -- Standard email registration flow @@ -1243,113 +1163,6 @@ testSendActivationCodeInvalidEmailOrPhone brig = do -- Code for email pre-verification requestActivationCode brig 400 (Left invalidEmail) -testSendActivationCodePrefixExcluded :: Brig -> Http () -testSendActivationCodePrefixExcluded brig = do - p <- randomPhone - let prefix = mkPrefix $ T.take 5 (fromPhone p) - -- expect activation to fail after it was excluded - insertPrefix brig prefix - requestActivationCode brig 403 (Right p) - -- expect activation to work again after removing block - deletePrefix brig (phonePrefix prefix) - requestActivationCode brig 200 (Right p) - -testInternalPhonePrefixes :: Brig -> Http () -testInternalPhonePrefixes brig = do - -- prefix1 is a prefix of prefix2 - let prefix1 = mkPrefix "+5678" - prefix2 = mkPrefix "+56789" - insertPrefix brig prefix1 - insertPrefix brig prefix2 - -- test getting prefixs - res <- getPrefixes prefix1 - liftIO $ assertEqual "prefix match prefix" res [prefix1] - -- we expect both prefixes returned when searching for the longer one - res2 <- getPrefixes prefix2 - liftIO $ assertEqual "prefix match phone number" res2 [prefix1, prefix2] - deletePrefix brig (phonePrefix prefix1) - deletePrefix brig (phonePrefix prefix2) - getPrefix (phonePrefix prefix1) !!! const 404 === statusCode - where - getPrefixes :: ExcludedPrefix -> Http [ExcludedPrefix] - getPrefixes prefix = responseJsonError =<< getPrefix (phonePrefix prefix) - getPrefix :: PhonePrefix -> Http ResponseLBS - getPrefix prefix = get (brig . paths ["/i/users/phone-prefixes", toByteString' prefix]) - -mkPrefix :: Text -> ExcludedPrefix -mkPrefix t = ExcludedPrefix (PhonePrefix t) "comment" - -insertPrefix :: Brig -> ExcludedPrefix -> Http () -insertPrefix brig prefix = do - let payload = body $ RequestBodyLBS (encode prefix) - post (brig . path "/i/users/phone-prefixes" . contentJson . payload) !!! const 200 === statusCode - -deletePrefix :: Brig -> PhonePrefix -> Http () -deletePrefix brig prefix = delete (brig . paths ["/i/users/phone-prefixes", toByteString' prefix]) !!! const 200 === statusCode - -testEmailPhoneDelete :: Brig -> Cannon -> Http () -testEmailPhoneDelete brig cannon = do - user <- randomUser brig - let uid = userId user - let Just email = userEmail user - (cky, tok) <- do - rsp <- - login brig (emailLogin email defPassword Nothing) PersistentCookie - liftIO $ assertFailure "missing activation key/code" - Just kc -> activate brig kc !!! const 200 === statusCode - -- Remove the email - WS.bracketR cannon uid $ \ws -> do - delete (brig . path "/self/email" . zUser uid . zConn "c") - !!! (const 200 === statusCode) - void . liftIO . WS.assertMatch (5 # Second) ws $ \n -> do - let j = Object $ List1.head (ntfPayload n) - let etype = j ^? key "type" . _String - let euser = j ^? key "user" . key "id" . _String - let eemail = j ^? key "user" . key "email" . _String - etype @?= Just "user.identity-remove" - euser @?= Just (UUID.toText (toUUID uid)) - eemail @?= Just (fromEmail email) - get (brig . path "/self" . zUser uid) !!! do - const 200 === statusCode - const Nothing === (userEmail <=< responseJsonMaybe) - -- Cannot remove the only remaining identity - delete (brig . path "/self/phone" . zUser uid . zConn "c") - !!! const 403 === statusCode - -- Add back a new email address - eml <- randomEmail - initiateEmailUpdateCreds brig eml (cky, tok) uid !!! (const 202 === statusCode) - act' <- getActivationCode brig (Left eml) - case act' of - Nothing -> liftIO $ assertFailure "missing activation key/code" - Just kc -> activate brig kc !!! const 200 === statusCode - -- Remove the phone number - WS.bracketR cannon uid $ \ws -> do - delete (brig . path "/self/phone" . zUser uid . zConn "c") - !!! const 200 === statusCode - void . liftIO . WS.assertMatch (5 # Second) ws $ \n -> do - let j = Object $ List1.head (ntfPayload n) - let etype = j ^? key "type" . _String - let euser = j ^? key "user" . key "id" . _String - let ephone = j ^? key "user" . key "phone" . _String - etype @?= Just "user.identity-remove" - euser @?= Just (UUID.toText (toUUID uid)) - ephone @?= Just (fromPhone phone) - get (brig . path "/self" . zUser uid) !!! do - const 200 === statusCode - const Nothing === (userPhone <=< responseJsonMaybe) - testDeleteUserByPassword :: Brig -> Cannon -> UserJournalWatcher -> Http () testDeleteUserByPassword brig cannon userJournalWatcher = do u <- randomUser brig @@ -1490,11 +1303,10 @@ testUpdateSSOId brig galley = do ) !!! const 200 === statusCode profile :: SelfProfile <- responseJsonError =<< get (brig . path "/self" . zUser uid) - let Just (SSOIdentity ssoid' mEmail mPhone) = userIdentity . selfUser $ profile + let Just (SSOIdentity ssoid' mEmail) = userIdentity . selfUser $ profile liftIO $ do assertEqual "updateSSOId/ssoid" ssoid ssoid' assertEqual "updateSSOId/email" (userEmail user) mEmail - assertEqual "updateSSOId/phone" (userPhone user) mPhone (owner, teamid) <- createUserWithTeam brig let mkMember :: Bool -> Bool -> Http User mkMember hasEmail hasPhone = do @@ -1508,11 +1320,9 @@ testUpdateSSOId brig galley = do ssoids2 = [UserSSOId (mkSampleUref "2" "1"), UserSSOId (mkSampleUref "2" "2")] users <- sequence - [ mkMember True False, - mkMember True True - -- the following two could be implemented by creating the user implicitly via SSO login. - -- , mkMember False False - -- , mkMember False True + [ mkMember True False + -- the following two could be implemented by creating the user implicitly via SSO login. + -- , mkMember False False ] zipWithM_ go users ssoids1 zipWithM_ go users ssoids2 diff --git a/services/brig/test/integration/API/User/Auth.hs b/services/brig/test/integration/API/User/Auth.hs index 8020c56360b..966481ef84d 100644 --- a/services/brig/test/integration/API/User/Auth.hs +++ b/services/brig/test/integration/API/User/Auth.hs @@ -28,7 +28,6 @@ import API.Team.Util import Bilge hiding (body) import Bilge qualified as Http import Bilge.Assert hiding (assert) -import Brig.Code qualified as Code import Brig.Options qualified as Opts import Brig.ZAuth (ZAuth, runZAuth) import Brig.ZAuth qualified as ZAuth @@ -367,15 +366,11 @@ testPhoneLogin brig = do [ "name" .= ("Alice" :: Text), "phone" .= fromPhone p ] + -- phone logins are not supported anymore post (brig . path "/i/users" . contentJson . Http.body newUser) - !!! const 201 === statusCode - sendLoginCode brig p LoginCodeSMS False !!! const 200 === statusCode - code <- getPhoneLoginCode brig p - case code of - Nothing -> liftIO $ assertFailure "missing login code" - Just c -> - login brig (SmsLogin (SmsLoginData p c Nothing)) PersistentCookie - !!! const 200 === statusCode + !!! do + const 400 === statusCode + const (Just "invalid-phone") === errorLabel testHandleLogin :: Brig -> Http () testHandleLogin brig = do @@ -408,24 +403,9 @@ testSendLoginCode brig = do "password" .= ("topsecretdefaultpassword" :: Text) ] post (brig . path "/i/users" . contentJson . Http.body newUser) - !!! const 201 === statusCode - -- Unless forcing it, SMS/voice code login is not permitted if - -- the user has a password. - sendLoginCode brig p LoginCodeSMS False !!! do - const 403 === statusCode - const (Just "password-exists") === errorLabel - rsp1 <- - sendLoginCode brig p LoginCodeSMS True - responseJsonMaybe rsp1 - liftIO $ assertEqual "timeout" (Just (Code.Timeout 600)) _timeout - -- Retry with a voice call - rsp2 <- - sendLoginCode brig p LoginCodeVoice True - responseJsonMaybe rsp2 - liftIO $ assertEqual "timeout" (Just (Code.Timeout 600)) _timeout + !!! do + const 400 === statusCode + const (Just "invalid-phone") === errorLabel -- The testLoginFailure test conforms to the following testing standards: -- diff --git a/services/brig/test/integration/API/User/Client.hs b/services/brig/test/integration/API/User/Client.hs index cf4172263bc..c992714c106 100644 --- a/services/brig/test/integration/API/User/Client.hs +++ b/services/brig/test/integration/API/User/Client.hs @@ -151,7 +151,7 @@ testAddGetClientVerificationCode db brig galley = do Util.setTeamFeatureLockStatus @Public.SndFactorPasswordChallengeConfig galley tid Public.LockStatusUnlocked Util.setTeamSndFactorPasswordChallenge galley tid Public.FeatureStatusEnabled Util.generateVerificationCode brig (Public.SendVerificationCode Public.Login email) - k <- Code.mkKey (Code.ForEmail email) + k <- Code.mkKey email codeValue <- Code.codeValue <$$> lookupCode db k Code.AccountLogin checkLoginSucceeds $ PasswordLogin $ @@ -207,7 +207,7 @@ testAddGetClientCodeExpired db opts brig galley = do Util.setTeamFeatureLockStatus @Public.SndFactorPasswordChallengeConfig galley tid Public.LockStatusUnlocked Util.setTeamSndFactorPasswordChallenge galley tid Public.FeatureStatusEnabled Util.generateVerificationCode brig (Public.SendVerificationCode Public.Login email) - k <- Code.mkKey (Code.ForEmail email) + k <- Code.mkKey email codeValue <- Code.codeValue <$$> lookupCode db k Code.AccountLogin checkLoginSucceeds $ PasswordLogin $ diff --git a/services/brig/test/integration/API/User/Connection.hs b/services/brig/test/integration/API/User/Connection.hs index 7dbb61f7bcb..e9023104eb9 100644 --- a/services/brig/test/integration/API/User/Connection.hs +++ b/services/brig/test/integration/API/User/Connection.hs @@ -366,7 +366,6 @@ testBlockConnection brig = do -- Initiate a new connection (A -> B) postConnection brig uid1 uid2 !!! const 201 === statusCode -- Even connected users cannot see each other's email - -- (or phone number for that matter). assertEmailVisibility brig u2 u1 False assertEmailVisibility brig u1 u2 False -- B blocks A @@ -413,7 +412,6 @@ testBlockConnectionQualified brig = do -- Initiate a new connection (A -> B) postConnectionQualified brig uid1 quid2 !!! const 201 === statusCode -- Even connected users cannot see each other's email - -- (or phone number for that matter). assertEmailVisibility brig u2 u1 False assertEmailVisibility brig u1 u2 False -- B blocks A diff --git a/services/brig/test/integration/API/User/Util.hs b/services/brig/test/integration/API/User/Util.hs index fd6f2b6cbe0..e3c90c3f9c9 100644 --- a/services/brig/test/integration/API/User/Util.hs +++ b/services/brig/test/integration/API/User/Util.hs @@ -133,33 +133,13 @@ registerUser name brig = do ] post (brig . path "/register" . contentJson . body p) -createRandomPhoneUser :: (MonadCatch m, MonadIO m, MonadHttp m, HasCallStack) => Brig -> m (UserId, Phone) -createRandomPhoneUser brig = do - usr <- randomUser brig - let uid = userId usr - phn <- liftIO randomPhone - -- update phone - let phoneUpdate = RequestBodyLBS . encode $ PhoneUpdate phn - put (brig . path "/self/phone" . contentJson . zUser uid . zConn "c" . body phoneUpdate) - !!! (const 202 === statusCode) - -- activate - act <- getActivationCode brig (Right phn) - case act of - Nothing -> liftIO $ assertFailure "missing activation key/code" - Just kc -> activate brig kc !!! const 200 === statusCode - -- check new phone - get (brig . path "/self" . zUser uid) !!! do - const 200 === statusCode - const (Just phn) === (userPhone <=< responseJsonMaybe) - pure (uid, phn) - initiatePasswordReset :: Brig -> Email -> (MonadHttp m) => m ResponseLBS initiatePasswordReset brig email = post ( brig . path "/password-reset" . contentJson - . body (RequestBodyLBS . encode $ NewPasswordReset (Left email)) + . body (RequestBodyLBS . encode $ NewPasswordReset email) ) activateEmail :: (MonadCatch m, MonadIO m, MonadHttp m, HasCallStack) => Brig -> Email -> m () @@ -198,10 +178,11 @@ initiateEmailUpdateCreds brig email (cky, tok) uid = do . zUser uid . Bilge.json (EmailUpdate email) -initiateEmailUpdateNoSend :: Brig -> Email -> UserId -> (MonadHttp m) => m ResponseLBS +initiateEmailUpdateNoSend :: (MonadHttp m, MonadIO m, MonadCatch m) => Brig -> Email -> UserId -> m ResponseLBS initiateEmailUpdateNoSend brig email uid = let emailUpdate = RequestBodyLBS . encode $ EmailUpdate email in put (brig . path "/i/self/email" . contentJson . zUser uid . body emailUpdate) + diff --git a/services/brig/test/integration/Util.hs b/services/brig/test/integration/Util.hs index 1db3e2ec90a..87570a7da58 100644 --- a/services/brig/test/integration/Util.hs +++ b/services/brig/test/integration/Util.hs @@ -84,6 +84,7 @@ import Network.Wai qualified as Wai import Network.Wai.Handler.Warp qualified as Warp import Network.Wai.Test (Session) import Network.Wai.Test qualified as WaiTest +import Network.Wai.Utilities.Error qualified as Wai import OpenSSL.BN (randIntegerZeroToNMinusOne) import Servant.Client (ClientError (FailureResponse)) import Servant.Client qualified as Servant @@ -924,18 +925,9 @@ updatePhone :: (HasCallStack) => Brig -> UserId -> Phone -> Http () updatePhone brig uid phn = do -- update phone let phoneUpdate = RequestBodyLBS . encode $ PhoneUpdate phn - failMsg = "updatePhone (PUT /self/phone): failed to update to " <> show phn <> " - might be a flaky test tracked in https://wearezeta.atlassian.net/browse/BE-526" put (brig . path "/self/phone" . contentJson . zUser uid . zConn "c" . body phoneUpdate) !!! do - const 202 === statusCode - assertTrue failMsg ((== 202) . statusCode) - -- activate - act <- getActivationCode brig (Right phn) - case act of - Nothing -> liftIO $ assertFailure "missing activation key/code" - Just kc -> - activate brig kc !!! do - const 200 === statusCode - const (Just False) === fmap activatedFirst . responseJsonMaybe + const 400 === statusCode + const (Just "invalid-phone") === fmap Wai.label . responseJsonMaybe defEmailLogin :: Email -> Login defEmailLogin e = emailLogin e defPassword (Just defCookieLabel) diff --git a/services/brig/test/resources/nexmo-credentials.yaml b/services/brig/test/resources/nexmo-credentials.yaml deleted file mode 100644 index 1f83517f2ee..00000000000 --- a/services/brig/test/resources/nexmo-credentials.yaml +++ /dev/null @@ -1,2 +0,0 @@ -key: "dummy" -secret: "dummy" diff --git a/services/spar/spar.cabal b/services/spar/spar.cabal index e8a01fd1f8b..1e161ee0560 100644 --- a/services/spar/spar.cabal +++ b/services/spar/spar.cabal @@ -276,6 +276,7 @@ executable spar-integration Test.Spar.Scim.AuthSpec Test.Spar.Scim.UserSpec Util + Util.Activation Util.Core Util.Email Util.Invitation diff --git a/services/spar/src/Spar/Scim/User.hs b/services/spar/src/Spar/Scim/User.hs index 69b9e53f04c..99f5e3eb674 100644 --- a/services/spar/src/Spar/Scim/User.hs +++ b/services/spar/src/Spar/Scim/User.hs @@ -1103,10 +1103,8 @@ getUserById midp stiTeam uid = do veidChanged :: User -> ST.ValidExternalId -> Bool veidChanged usr veid = case userIdentity usr of Nothing -> True - Just (FullIdentity _ _) -> True Just (EmailIdentity _) -> True - Just (PhoneIdentity _) -> True - Just (SSOIdentity ssoid _ _) -> Brig.veidToUserSSOId veid /= ssoid + Just (SSOIdentity ssoid _) -> Brig.veidToUserSSOId veid /= ssoid managedByChanged :: User -> Bool managedByChanged usr = userManagedBy usr /= ManagedByScim diff --git a/services/spar/test-integration/Test/Spar/APISpec.hs b/services/spar/test-integration/Test/Spar/APISpec.hs index 6a1958b0905..90895f2164c 100644 --- a/services/spar/test-integration/Test/Spar/APISpec.hs +++ b/services/spar/test-integration/Test/Spar/APISpec.hs @@ -445,7 +445,7 @@ testGetPutDelete whichone = do env <- ask (ownerid, _tid) <- callCreateUserWithTeam ((^. idpId) -> idpid, (idpmeta, _)) <- registerTestIdPWithMeta ownerid - (uid, _) <- call $ createRandomPhoneUser (env ^. teBrig) + uid <- call $ userId <$> randomUser (env ^. teBrig) whichone (env ^. teSpar) (Just uid) idpid idpmeta `shouldRespondWith` checkErrHspec 403 "insufficient-permissions" context "zuser is a team member, but not a team owner" $ do @@ -877,7 +877,7 @@ specCRUDIdentityProvider = do context "zuser has no team" $ do it "responds with 'no team member'" $ do env <- ask - (uid, _) <- call $ createRandomPhoneUser (env ^. teBrig) + uid <- call $ userId <$> randomUser (env ^. teBrig) (SampleIdP idpmeta _ _ _) <- makeSampleIdPMetadata callIdpCreate' (env ^. teWireIdPAPIVersion) (env ^. teSpar) (Just uid) idpmeta `shouldRespondWith` checkErrHspec 403 "no-team-member" diff --git a/services/spar/test-integration/Test/Spar/Scim/UserSpec.hs b/services/spar/test-integration/Test/Spar/Scim/UserSpec.hs index b3831dc66f5..6dbadf09ed3 100644 --- a/services/spar/test-integration/Test/Spar/Scim/UserSpec.hs +++ b/services/spar/test-integration/Test/Spar/Scim/UserSpec.hs @@ -372,7 +372,7 @@ assertBrigCassandra uid uref usr (valemail, emailValidated) managedBy = do userManagedBy (accountUser acc) `shouldBe` managedBy userIdentity (accountUser acc) - `shouldBe` Just (SSOIdentity (UserSSOId uref) email Nothing) + `shouldBe` Just (SSOIdentity (UserSSOId uref) email) specSuspend :: SpecWith TestEnv specSuspend = do diff --git a/services/spar/test-integration/Util/Activation.hs b/services/spar/test-integration/Util/Activation.hs new file mode 100644 index 00000000000..143e5adbdf5 --- /dev/null +++ b/services/spar/test-integration/Util/Activation.hs @@ -0,0 +1,47 @@ +-- This file is part of the Wire Server implementation. +-- +-- Copyright (C) 2024 Wire Swiss GmbH +-- +-- This program is free software: you can redistribute it and/or modify it under +-- the terms of the GNU Affero General Public License as published by the Free +-- Software Foundation, either version 3 of the License, or (at your option) any +-- later version. +-- +-- This program is distributed in the hope that it will be useful, but WITHOUT +-- ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS +-- FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for more +-- details. +-- +-- You should have received a copy of the GNU Affero General Public License along +-- with this program. If not, see . + +module Util.Activation where + +import Bilge +import Control.Lens +import Data.Aeson.Lens as Aeson +import Data.ByteString.Conversion +import qualified Data.Text.Ascii as Ascii +import Imports +import Util.Types +import Wire.API.User.Activation +import Wire.API.User.Identity + +getActivationCode :: + (MonadHttp m, MonadIO m) => + BrigReq -> + Email -> + m (Maybe (ActivationKey, ActivationCode)) +getActivationCode brig e = do + let qry = queryItem "email" . toByteString' $ e + r <- + get + ( brig + . path "/i/users/activation-code" + . qry + . expectStatus (`elem` [200, 404]) + ) + let lbs = fromMaybe "" $ responseBody r + let akey = ActivationKey . Ascii.unsafeFromText <$> (lbs ^? key "key" . _String) + let acode = ActivationCode . Ascii.unsafeFromText <$> (lbs ^? key "code" . _String) + pure $ (,) <$> akey <*> acode diff --git a/services/spar/test-integration/Util/Core.hs b/services/spar/test-integration/Util/Core.hs index 1614167e961..a9a29c3445f 100644 --- a/services/spar/test-integration/Util/Core.hs +++ b/services/spar/test-integration/Util/Core.hs @@ -76,7 +76,6 @@ module Util.Core nextSAMLID, nextSubject, nextUserRef, - createRandomPhoneUser, zUser, zConn, ping, @@ -138,13 +137,13 @@ module Util.Core eventually, getIdPByIssuer, retryNUntil, + randomUser, ) where import Bilge hiding (getCookie, host, port) -- we use Web.Cookie instead of the http-client type import qualified Bilge import Bilge.Assert (Assertions, (!!!), ( tenant)) <$> nextSubject -createRandomPhoneUser :: (HasCallStack, MonadCatch m, MonadIO m, MonadHttp m) => BrigReq -> m (UserId, Phone) -createRandomPhoneUser brig_ = do - usr <- randomUser brig_ - let uid = userId usr - phn <- liftIO randomPhone - -- update phone - let phoneUpdate = RequestBodyLBS . Aeson.encode $ PhoneUpdate phn - put (brig_ . path "/self/phone" . contentJson . zUser uid . zConn "c" . body phoneUpdate) - !!! (const 202 === statusCode) - -- activate - act <- getActivationCode brig_ (Right phn) - case act of - Nothing -> liftIO . throwIO $ ErrorCall "missing activation key/code" - Just kc -> activate brig_ kc !!! const 200 === statusCode - -- check new phone - get (brig_ . path "/self" . zUser uid) !!! do - const 200 === statusCode - const (Right (Just phn)) === (fmap userPhone . responseJsonEither) - pure (uid, phn) - getTeams :: (HasCallStack, MonadHttp m, MonadIO m) => UserId -> GalleyReq -> m Galley.TeamList getTeams u gly = do r <- @@ -658,12 +635,6 @@ randomEmail = do uid <- liftIO nextRandom pure $ Email ("success+" <> UUID.toText uid) "simulator.amazonses.com" -randomPhone :: (MonadIO m) => m Phone -randomPhone = liftIO $ do - nrs <- map show <$> replicateM 14 (randomRIO (0, 9) :: IO Int) - let phone = parsePhone . cs $ "+0" ++ concat nrs - pure $ fromMaybe (error "Invalid random phone#") phone - randomUser :: (HasCallStack, MonadCatch m, MonadIO m, MonadHttp m) => BrigReq -> m User randomUser brig_ = do n <- cs . UUID.toString <$> liftIO UUID.nextRandom @@ -708,31 +679,6 @@ defPassword = plainTextPassword6Unsafe "topsecretdefaultpassword" defCookieLabel :: CookieLabel defCookieLabel = CookieLabel "auth" -getActivationCode :: - (HasCallStack, MonadIO m, MonadHttp m) => - BrigReq -> - Either Email Phone -> - m (Maybe (ActivationKey, ActivationCode)) -getActivationCode brig_ ep = do - let qry = either (queryItem "email" . toByteString') (queryItem "phone" . toByteString') ep - r <- get $ brig_ . path "/i/users/activation-code" . qry - let lbs = fromMaybe "" $ responseBody r - let akey = ActivationKey . Ascii.unsafeFromText <$> (lbs ^? Aeson.key "key" . Aeson._String) - let acode = ActivationCode . Ascii.unsafeFromText <$> (lbs ^? Aeson.key "code" . Aeson._String) - pure $ (,) <$> akey <*> acode - -activate :: - (HasCallStack, MonadHttp m) => - BrigReq -> - ActivationPair -> - m ResponseLBS -activate brig_ (k, c) = - get $ - brig_ - . path "activate" - . queryItem "key" (toByteString' k) - . queryItem "code" (toByteString' c) - zUser :: UserId -> Request -> Request zUser = header "Z-User" . toByteString' @@ -1280,12 +1226,7 @@ getSsoidViaSelf uid = maybe (error "not found") pure =<< getSsoidViaSelf' uid getSsoidViaSelf' :: (HasCallStack) => UserId -> TestSpar (Maybe UserSSOId) getSsoidViaSelf' uid = do musr <- aFewTimes (runSpar $ Intra.getBrigUser Intra.NoPendingInvitations uid) isJust - pure $ case userIdentity =<< musr of - Just (SSOIdentity ssoid _ _) -> Just ssoid - Just (FullIdentity _ _) -> Nothing - Just (EmailIdentity _) -> Nothing - Just (PhoneIdentity _) -> Nothing - Nothing -> Nothing + pure $ ssoIdentity =<< (userIdentity =<< musr) getUserIdViaRef :: (HasCallStack) => UserRef -> TestSpar UserId getUserIdViaRef uref = maybe (error "not found") pure =<< getUserIdViaRef' uref diff --git a/services/spar/test-integration/Util/Email.hs b/services/spar/test-integration/Util/Email.hs index babae51a36e..74c564ad2bc 100644 --- a/services/spar/test-integration/Util/Email.hs +++ b/services/spar/test-integration/Util/Email.hs @@ -30,11 +30,11 @@ import Data.Aeson.Lens import Data.ByteString.Conversion import Data.Id import qualified Data.Misc as Misc -import qualified Data.Text.Ascii as Ascii import Data.Text.Encoding (encodeUtf8) import qualified Data.ZAuth.Token as ZAuth import Imports import Test.Tasty.HUnit +import Util.Activation import Util.Core import Util.Types import qualified Wire.API.Team.Feature as Feature @@ -108,7 +108,7 @@ activateEmail :: Email -> (MonadHttp m) => m () activateEmail brig email = do - act <- getActivationCode brig (Left email) + act <- getActivationCode brig email case act of Nothing -> liftIO $ assertFailure "missing activation key/code" Just kc -> @@ -122,7 +122,7 @@ failActivatingEmail :: Email -> (MonadHttp m) => m () failActivatingEmail brig email = do - act <- getActivationCode brig (Left email) + act <- getActivationCode brig email liftIO $ assertEqual "there should be no pending activation" act Nothing checkEmail :: @@ -149,19 +149,6 @@ activate brig (k, c) = . queryItem "key" (toByteString' k) . queryItem "code" (toByteString' c) -getActivationCode :: - (MonadCatch m, MonadHttp m, HasCallStack) => - BrigReq -> - Either Email Phone -> - m (Maybe (ActivationKey, ActivationCode)) -getActivationCode brig ep = do - let qry = either (queryItem "email" . toByteString') (queryItem "phone" . toByteString') ep - r <- get $ brig . path "/i/users/activation-code" . qry - let lbs = fromMaybe "" $ responseBody r - let akey = ActivationKey . Ascii.unsafeFromText <$> (lbs ^? key "key" . _String) - let acode = ActivationCode . Ascii.unsafeFromText <$> (lbs ^? key "code" . _String) - pure $ (,) <$> akey <*> acode - setSamlEmailValidation :: (HasCallStack) => TeamId -> Feature.FeatureStatus -> TestSpar () setSamlEmailValidation tid status = do galley <- view teGalley diff --git a/services/spar/test-integration/Util/Scim.hs b/services/spar/test-integration/Util/Scim.hs index fbba2a371ed..40ef9884d0a 100644 --- a/services/spar/test-integration/Util/Scim.hs +++ b/services/spar/test-integration/Util/Scim.hs @@ -750,7 +750,7 @@ scimifyBrigUserHack :: User -> Email -> User scimifyBrigUserHack usr email = usr { userManagedBy = ManagedByScim, - userIdentity = Just (SSOIdentity (UserScimExternalId (fromEmail email)) (Just email) Nothing) + userIdentity = Just (SSOIdentity (UserScimExternalId (fromEmail email)) (Just email)) } getDefaultUserLocale :: TestSpar Locale diff --git a/tools/db/inconsistencies/src/DanglingUserKeys.hs b/tools/db/inconsistencies/src/DanglingUserKeys.hs index 6812ac66293..3d27d4c208c 100644 --- a/tools/db/inconsistencies/src/DanglingUserKeys.hs +++ b/tools/db/inconsistencies/src/DanglingUserKeys.hs @@ -36,7 +36,7 @@ import Imports import System.Logger import System.Logger qualified as Log import UnliftIO.Async -import Wire.API.User hiding (userEmail, userPhone) +import Wire.API.User hiding (userEmail) import Wire.UserKeyStore runCommand :: Logger -> ClientState -> FilePath -> IO () @@ -77,7 +77,7 @@ pageSize = 1000 data Inconsistency = Inconsistency { -- | Key in the user_keys table - key :: UserKey, + key :: EmailKey, userId :: UserId, time :: Writetime UserId, status :: Maybe (WithWritetime AccountStatus), @@ -100,22 +100,22 @@ instance (Aeson.ToJSON a) => Aeson.ToJSON (WithWritetime a) ---------------------------------------------------------------------------- -- Queries -getKey :: UserKey -> Client (Maybe (UserId, Writetime UserId)) +getKey :: EmailKey -> Client (Maybe (UserId, Writetime UserId)) getKey key = retry x5 $ query1 cql (params LocalQuorum (Identity key)) where - cql :: PrepQuery R (Identity UserKey) (UserId, Writetime UserId) + cql :: PrepQuery R (Identity EmailKey) (UserId, Writetime UserId) cql = "SELECT user, writetime(user) from user_keys where key = ?" -getKeys :: ConduitM () [(UserKey, UserId, Writetime UserId)] Client () +getKeys :: ConduitM () [(EmailKey, UserId, Writetime UserId)] Client () getKeys = paginateC cql (paramsP LocalQuorum () pageSize) x5 where - cql :: PrepQuery R () (UserKey, UserId, Writetime UserId) + cql :: PrepQuery R () (EmailKey, UserId, Writetime UserId) cql = "SELECT key, user, writetime(user) from user_keys" -parseKey :: Text -> Maybe UserKey -parseKey t = (userEmailKey <$> parseEmail t) <|> (userPhoneKey <$> parsePhone t) +parseKey :: Text -> Maybe EmailKey +parseKey t = mkEmailKey <$> parseEmail t -instance Cql UserKey where +instance Cql EmailKey where ctype = Tagged TextColumn fromCql (CqlText t) = @@ -125,10 +125,10 @@ instance Cql UserKey where (parseKey t) fromCql _ = Left "userkey: expected text" - toCql k = toCql $ keyText k + toCql k = toCql $ emailKeyUniq k -instance Aeson.ToJSON UserKey where - toJSON = Aeson.toJSON . keyText +instance Aeson.ToJSON EmailKey where + toJSON = Aeson.toJSON . emailKeyUniq type UserDetailsRow = (Maybe AccountStatus, Maybe (Writetime AccountStatus), Maybe Email, Maybe (Writetime Email), Maybe Phone, Maybe (Writetime Phone)) @@ -138,28 +138,28 @@ getUserDetails uid = retry x5 $ query1 cql (params LocalQuorum (Identity uid)) cql :: PrepQuery R (Identity UserId) UserDetailsRow cql = "SELECT status, writetime(status), email, writetime(email), phone, writetime(phone) from user where id = ?" -checkKey :: Logger -> ClientState -> UserKey -> Bool -> IO (Maybe Inconsistency) +checkKey :: Logger -> ClientState -> EmailKey -> Bool -> IO (Maybe Inconsistency) checkKey l brig key repairData = do mUser <- runClient brig $ getKey key case mUser of Nothing -> do - Log.warn l (Log.msg (Log.val "No user found for key") . Log.field "key" (keyText key)) + Log.warn l (Log.msg (Log.val "No user found for key") . Log.field "key" (emailKeyUniq key)) pure Nothing Just (uid, writeTime) -> checkUser l brig key uid writeTime repairData -- mostly copied from Brig to not need a Brig Env/ReaderT -freeUserKey :: Logger -> UserKey -> Client () -freeUserKey l k = do - Log.info l $ Log.msg (Log.val "Freeing key") . Log.field "key" (keyText k) - retry x5 $ write keyDelete (params LocalQuorum (Identity $ keyText k)) +freeEmailKey :: Logger -> EmailKey -> Client () +freeEmailKey l k = do + Log.info l $ Log.msg (Log.val "Freeing key") . Log.field "key" (emailKeyUniq k) + retry x5 $ write keyDelete (params LocalQuorum (Identity $ emailKeyUniq k)) where keyDelete :: PrepQuery W (Identity Text) () keyDelete = "DELETE FROM user_keys WHERE key = ?" -insertKey :: Logger -> UserId -> UserKey -> Client () +insertKey :: Logger -> UserId -> EmailKey -> Client () insertKey l u k = do - Log.info l $ Log.msg (Log.val "Inserting key") . Log.field "key" (keyText k) . Log.field "userId" (show u) - retry x5 $ write keyInsert (params LocalQuorum (keyText k, u)) + Log.info l $ Log.msg (Log.val "Inserting key") . Log.field "key" (emailKeyUniq k) . Log.field "userId" (show u) + retry x5 $ write keyInsert (params LocalQuorum (emailKeyUniq k, u)) where keyInsert :: PrepQuery W (Text, UserId) () keyInsert = "INSERT INTO user_keys (key, user) VALUES (?, ?)" @@ -172,7 +172,7 @@ insertKey l u k = do -- 3.b. this user's email, when searched for points to another user -> do nothing; log this issue -- 3.c this user's email, when searched for does not exist in user_keys. Do nothing, let this be handled by the other module EmailLessUsers.hs -- 4. user has an email in user_keys but no email inside user table -> do nothing. How to resolve? -checkUser :: Logger -> ClientState -> UserKey -> UserId -> Writetime UserId -> Bool -> IO (Maybe Inconsistency) +checkUser :: Logger -> ClientState -> EmailKey -> UserId -> Writetime UserId -> Bool -> IO (Maybe Inconsistency) checkUser l brig key uid time repairData = do maybeDetails <- runClient brig $ getUserDetails uid case maybeDetails of @@ -183,7 +183,7 @@ checkUser l brig key uid time repairData = do inconsistencyCase = "2." when repairData $ -- case 2. runClient brig $ - freeUserKey l key + freeEmailKey l key pure . Just $ Inconsistency {userId = uid, ..} Just (mStatus, mStatusWriteTime, mEmail, mEmailWriteTime, mPhone, mPhoneWriteTime) -> do let status = WithWritetime <$> mStatus <*> mStatusWriteTime @@ -194,12 +194,11 @@ checkUser l brig key uid time repairData = do Just Deleted -> True _ -> False compareEmail e = (emailKeyUniq . mkEmailKey <$> mEmail) /= Just (fromEmail e) - comparePhone p = (phoneKeyUniq . mkPhoneKey <$> mPhone) /= Just (fromPhone p) - keyError = foldKey compareEmail comparePhone key + keyError = compareEmail (emailKeyOrig key) if statusError then do let inconsistencyCase = "1." - when repairData $ runClient brig (freeUserKey l key) + when repairData $ runClient brig (freeEmailKey l key) pure . Just $ Inconsistency {userId = uid, ..} else if keyError @@ -210,17 +209,17 @@ checkUser l brig key uid time repairData = do let inconsistencyCase = "4." pure . Just $ Inconsistency {userId = uid, ..} Just email -> do - validKeysEntry <- runClient brig $ getKey (userEmailKey email) + validKeysEntry <- runClient brig $ getKey (mkEmailKey email) case validKeysEntry of Just (keyEntryUserId, _) -> if keyEntryUserId == uid then do -- there is a valid matching user_key entry for a user in the user table; just *also* an extra entry that can be cleaned up (case 3.a.) - Log.warn l (Log.msg (Log.val "Subcase 3a: entry can be repaired by removing entry") . Log.field "key" (keyText key)) + Log.warn l (Log.msg (Log.val "Subcase 3a: entry can be repaired by removing entry") . Log.field "key" (emailKeyUniq key)) let inconsistencyCase = "3.a." when repairData $ runClient brig $ - freeUserKey l key + freeEmailKey l key pure . Just $ Inconsistency {userId = uid, ..} else do let inconsistencyCase = "3.b." diff --git a/tools/db/inconsistencies/src/EmailLessUsers.hs b/tools/db/inconsistencies/src/EmailLessUsers.hs index 1c4e73f11b6..021a5064ae3 100644 --- a/tools/db/inconsistencies/src/EmailLessUsers.hs +++ b/tools/db/inconsistencies/src/EmailLessUsers.hs @@ -116,7 +116,7 @@ type UserDetailsRow = (UserId, Maybe AccountStatus, Maybe (Writetime AccountStat insertMissingEmail :: Logger -> ClientState -> Email -> UserId -> IO () insertMissingEmail l brig email uid = do - runClient brig $ K.insertKey l uid (userEmailKey email) + runClient brig $ K.insertKey l uid (mkEmailKey email) userWithEmailAndStatus :: UserDetailsRow -> Maybe (UserId, AccountStatus, Writetime AccountStatus, Email, Writetime Email) userWithEmailAndStatus (uid, mStatus, mStatusWritetime, mEmail, mEmailWritetime, activated) = do @@ -137,7 +137,7 @@ checkUser :: Logger -> ClientState -> Bool -> (UserId, AccountStatus, Writetime checkUser l brig repairData (uid, statusValue, statusWritetime, userEmailValue, userEmailWriteTime) = do let status = WithWritetime statusValue statusWritetime userEmail = WithWritetime userEmailValue userEmailWriteTime - mKeyDetails <- runClient brig $ K.getKey (userEmailKey userEmailValue) + mKeyDetails <- runClient brig $ K.getKey (mkEmailKey userEmailValue) case mKeyDetails of Nothing -> do let emailKey = Nothing diff --git a/tools/stern/src/Stern/API.hs b/tools/stern/src/Stern/API.hs index 8783812b365..8b071b59b45 100644 --- a/tools/stern/src/Stern/API.hs +++ b/tools/stern/src/Stern/API.hs @@ -129,7 +129,6 @@ sitemap' = Named @"suspend-user" suspendUser :<|> Named @"unsuspend-user" unsuspendUser :<|> Named @"get-users-by-email" usersByEmail - :<|> Named @"get-users-by-phone" usersByPhone :<|> Named @"get-users-by-ids" usersByIds :<|> Named @"get-users-by-handles" usersByHandles :<|> Named @"get-user-connections" userConnections @@ -137,7 +136,6 @@ sitemap' = :<|> Named @"search-users" searchOnBehalf :<|> Named @"revoke-identity" revokeIdentity :<|> Named @"put-email" changeEmail - :<|> Named @"put-phone" changePhone :<|> Named @"delete-user" deleteUser :<|> Named @"suspend-team" (setTeamStatusH Team.Suspended) :<|> Named @"unsuspend-team" (setTeamStatusH Team.Active) @@ -210,10 +208,7 @@ unsuspendUser :: UserId -> Handler NoContent unsuspendUser uid = NoContent <$ Intra.putUserStatus Active uid usersByEmail :: Email -> Handler [UserAccount] -usersByEmail = Intra.getUserProfilesByIdentity . Left - -usersByPhone :: Phone -> Handler [UserAccount] -usersByPhone = Intra.getUserProfilesByIdentity . Right +usersByEmail = Intra.getUserProfilesByIdentity usersByIds :: [UserId] -> Handler [UserAccount] usersByIds = Intra.getUserProfiles . Left @@ -237,19 +232,15 @@ searchOnBehalf (fromMaybe (unsafeRange 10) . checked @1 @100 @Int32 . fromMaybe 10 -> s) = Intra.getContacts uid q (fromRange s) -revokeIdentity :: Maybe Email -> Maybe Phone -> Handler NoContent -revokeIdentity mbe mbp = NoContent <$ (Intra.revokeIdentity =<< doubleMaybeToEither "email, phone" mbe mbp) +revokeIdentity :: Email -> Handler NoContent +revokeIdentity e = NoContent <$ Intra.revokeIdentity e changeEmail :: UserId -> EmailUpdate -> Handler NoContent changeEmail uid upd = NoContent <$ Intra.changeEmail uid upd -changePhone :: UserId -> PhoneUpdate -> Handler NoContent -changePhone uid upd = NoContent <$ Intra.changePhone uid upd - -deleteUser :: UserId -> Maybe Email -> Maybe Phone -> Handler NoContent -deleteUser uid mbEmail mbPhone = do - emailOrPhone <- doubleMaybeToEither "email, phone" mbEmail mbPhone - usrs <- Intra.getUserProfilesByIdentity emailOrPhone +deleteUser :: UserId -> Email -> Handler NoContent +deleteUser uid email = do + usrs <- Intra.getUserProfilesByIdentity email case usrs of [accountUser -> u] -> if userId u == uid @@ -257,7 +248,7 @@ deleteUser uid mbEmail mbPhone = do info $ userMsg uid . msg (val "Deleting account") void $ Intra.deleteAccount uid pure NoContent - else throwE $ mkError status400 "match-error" "email or phone did not match UserId" + else throwE $ mkError status400 "match-error" "email did not match UserId" (_ : _ : _) -> error "impossible" _ -> throwE $ mkError status404 "not-found" "not found" @@ -266,7 +257,7 @@ setTeamStatusH status tid = NoContent <$ Intra.setStatusBindingTeam tid status deleteTeam :: TeamId -> Maybe Bool -> Maybe Email -> Handler NoContent deleteTeam givenTid (fromMaybe False -> False) (Just email) = do - acc <- Intra.getUserProfilesByIdentity (Left email) >>= handleNoUser . listToMaybe + acc <- Intra.getUserProfilesByIdentity email >>= handleNoUser . listToMaybe userTid <- (Intra.getUserBindingTeam . userId . accountUser $ acc) >>= handleNoTeam when (givenTid /= userTid) $ throwE bindingTeamMismatch @@ -285,27 +276,24 @@ deleteTeam tid (fromMaybe False -> True) _ = do deleteTeam _ _ _ = throwE $ mkError status400 "Bad Request" "either email or 'force=true' parameter is required" -isUserKeyBlacklisted :: Maybe Email -> Maybe Phone -> Handler NoContent -isUserKeyBlacklisted mbemail mbphone = do - emailOrPhone <- doubleMaybeToEither "email, phone" mbemail mbphone - bl <- Intra.isBlacklisted emailOrPhone +isUserKeyBlacklisted :: Email -> Handler NoContent +isUserKeyBlacklisted email = do + bl <- Intra.isBlacklisted email if bl then throwE $ mkError status200 "blacklisted" "The given user key IS blacklisted" else throwE $ mkError status404 "not-blacklisted" "The given user key is NOT blacklisted" -addBlacklist :: Maybe Email -> Maybe Phone -> Handler NoContent -addBlacklist mbemail mbphone = do - emailOrPhone <- doubleMaybeToEither "email, phone" mbemail mbphone - NoContent <$ Intra.setBlacklistStatus True emailOrPhone +addBlacklist :: Email -> Handler NoContent +addBlacklist email = do + NoContent <$ Intra.setBlacklistStatus True email -deleteFromBlacklist :: Maybe Email -> Maybe Phone -> Handler NoContent -deleteFromBlacklist mbemail mbphone = do - emailOrPhone <- doubleMaybeToEither "email, phone" mbemail mbphone - NoContent <$ Intra.setBlacklistStatus False emailOrPhone +deleteFromBlacklist :: Email -> Handler NoContent +deleteFromBlacklist email = do + NoContent <$ Intra.setBlacklistStatus False email getTeamInfoByMemberEmail :: Email -> Handler TeamInfo getTeamInfoByMemberEmail e = do - acc <- Intra.getUserProfilesByIdentity (Left e) >>= handleUser . listToMaybe + acc <- Intra.getUserProfilesByIdentity e >>= handleUser . listToMaybe tid <- (Intra.getUserBindingTeam . userId . accountUser $ acc) >>= handleTeam Intra.getTeamInfo tid where @@ -416,7 +404,7 @@ setTeamBillingInfo tid billingInfo = do getConsentLog :: Email -> Handler ConsentLogAndMarketo getConsentLog e = do - acc <- listToMaybe <$> Intra.getUserProfilesByIdentity (Left e) + acc <- listToMaybe <$> Intra.getUserProfilesByIdentity e when (isJust acc) $ throwE $ mkError status403 "user-exists" "Trying to access consent log of existing user!" diff --git a/tools/stern/src/Stern/API/Routes.hs b/tools/stern/src/Stern/API/Routes.hs index feba0168cd9..b52d262f142 100644 --- a/tools/stern/src/Stern/API/Routes.hs +++ b/tools/stern/src/Stern/API/Routes.hs @@ -91,14 +91,6 @@ type SternAPI = :> QueryParam' [Required, Strict, Description "Email address"] "email" Email :> Get '[JSON] [UserAccount] ) - :<|> Named - "get-users-by-phone" - ( Summary "Displays user's info given a phone number" - :> "users" - :> "by-phone" - :> QueryParam' [Required, Strict, Description "Phone number"] "phone" Phone - :> Get '[JSON] [UserAccount] - ) :<|> Named "get-users-by-ids" ( Summary "Displays active users info given a list of ids" @@ -144,7 +136,7 @@ type SternAPI = ) :<|> Named "revoke-identity" - ( Summary "Revoke a verified user identity. Specify exactly one of phone, email." + ( Summary "Revoke a verified user identity. Specify email." :> Description "Forcefully revokes a verified user identity. \ \WARNING: If the given identity is the only verified \ @@ -153,8 +145,7 @@ type SternAPI = \If the given identity is not taken / verified, this is a no-op." :> "users" :> "revoke-identity" - :> QueryParam' [Optional, Strict, Description "A verified email address"] "email" Email - :> QueryParam' [Optional, Strict, Description "A verified phone number (E.164 format)."] "phone" Phone + :> QueryParam' [Required, Strict, Description "A verified email address"] "email" Email :> Post '[JSON] NoContent ) :<|> Named @@ -167,25 +158,14 @@ type SternAPI = :> Servant.ReqBody '[JSON] EmailUpdate :> Put '[JSON] NoContent ) - :<|> Named - "put-phone" - ( Summary "Change a user's phone number." - :> Description "The new phone number must be verified before the change takes effect." - :> "users" - :> Capture "uid" UserId - :> "phone" - :> Servant.ReqBody '[JSON] PhoneUpdate - :> Put '[JSON] NoContent - ) :<|> Named "delete-user" ( Summary "Delete a user (irrevocable!)" :> Description - "Email or Phone must match UserId's (to prevent copy/paste mistakes). Use exactly one of the two query params." + "Email must match UserId's (to prevent copy/paste mistakes)." :> "users" :> Capture "uid" UserId - :> QueryParam' [Optional, Strict, Description "A verified email address"] "email" Email - :> QueryParam' [Optional, Strict, Description "A verified phone number (E.164 format)."] "phone" Phone + :> QueryParam' [Required, Strict, Description "A verified email address"] "email" Email :> Delete '[JSON] NoContent ) :<|> Named @@ -228,29 +208,26 @@ type SternAPI = ) :<|> Named "head-user-blacklist" - ( Summary "Fetch blacklist information on a email/phone (200: blacklisted; 404: not blacklisted)" + ( Summary "Fetch blacklist information on a email (200: blacklisted; 404: not blacklisted)" :> "users" :> "blacklist" - :> QueryParam' [Optional, Strict, Description "A verified email address"] "email" Email - :> QueryParam' [Optional, Strict, Description "A verified phone number (E.164 format)."] "phone" Phone + :> QueryParam' [Required, Strict, Description "A verified email address"] "email" Email :> Verb 'GET 200 '[JSON] NoContent ) :<|> Named "post-user-blacklist" - ( Summary "Add the email/phone to our blacklist" + ( Summary "Add the email to our blacklist" :> "users" :> "blacklist" - :> QueryParam' [Optional, Strict, Description "A verified email address"] "email" Email - :> QueryParam' [Optional, Strict, Description "A verified phone number (E.164 format)."] "phone" Phone + :> QueryParam' [Required, Strict, Description "A verified email address"] "email" Email :> Post '[JSON] NoContent ) :<|> Named "delete-user-blacklist" - ( Summary "Remove the email/phone from our blacklist" + ( Summary "Remove the email from our blacklist" :> "users" :> "blacklist" - :> QueryParam' [Optional, Strict, Description "A verified email address"] "email" Email - :> QueryParam' [Optional, Strict, Description "A verified phone number (E.164 format)."] "phone" Phone + :> QueryParam' [Required, Strict, Description "A verified email address"] "email" Email :> Delete '[JSON] NoContent ) :<|> Named diff --git a/tools/stern/src/Stern/Intra.hs b/tools/stern/src/Stern/Intra.hs index b0e05f92885..59636d7e5ba 100644 --- a/tools/stern/src/Stern/Intra.hs +++ b/tools/stern/src/Stern/Intra.hs @@ -253,8 +253,8 @@ getUserProfiles uidsOrHandles = do fmap (BS.intercalate "," . map toByteString') . chunksOf 50 -getUserProfilesByIdentity :: Either Email Phone -> Handler [UserAccount] -getUserProfilesByIdentity emailOrPhone = do +getUserProfilesByIdentity :: Email -> Handler [UserAccount] +getUserProfilesByIdentity email = do info $ msg "Getting user accounts by identity" b <- view brig r <- @@ -264,7 +264,7 @@ getUserProfilesByIdentity emailOrPhone = do b ( method GET . Bilge.path "i/users" - . userKeyToParam emailOrPhone + . userKeyToParam email . expect2xx ) parseResponse (mkError status502 "bad-upstream") r @@ -310,8 +310,8 @@ getContacts u q s = do ) parseResponse (mkError status502 "bad-upstream") r -revokeIdentity :: Either Email Phone -> Handler () -revokeIdentity emailOrPhone = do +revokeIdentity :: Email -> Handler () +revokeIdentity email = do info $ msg "Revoking user identity" b <- view brig void @@ -321,7 +321,7 @@ revokeIdentity emailOrPhone = do b ( method POST . Bilge.path "i/users/revoke-identity" - . userKeyToParam emailOrPhone + . userKeyToParam email . expect2xx ) @@ -503,8 +503,8 @@ setTeamBillingInfo tid tbu = do . expect2xx ) -isBlacklisted :: Either Email Phone -> Handler Bool -isBlacklisted emailOrPhone = do +isBlacklisted :: Email -> Handler Bool +isBlacklisted email = do info $ msg "Checking blacklist" b <- view brig resp <- @@ -514,15 +514,15 @@ isBlacklisted emailOrPhone = do b ( method GET . Bilge.path "i/users/blacklist" - . userKeyToParam emailOrPhone + . userKeyToParam email ) case Bilge.statusCode resp of 200 -> pure True 404 -> pure False _ -> throwE (mkError status502 "bad-upstream" (errorMessage resp)) -setBlacklistStatus :: Bool -> Either Email Phone -> Handler () -setBlacklistStatus status emailOrPhone = do +setBlacklistStatus :: Bool -> Email -> Handler () +setBlacklistStatus status email = do info $ msg "Changing blacklist status" b <- view brig void @@ -532,7 +532,7 @@ setBlacklistStatus status emailOrPhone = do b ( method (statusToMethod status) . Bilge.path "i/users/blacklist" - . userKeyToParam emailOrPhone + . userKeyToParam email . expect2xx ) where @@ -679,9 +679,8 @@ setSearchVisibility tid typ = do stripBS :: ByteString -> ByteString stripBS = encodeUtf8 . strip . decodeUtf8 -userKeyToParam :: Either Email Phone -> Request -> Request -userKeyToParam (Left e) = queryItem "email" (stripBS $ toByteString' e) -userKeyToParam (Right p) = queryItem "phone" (stripBS $ toByteString' p) +userKeyToParam :: Email -> Request -> Request +userKeyToParam e = queryItem "email" (stripBS $ toByteString' e) errorMessage :: Response (Maybe LByteString) -> LText errorMessage = maybe "" TL.decodeUtf8 . responseBody diff --git a/tools/stern/test/integration/API.hs b/tools/stern/test/integration/API.hs index 3b107b56502..69b351cabdb 100644 --- a/tools/stern/test/integration/API.hs +++ b/tools/stern/test/integration/API.hs @@ -65,7 +65,6 @@ tests s = test s "POST /users/:uid/suspend" testSuspendUser, test s "POST /users/:uid/unsuspend" testUnsuspendUser, test s "GET /users/by-email" testGetUsersByEmail, - test s "GET /users/by-phone" testGetUsersByPhone, test s "GET /users/by-ids" testGetUsersByIds, test s "GET /users/by-handles" testGetUsersByHandles, test s "GET /users/:id/connections" testGetConnections, @@ -73,7 +72,6 @@ tests s = test s "GET /users/:uid/search" testSearchUsers, test s "POST /users/revoke-identity?email=..." testRevokeIdentity, test s "PUT /users/:uid/email" testPutEmail, - test s "PUT /users/:uid/phone" testPutPhone, test s "DELETE /users/:uid" testDeleteUser, test s "PUT /teams/:tid/suspend" testSuspendTeam, test s "PUT /teams/:tid/unsuspend" testUnsuspendTeam, @@ -175,13 +173,6 @@ testGetUserMetaInfo = do -- Just make sure this returns a 200 void $ getUserMetaInfo uid -testPutPhone :: TestM () -testPutPhone = do - uid <- randomUser - phone <- randomPhone - -- We simply test that this call returns 200 - putPhone uid (PhoneUpdate phone) - testDeleteUser :: TestM () testDeleteUser = do (uid, email) <- randomEmailUser @@ -405,12 +396,6 @@ testGetUsersByHandles = do [ua] <- getUsersByHandles h liftIO $ userId ua.accountUser @?= uid -testGetUsersByPhone :: TestM () -testGetUsersByPhone = do - (uid, phone) <- randomPhoneUser - [ua] <- getUsersByPhone phone - liftIO $ userId ua.accountUser @?= uid - testGetUsersByEmail :: TestM () testGetUsersByEmail = do (uid, email) <- randomEmailUser @@ -466,14 +451,13 @@ testSearchUsers = do testRevokeIdentity :: TestM () testRevokeIdentity = do - (_, (email, phone)) <- randomEmailPhoneUser + (_, email) <- randomEmailUser do [ua] <- getUsersByEmail email liftIO $ do ua.accountStatus @?= Active isJust ua.accountUser.userIdentity @?= True void $ revokeIdentity (Left email) - void $ revokeIdentity (Right phone) do [ua] <- getUsersByEmail email liftIO $ do @@ -511,12 +495,6 @@ getUsersByHandles h = do r <- get (stern . paths ["users", "by-handles"] . queryItem "handles" (cs h) . expect2xx) pure $ responseJsonUnsafe r -getUsersByPhone :: Phone -> TestM [UserAccount] -getUsersByPhone phone = do - stern <- view tsStern - r <- get (stern . paths ["users", "by-phone"] . queryItem "phone" (toByteString' phone) . expect2xx) - pure $ responseJsonUnsafe r - getUsersByEmail :: Email -> TestM [UserAccount] getUsersByEmail email = do stern <- view tsStern @@ -571,11 +549,6 @@ putEmail uid emailUpdate = do s <- view tsStern void $ put (s . paths ["users", toByteString' uid, "email"] . json emailUpdate . expect2xx) -putPhone :: UserId -> PhoneUpdate -> TestM () -putPhone uid phoneUpdate = do - s <- view tsStern - void $ put (s . paths ["users", toByteString' uid, "phone"] . json phoneUpdate . expect2xx) - deleteUser :: UserId -> Either Email Phone -> TestM () deleteUser uid emailOrPhone = do s <- view tsStern diff --git a/tools/stern/test/integration/Util.hs b/tools/stern/test/integration/Util.hs index dc6cf21de41..2c26c513d13 100644 --- a/tools/stern/test/integration/Util.hs +++ b/tools/stern/test/integration/Util.hs @@ -87,34 +87,20 @@ randomUser'' isCreator hasPassword hasEmail = selfUser <$> randomUserProfile' is randomUserProfile' :: (HasCallStack) => Bool -> Bool -> Bool -> TestM SelfProfile randomUserProfile' isCreator hasPassword hasEmail = randomUserProfile'' isCreator hasPassword hasEmail <&> fst -randomUserProfile'' :: (HasCallStack) => Bool -> Bool -> Bool -> TestM (SelfProfile, (Email, Phone)) +randomUserProfile'' :: (HasCallStack) => Bool -> Bool -> Bool -> TestM (SelfProfile, Email) randomUserProfile'' isCreator hasPassword hasEmail = do b <- view tsBrig e <- liftIO randomEmail - p <- liftIO randomPhone let pl = object $ ["name" .= fromEmail e] <> ["password" .= defPassword | hasPassword] <> ["email" .= fromEmail e | hasEmail] - <> ["phone" .= fromPhone p] <> ["team" .= BindingNewTeam (newNewTeam (unsafeRange "teamName") DefaultIcon) | isCreator] - (,(e, p)) . responseJsonUnsafe <$> (post (b . path "/i/users" . Bilge.json pl) m Phone -randomPhone = liftIO $ do - nrs <- map show <$> replicateM 14 (randomRIO (0, 9) :: IO Int) - let phone = parsePhone . Text.pack $ "+0" ++ concat nrs - pure $ fromMaybe (error "Invalid random phone#") phone + (,e) . responseJsonUnsafe <$> (post (b . path "/i/users" . Bilge.json pl) TestM (UserId, Email) -randomEmailUser = randomUserProfile'' False False True <&> bimap (User.userId . selfUser) fst - -randomPhoneUser :: (HasCallStack) => TestM (UserId, Phone) -randomPhoneUser = randomUserProfile'' False False True <&> bimap (User.userId . selfUser) snd - -randomEmailPhoneUser :: (HasCallStack) => TestM (UserId, (Email, Phone)) -randomEmailPhoneUser = randomUserProfile'' False False True <&> first (User.userId . selfUser) +randomEmailUser = randomUserProfile'' False False True <&> first (User.userId . selfUser) defPassword :: PlainTextPassword8 defPassword = plainTextPassword8Unsafe "topsecretdefaultpassword" From b6904869d620bacbf61b6e7833a13b63f05d4ce1 Mon Sep 17 00:00:00 2001 From: Mango The Fourth <40720523+MangoIV@users.noreply.github.com> Date: Wed, 3 Jul 2024 15:25:56 +0200 Subject: [PATCH 59/64] [chore] replace cabal.project.local template and update cabal.project (#4119) * replace cabal.project.local template and update cabal.project * use program-options instead of package * --- Makefile | 3 +- cabal.project | 110 +----------------- .../cabal-project-local-improvements | 1 + hack/bin/cabal-project-local-template.sh | 16 --- hack/bin/cabal.project.local.template | 6 + 5 files changed, 9 insertions(+), 127 deletions(-) create mode 100644 changelog.d/5-internal/cabal-project-local-improvements delete mode 100755 hack/bin/cabal-project-local-template.sh create mode 100644 hack/bin/cabal.project.local.template diff --git a/Makefile b/Makefile index 4eadeb39a51..7ec7a59287a 100644 --- a/Makefile +++ b/Makefile @@ -73,8 +73,7 @@ clean-hint: .PHONY: cabal.project.local cabal.project.local: - echo "optimization: False" > ./cabal.project.local - ./hack/bin/cabal-project-local-template.sh "ghc-options: -O0" >> ./cabal.project.local + cp ./hack/bin/cabal.project.local.template ./cabal.project.local # Usage: make c package=brig test=1 .PHONY: c diff --git a/cabal.project b/cabal.project index 2e55626a809..fe2c42af262 100644 --- a/cabal.project +++ b/cabal.project @@ -61,115 +61,7 @@ packages: tests: True benchmarks: True -package assets - ghc-options: -Werror -package auto-whitelist - ghc-options: -Werror -package background-worker - ghc-options: -Werror -package bilge - ghc-options: -Werror -package brig - ghc-options: -Werror -package brig-types - ghc-options: -Werror -package cannon - ghc-options: -Werror -package cargohold - ghc-options: -Werror -package cargohold-types - ghc-options: -Werror -package cassandra-util - ghc-options: -Werror -package deriving-swagger2 - ghc-options: -Werror -package dns-util - ghc-options: -Werror -package extended - ghc-options: -Werror -package federator - ghc-options: -Werror -package find-undead - ghc-options: -Werror -package galley - ghc-options: -Werror -package galley-types - ghc-options: -Werror -package gundeck - ghc-options: -Werror -package gundeck-types - ghc-options: -Werror -package hscim - ghc-options: -Werror -package http2-manager - ghc-options: -Werror -package inconsistencies - ghc-options: -Werror -package integration - ghc-options: -Werror -package imports - ghc-options: -Werror -package jwt-tools - ghc-options: -Werror -package metrics-core - ghc-options: -Werror -package metrics-wai - ghc-options: -Werror -package migrate-sso-feature-flag - ghc-options: -Werror -package mlsstats - ghc-options: -Werror -package move-team - ghc-options: -Werror -package polysemy-wire-zoo - ghc-options: -Werror -package proxy - ghc-options: -Werror -package mlsstats - ghc-options: -Werror -package phone-users - ghc-options: -Werror -package rabbitmq-consumer - ghc-options: -Werror -package repair-handles - ghc-options: -Werror -package rex - ghc-options: -Werror -package schema-profunctor - ghc-options: -Werror -package service-backfill - ghc-options: -Werror -package sodium-crypto-sign - ghc-options: -Werror -package spar - ghc-options: -Werror -package ssl-util - ghc-options: -Werror -package stern - ghc-options: -Werror -package tasty-cannon - ghc-options: -Werror -package test-stats - ghc-options: -Werror -package types-common - ghc-options: -Werror -package types-common-aws - ghc-options: -Werror -package types-common-journal - ghc-options: -Werror -package wai-utilities - ghc-options: -Werror -package wire-api - ghc-options: -Werror -package wire-api-federation - ghc-options: -Werror -package wire-message-proto-lens - ghc-options: -Werror -package wire-subsystems - ghc-options: -Werror -package zauth - ghc-options: -Werror -package fedcalls +program-options ghc-options: -Werror -- NOTE: diff --git a/changelog.d/5-internal/cabal-project-local-improvements b/changelog.d/5-internal/cabal-project-local-improvements new file mode 100644 index 00000000000..9a0c5621c18 --- /dev/null +++ b/changelog.d/5-internal/cabal-project-local-improvements @@ -0,0 +1 @@ +replace cabal.project.local template and update cabal.project diff --git a/hack/bin/cabal-project-local-template.sh b/hack/bin/cabal-project-local-template.sh deleted file mode 100755 index de45ddfd694..00000000000 --- a/hack/bin/cabal-project-local-template.sh +++ /dev/null @@ -1,16 +0,0 @@ -#!/usr/bin/env bash -set -euo pipefail - -DIR="$( cd "$( dirname "${BASH_SOURCE[0]}" )" && pwd )" -TOP_LEVEL="$(cd "$DIR/../.." && pwd)" - -cd "$TOP_LEVEL" - -package_options=$1 - -local_projects=$(find . -name '*.cabal' | grep -v dist-newstyle | xargs -n 1 basename | sed 's|.cabal||g' | sort) - -for project in $local_projects; do - echo "package $project - $package_options" -done diff --git a/hack/bin/cabal.project.local.template b/hack/bin/cabal.project.local.template new file mode 100644 index 00000000000..9264d3a48f4 --- /dev/null +++ b/hack/bin/cabal.project.local.template @@ -0,0 +1,6 @@ +test-show-details: direct +profiling: False +profiling-detail: late +optimization: False +program-options + ghc-options: -O0 From 506a880be360ba9b5b9cf2462f166a04f33fb887 Mon Sep 17 00:00:00 2001 From: Matthias Fischmann Date: Sat, 6 Jul 2024 00:16:25 +0200 Subject: [PATCH 60/64] Fix scim logic: delete dangling external_ids if they happen. (#4120) --- .../3-bug-fixes/WPB-9708-scim-gc-logic | 1 + libs/hscim/src/Web/Scim/Server/Mock.hs | 2 +- libs/hscim/src/Web/Scim/Test/Acceptance.hs | 3 +- libs/hscim/test/Test/Class/UserSpec.hs | 7 +- services/spar/src/Spar/Scim/User.hs | 69 ++++++++----------- .../Test/Spar/Scim/UserSpec.hs | 16 +++-- services/spar/test/Test/Spar/Scim/UserSpec.hs | 8 +-- 7 files changed, 51 insertions(+), 55 deletions(-) create mode 100644 changelog.d/3-bug-fixes/WPB-9708-scim-gc-logic diff --git a/changelog.d/3-bug-fixes/WPB-9708-scim-gc-logic b/changelog.d/3-bug-fixes/WPB-9708-scim-gc-logic new file mode 100644 index 00000000000..42a461c408e --- /dev/null +++ b/changelog.d/3-bug-fixes/WPB-9708-scim-gc-logic @@ -0,0 +1 @@ +Make scim-delete-user idempotent. Hide information about existing users (make delete idempotent) \ No newline at end of file diff --git a/libs/hscim/src/Web/Scim/Server/Mock.hs b/libs/hscim/src/Web/Scim/Server/Mock.hs index 11a81d35642..b7c07b2d999 100644 --- a/libs/hscim/src/Web/Scim/Server/Mock.hs +++ b/libs/hscim/src/Web/Scim/Server/Mock.hs @@ -141,7 +141,7 @@ instance UserDB Mock TestServer where deleteUser () uid = do m <- asks userDB liftSTM (STMMap.lookup uid m) >>= \case - Nothing -> throwScim (notFound "User" (pack (show uid))) + Nothing -> pure () Just _ -> liftSTM $ STMMap.delete uid m -- (there seems to be no readOnly fields in User) diff --git a/libs/hscim/src/Web/Scim/Test/Acceptance.hs b/libs/hscim/src/Web/Scim/Test/Acceptance.hs index d6475eb1ad4..e5bb3b995cb 100644 --- a/libs/hscim/src/Web/Scim/Test/Acceptance.hs +++ b/libs/hscim/src/Web/Scim/Test/Acceptance.hs @@ -263,7 +263,8 @@ microsoftAzure AcceptanceConfig {..} = do patch' queryConfig ("/Users/" <> testuid) op3 `shouldRespondWith` result3 -- Delete User delete' queryConfig ("/Users/" <> testuid) "" `shouldRespondWith` 204 - delete' queryConfig ("/Users/" <> testuid) "" `shouldEventuallyRespondWith` 404 + -- (... idempotently) + delete' queryConfig ("/Users/" <> testuid) "" `shouldRespondWith` 204 it "Group operations" $ const pending sampleUser1 :: Text -> L.ByteString diff --git a/libs/hscim/test/Test/Class/UserSpec.hs b/libs/hscim/test/Test/Class/UserSpec.hs index 8bfc45bb945..6a46738dccc 100644 --- a/libs/hscim/test/Test/Class/UserSpec.hs +++ b/libs/hscim/test/Test/Class/UserSpec.hs @@ -383,14 +383,15 @@ spec = with app $ do { matchStatus = 200 } describe "DELETE /Users/:id" $ do - it "responds with 404 for unknown user" $ do - delete "/9999" `shouldRespondWith` 404 + it "responds with 204 for unknown user" $ do + delete "/9999" `shouldRespondWith` 204 it "deletes a stored user" $ do post "/" newBarbara `shouldRespondWith` 201 delete "/0" `shouldRespondWith` 204 -- user should be gone get "/0" `shouldRespondWith` 404 - delete "/0" `shouldRespondWith` 404 + -- delete is idempotent + delete "/0" `shouldRespondWith` 204 smallUser :: ByteString smallUser = diff --git a/services/spar/src/Spar/Scim/User.hs b/services/spar/src/Spar/Scim/User.hs index 99f5e3eb674..0ce2a38a2fd 100644 --- a/services/spar/src/Spar/Scim/User.hs +++ b/services/spar/src/Spar/Scim/User.hs @@ -45,7 +45,7 @@ where import qualified Control.Applicative as Applicative (empty) import Control.Lens hiding (op) import Control.Monad.Error.Class (MonadError) -import Control.Monad.Except (throwError, withExceptT) +import Control.Monad.Except (throwError) import Control.Monad.Trans.Except (mapExceptT) import Control.Monad.Trans.Maybe (MaybeT (MaybeT), runMaybeT) import Crypto.Hash (Digest, SHA256, hashlazy) @@ -495,17 +495,18 @@ createValidScimUser tokeninfo@ScimTokenInfo {stiTeam} vsu@(ST.ValidScimUser veid Just (buid, ScimUserCreated) -> -- If the user has been created, but can't be found in brig anymore, -- the invitation has timed out and the user has been deleted on brig's side. - -- If this is the case we can safely create the user again. + -- If this is the case we can safely create the user again, AFTER THE + -- HALF-CREATED ACCOUNT HAS BEEN GARBAGE-COLLECTED. -- Otherwise we return a conflict error. lift (BrigAccess.getStatusMaybe buid) >>= \case Just Active -> throwError (externalIdTakenError ("user with status Active exists: " <> Text.pack (show (veid, buid)))) Just Suspended -> throwError (externalIdTakenError ("user with status Suspended exists" <> Text.pack (show (veid, buid)))) Just Ephemeral -> throwError (externalIdTakenError ("user with status Ephemeral exists" <> Text.pack (show (veid, buid)))) Just PendingInvitation -> throwError (externalIdTakenError ("user with status PendingInvitation exists" <> Text.pack (show (veid, buid)))) - Just Deleted -> pure () - Nothing -> pure () + Just Deleted -> incompleteUserCreationCleanUp buid + Nothing -> incompleteUserCreationCleanUp buid Just (buid, ScimUserCreating) -> - incompleteUserCreationCleanUp buid externalIdTakenError + incompleteUserCreationCleanUp buid Nothing -> pure () -- ensure uniqueness constraints of all affected identifiers. @@ -568,15 +569,14 @@ createValidScimUser tokeninfo@ScimTokenInfo {stiTeam} vsu@(ST.ValidScimUser veid lift $ ScimExternalIdStore.insertStatus stiTeam veid buid ScimUserCreated pure storedUser where - incompleteUserCreationCleanUp :: UserId -> (Text -> Scim.ScimError) -> Scim.ScimHandler (Sem r) () - incompleteUserCreationCleanUp buid e = do + incompleteUserCreationCleanUp :: UserId -> Scim.ScimHandler (Sem r) () + incompleteUserCreationCleanUp buid = do -- something went wrong while storing the user in brig -- we can try clean up now, but if brig is down, we can't do much - -- maybe retrying the user creation in brig is also an option? - -- after clean up we rethrow the error so the handler returns the correct failure + -- and just fail with a 5xx. lift $ Logger.warn $ Log.msg @Text "An earlier attempt of creating a user with this external ID has failed and left some inconsistent data. Attempting to clean up." - withExceptT (e . ("could not delete scim user: " <>) . Text.pack . show) $ deleteScimUser tokeninfo buid - lift $ Logger.info $ Log.msg @Text "Clean up successful." + deleteScimUser tokeninfo buid + lift $ Logger.info $ Log.msg @Text "Clean up complete." externalIdTakenError :: Text -> Scim.ScimError externalIdTakenError msg = Scim.conflict {Scim.detail = Just ("ExternalId is already taken: " <> msg)} @@ -779,47 +779,36 @@ deleteScimUser tokeninfo@ScimTokenInfo {stiTeam, stiIdP} uid = . logUser uid ) (const id) - $ do + do -- `getBrigUser` does not include deleted users. This is fine: these -- ("tombstones") would not have the needed values (`userIdentity = -- Nothing`) to delete a user in spar. I.e. `SAML.UserRef` and `Email` -- cannot be figured out when a `User` has status `Deleted`. mbBrigUser <- lift $ Brig.getBrigUser WithPendingInvitations uid - deletionStatus <- case mbBrigUser of + case mbBrigUser of Nothing -> -- Ensure there's no left-over of this user in brig. This is safe -- because the user has either been deleted (tombstone) or does not -- exist. Asserting the correct team id here is not needed (and would -- be hard as the check relies on the data of `mbBrigUser`): The worst - -- thing that could happen is that foreign users cleanup particially + -- thing that could happen is that foreign users cleanup partially -- deleted users. - lift $ BrigAccess.deleteUser uid + void . lift $ BrigAccess.deleteUser uid Just brigUser -> do - -- FUTUREWORK: currently it's impossible to delete the last available team owner via SCIM - -- (because that owner won't be managed by SCIM in the first place), but if it ever becomes - -- possible, we should do a check here and prohibit it. - unless (userTeam brigUser == Just stiTeam) $ - -- users from other teams get you a 404. - throwError $ - Scim.notFound "user" (idToText uid) - - -- This deletion needs data from the non-deleted User in brig. So, - -- execute it first, then delete the user in brig. Unfortunately, this - -- dependency prevents us from cleaning up the spar fragments of users - -- that have been deleted in brig. Deleting scim-managed users in brig - -- (via the TM app) is blocked, though, so there is no legal way to enter - -- that situation. - deleteUserInSpar brigUser - lift $ BrigAccess.deleteUser uid - case deletionStatus of - NoUser -> - throwError $ - Scim.notFound "user" (idToText uid) - AccountAlreadyDeleted -> - throwError $ - Scim.notFound "user" (idToText uid) - AccountDeleted -> - pure () + if userTeam brigUser == Just stiTeam + then do + -- This deletion needs data from the non-deleted User in brig. So, + -- execute it first, then delete the user in brig. Unfortunately, this + -- dependency prevents us from cleaning up the spar fragments of users + -- that have been deleted in brig. Deleting scim-managed users in brig + -- (via the TM app) is blocked, though, so there is no legal way to enter + -- that situation. + deleteUserInSpar brigUser + void . lift $ BrigAccess.deleteUser uid + else do + -- if we find the user in another team, we pretend it wasn't even there, to + -- avoid leaking data to attackers (very unlikely, but hey). + pure () where deleteUserInSpar :: ( Member IdPConfigStore r, diff --git a/services/spar/test-integration/Test/Spar/Scim/UserSpec.hs b/services/spar/test-integration/Test/Spar/Scim/UserSpec.hs index 6dbadf09ed3..c5d6ae7f436 100644 --- a/services/spar/test-integration/Test/Spar/Scim/UserSpec.hs +++ b/services/spar/test-integration/Test/Spar/Scim/UserSpec.hs @@ -2100,7 +2100,7 @@ specDeleteUser = do liftIO $ (brigUser, samlUser, scimUser) `shouldBe` (Nothing, Nothing, Nothing) - it "should respond with 204 on first deletion, then 404" $ do + it "should respond with 204 on deletion (also indempotently)" $ do (tok, _) <- registerIdPAndScimToken user <- randomScimUser storedUser <- createUser tok user @@ -2109,9 +2109,9 @@ specDeleteUser = do -- Expect first call to succeed deleteUser_ (Just tok) (Just uid) spar !!! const 204 === statusCode - -- Subsequent calls will return 404 eventually - aFewTimes (deleteUser_ (Just tok) (Just uid) spar) ((== 404) . statusCode) - !!! const 404 === statusCode + -- Subsequent calls will always return 204 (idempotency of deletion) + deleteUser_ (Just tok) (Just uid) spar + !!! const 204 === statusCode it "should free externalId and everything else in the scim user for re-use" $ do (tok, _) <- registerIdPAndScimToken user <- randomScimUser @@ -2133,7 +2133,7 @@ specDeleteUser = do let uid = scimUserId storedUser deleteUser_ Nothing (Just uid) spar !!! const 401 === statusCode - it "should return 404 if we provide a token for a different team" $ do + it "should always pretend to succeed, even if user exists in other team (does not leak information by diverging behavior)" $ do (tok, _) <- registerIdPAndScimToken user <- randomScimUser storedUser <- createUser tok user @@ -2141,7 +2141,9 @@ specDeleteUser = do (invalidTok, _) <- registerIdPAndScimToken spar <- view teSpar deleteUser_ (Just invalidTok) (Just uid) spar - !!! const 404 === statusCode + !!! const 204 === statusCode + getUser_ (Just tok) uid spar + !!! const 200 === statusCode it "getUser should return 404 after deleteUser" $ do user <- randomScimUser (tok, _) <- registerIdPAndScimToken @@ -2152,6 +2154,8 @@ specDeleteUser = do !!! const 204 === statusCode aFewTimes (getUser_ (Just tok) uid spar) ((== 404) . statusCode) !!! const 404 === statusCode + deleteUser_ (Just tok) (Just uid) spar + !!! const 204 === statusCode it "whether implemented or not, does *NOT EVER* respond with 5xx!" $ do env <- ask user <- randomScimUser diff --git a/services/spar/test/Test/Spar/Scim/UserSpec.hs b/services/spar/test/Test/Spar/Scim/UserSpec.hs index 99888ac657c..3cbd3208669 100644 --- a/services/spar/test/Test/Spar/Scim/UserSpec.hs +++ b/services/spar/test/Test/Spar/Scim/UserSpec.hs @@ -37,22 +37,22 @@ spec = describe "deleteScimUser" $ do (mockBrig (withActiveUser acc) AccountDeleted) (deleteUserAndAssertDeletionInSpar acc tokenInfo) r `shouldBe` Right () - it "returns an error when the account was deleted before" $ do + it "is idempotent" $ do tokenInfo <- generate arbitrary acc <- someActiveUser tokenInfo r <- interpretWithBrigAccessMock (mockBrig (withActiveUser acc) AccountAlreadyDeleted) (deleteUserAndAssertDeletionInSpar acc tokenInfo) - r `shouldBe` Left (notFound "user" ((idToText . userId . accountUser) acc)) - it "returns an error when there never was an account" $ do + r `shouldBe` Right () + it "works if there never was an account" $ do uid <- generate arbitrary tokenInfo <- generate arbitrary r <- interpretWithBrigAccessMock (mockBrig (const Nothing) NoUser) (runExceptT $ deleteScimUser tokenInfo uid) - r `shouldBe` Left (notFound "user" (idToText uid)) + r `shouldBe` Right () it "returns no error when there was a partially deleted account" $ do uid <- generate arbitrary tokenInfo <- generate arbitrary From a497b48e4839e75b2ea19292aa5bbec7849b91df Mon Sep 17 00:00:00 2001 From: Akshay Mankar Date: Mon, 8 Jul 2024 08:04:34 +0200 Subject: [PATCH 61/64] Introduce VerificationCodeSubsystem (#4121) --- .../5-internal/verification-code-subsystem | 1 + libs/polysemy-wire-zoo/src/Wire/Sem/Random.hs | 2 + .../src/Wire/Sem/Random/IO.hs | 2 + libs/types-common/src/Data/Code.hs | 2 +- libs/types-common/src/Data/RetryAfter.hs | 2 +- libs/wire-subsystems/default.nix | 5 + .../src/Wire/AuthenticationSubsystem/Error.hs | 20 +- libs/wire-subsystems/src/Wire/Error.hs | 35 ++ .../wire-subsystems/src/Wire/UserSubsystem.hs | 29 -- .../src/Wire/UserSubsystem/Error.hs | 22 +- .../src/Wire/UserSubsystem/Interpreter.hs | 1 + .../src/Wire/VerificationCode.hs | 116 ++++++ .../src/Wire/VerificationCodeGen.hs | 110 ++++++ .../src/Wire/VerificationCodeStore.hs | 17 + .../Wire/VerificationCodeStore/Cassandra.hs | 83 +++++ .../src/Wire/VerificationCodeSubsystem.hs | 63 ++++ .../VerificationCodeSubsystem/Interpreter.hs | 89 +++++ .../InterpreterSpec.hs | 3 - .../test/unit/Wire/MiniBackend.hs | 1 + .../test/unit/Wire/MockInterpreters.hs | 2 + .../test/unit/Wire/MockInterpreters/Now.hs | 3 + .../test/unit/Wire/MockInterpreters/Random.hs | 37 ++ .../MockInterpreters/VerificationCodeStore.hs | 62 ++++ .../Wire/UserSubsystem/InterpreterSpec.hs | 1 + .../InterpreterSpec.hs | 200 +++++++++++ libs/wire-subsystems/wire-subsystems.cabal | 13 + services/brig/brig.cabal | 1 - services/brig/src/Brig/API/Auth.hs | 6 +- services/brig/src/Brig/API/Client.hs | 7 +- services/brig/src/Brig/API/Error.hs | 74 ++-- services/brig/src/Brig/API/Federation.hs | 13 +- services/brig/src/Brig/API/Handler.hs | 14 +- services/brig/src/Brig/API/Internal.hs | 34 +- services/brig/src/Brig/API/Public.hs | 41 ++- services/brig/src/Brig/API/User.hs | 54 ++- services/brig/src/Brig/API/Util.hs | 10 - services/brig/src/Brig/Calling/API.hs | 1 + .../brig/src/Brig/CanonicalInterpreter.hs | 33 +- services/brig/src/Brig/Code.hs | 339 ------------------ services/brig/src/Brig/Provider/API.hs | 124 ++++--- services/brig/src/Brig/Team/API.hs | 1 + services/brig/src/Brig/Team/Util.hs | 7 +- services/brig/src/Brig/User/Auth.hs | 16 +- .../brig/test/integration/API/Provider.hs | 19 +- .../brig/test/integration/API/User/Client.hs | 10 +- .../brig/test/integration/API/User/Util.hs | 6 +- services/brig/test/integration/Util.hs | 2 +- 47 files changed, 1109 insertions(+), 624 deletions(-) create mode 100644 changelog.d/5-internal/verification-code-subsystem create mode 100644 libs/wire-subsystems/src/Wire/Error.hs create mode 100644 libs/wire-subsystems/src/Wire/VerificationCode.hs create mode 100644 libs/wire-subsystems/src/Wire/VerificationCodeGen.hs create mode 100644 libs/wire-subsystems/src/Wire/VerificationCodeStore.hs create mode 100644 libs/wire-subsystems/src/Wire/VerificationCodeStore/Cassandra.hs create mode 100644 libs/wire-subsystems/src/Wire/VerificationCodeSubsystem.hs create mode 100644 libs/wire-subsystems/src/Wire/VerificationCodeSubsystem/Interpreter.hs create mode 100644 libs/wire-subsystems/test/unit/Wire/MockInterpreters/Random.hs create mode 100644 libs/wire-subsystems/test/unit/Wire/MockInterpreters/VerificationCodeStore.hs create mode 100644 libs/wire-subsystems/test/unit/Wire/VerificationCodeSubsystem/InterpreterSpec.hs delete mode 100644 services/brig/src/Brig/Code.hs diff --git a/changelog.d/5-internal/verification-code-subsystem b/changelog.d/5-internal/verification-code-subsystem new file mode 100644 index 00000000000..530645f29a6 --- /dev/null +++ b/changelog.d/5-internal/verification-code-subsystem @@ -0,0 +1 @@ +Introduce VerificationCodSubsystem \ No newline at end of file diff --git a/libs/polysemy-wire-zoo/src/Wire/Sem/Random.hs b/libs/polysemy-wire-zoo/src/Wire/Sem/Random.hs index 0d563a187af..8cc1ef33868 100644 --- a/libs/polysemy-wire-zoo/src/Wire/Sem/Random.hs +++ b/libs/polysemy-wire-zoo/src/Wire/Sem/Random.hs @@ -23,6 +23,7 @@ module Wire.Sem.Random uuid, scimTokenId, liftRandom, + nDigitNumber, ) where @@ -37,5 +38,6 @@ data Random m a where Uuid :: Random m UUID ScimTokenId :: Random m ScimTokenId LiftRandom :: (forall mr. (MonadRandom mr) => mr a) -> Random m a + NDigitNumber :: Int -> Random m Integer makeSem ''Random diff --git a/libs/polysemy-wire-zoo/src/Wire/Sem/Random/IO.hs b/libs/polysemy-wire-zoo/src/Wire/Sem/Random/IO.hs index 5095decee8c..d073d267e8b 100644 --- a/libs/polysemy-wire-zoo/src/Wire/Sem/Random/IO.hs +++ b/libs/polysemy-wire-zoo/src/Wire/Sem/Random/IO.hs @@ -23,6 +23,7 @@ where import Data.Id (randomId) import qualified Data.UUID.V4 as UUID import Imports +import OpenSSL.BN import OpenSSL.Random (randBytes) import Polysemy import Wire.Sem.Random (Random (..)) @@ -36,3 +37,4 @@ randomToIO = interpret $ \case Uuid -> embed $ UUID.nextRandom ScimTokenId -> embed $ randomId @IO LiftRandom m -> embed @IO $ m + NDigitNumber n -> embed $ randIntegerZeroToNMinusOne (10 ^ n) diff --git a/libs/types-common/src/Data/Code.hs b/libs/types-common/src/Data/Code.hs index ef70a0aeb52..6bba1c5f087 100644 --- a/libs/types-common/src/Data/Code.hs +++ b/libs/types-common/src/Data/Code.hs @@ -44,7 +44,7 @@ import Test.QuickCheck (Arbitrary (arbitrary)) -- | A scoped identifier for a 'Value' with an associated 'Timeout'. newtype Key = Key {asciiKey :: Range 20 20 AsciiBase64Url} - deriving (Eq, Show) + deriving (Eq, Show, Ord) deriving newtype ( A.FromJSON, A.ToJSON, diff --git a/libs/types-common/src/Data/RetryAfter.hs b/libs/types-common/src/Data/RetryAfter.hs index e06c6b8bd06..ced0efd84e0 100644 --- a/libs/types-common/src/Data/RetryAfter.hs +++ b/libs/types-common/src/Data/RetryAfter.hs @@ -21,4 +21,4 @@ import Imports newtype RetryAfter = RetryAfter {retryAfterSeconds :: Int64} - deriving (Eq, Show) + deriving (Eq, Show, Num, Ord, Enum, Real, Integral) diff --git a/libs/wire-subsystems/default.nix b/libs/wire-subsystems/default.nix index 2e3a1eb36db..ab5d6d19a48 100644 --- a/libs/wire-subsystems/default.nix +++ b/libs/wire-subsystems/default.nix @@ -39,6 +39,7 @@ , iso639 , lens , lib +, memory , mime , mime-mail , network @@ -51,6 +52,7 @@ , postie , QuickCheck , quickcheck-instances +, random , resource-pool , resourcet , retry @@ -93,6 +95,7 @@ mkDerivation { cassandra-util containers cql + crypton currency-codes data-default data-timeout @@ -112,6 +115,7 @@ mkDerivation { imports iso639 lens + memory mime mime-mail network @@ -169,6 +173,7 @@ mkDerivation { postie QuickCheck quickcheck-instances + random servant-client-core streaming-commons string-conversions diff --git a/libs/wire-subsystems/src/Wire/AuthenticationSubsystem/Error.hs b/libs/wire-subsystems/src/Wire/AuthenticationSubsystem/Error.hs index 28532db6c1c..5efede38c26 100644 --- a/libs/wire-subsystems/src/Wire/AuthenticationSubsystem/Error.hs +++ b/libs/wire-subsystems/src/Wire/AuthenticationSubsystem/Error.hs @@ -16,14 +16,14 @@ -- with this program. If not, see . module Wire.AuthenticationSubsystem.Error ( AuthenticationSubsystemError (..), - authenticationSubsystemErrorToWai, + authenticationSubsystemErrorToHttpError, ) where import Imports -import Network.Wai.Utilities.Error qualified as Wai import Wire.API.Error import Wire.API.Error.Brig qualified as E +import Wire.Error data AuthenticationSubsystemError = AuthenticationSubsystemInvalidPasswordResetKey @@ -35,11 +35,11 @@ data AuthenticationSubsystemError instance Exception AuthenticationSubsystemError -authenticationSubsystemErrorToWai :: AuthenticationSubsystemError -> Wai.Error -authenticationSubsystemErrorToWai = - dynErrorToWai . \case - AuthenticationSubsystemInvalidPasswordResetKey -> dynError @(MapError E.InvalidPasswordResetKey) - AuthenticationSubsystemInvalidPasswordResetCode -> dynError @(MapError E.InvalidPasswordResetCode) - AuthenticationSubsystemResetPasswordMustDiffer -> dynError @(MapError E.ResetPasswordMustDiffer) - AuthenticationSubsystemInvalidPhone -> dynError @(MapError E.InvalidPhone) - AuthenticationSubsystemAllowListError -> dynError @(MapError E.AllowlistError) +authenticationSubsystemErrorToHttpError :: AuthenticationSubsystemError -> HttpError +authenticationSubsystemErrorToHttpError = + StdError . \case + AuthenticationSubsystemInvalidPasswordResetKey -> errorToWai @E.InvalidPasswordResetKey + AuthenticationSubsystemInvalidPasswordResetCode -> errorToWai @E.InvalidPasswordResetCode + AuthenticationSubsystemResetPasswordMustDiffer -> errorToWai @E.ResetPasswordMustDiffer + AuthenticationSubsystemInvalidPhone -> errorToWai @E.InvalidPhone + AuthenticationSubsystemAllowListError -> errorToWai @E.AllowlistError diff --git a/libs/wire-subsystems/src/Wire/Error.hs b/libs/wire-subsystems/src/Wire/Error.hs new file mode 100644 index 00000000000..1710571d161 --- /dev/null +++ b/libs/wire-subsystems/src/Wire/Error.hs @@ -0,0 +1,35 @@ +module Wire.Error where + +import Data.Aeson +import Data.Aeson.KeyMap qualified as KeyMap +import Data.ByteString qualified as BS +import Data.Text qualified as Text +import Data.Text.Encoding qualified as Text +import Imports +import Network.HTTP.Types +import Network.Wai.Utilities.Error qualified as Wai + +-- | Error thrown to the user +data HttpError where + StdError :: !Wai.Error -> HttpError + RichError :: (ToJSON a) => !Wai.Error -> !a -> [Header] -> HttpError + +instance Show HttpError where + show (StdError werr) = "StdError (" <> show werr <> ")" + show e@(RichError _ _ headers) = "RichError (json = " <> Text.unpack (Text.decodeUtf8 $ BS.toStrict $ encode e) <> ", headers = " <> show headers <> ")" + +instance Exception HttpError + +errorLabel :: HttpError -> LText +errorLabel (StdError e) = Wai.label e +errorLabel (RichError e _ _) = Wai.label e + +errorStatus :: HttpError -> Status +errorStatus (StdError e) = Wai.code e +errorStatus (RichError e _ _) = Wai.code e + +instance ToJSON HttpError where + toJSON (StdError e) = toJSON e + toJSON (RichError e x _) = case (toJSON e, toJSON x) of + (Object o1, Object o2) -> Object (KeyMap.union o1 o2) + (j, _) -> j diff --git a/libs/wire-subsystems/src/Wire/UserSubsystem.hs b/libs/wire-subsystems/src/Wire/UserSubsystem.hs index 52140de5db8..16f53f23f1d 100644 --- a/libs/wire-subsystems/src/Wire/UserSubsystem.hs +++ b/libs/wire-subsystems/src/Wire/UserSubsystem.hs @@ -7,41 +7,12 @@ import Data.Handle (Handle) import Data.Id import Data.Qualified import Imports -import Network.Wai.Utilities qualified as Wai import Polysemy -import Wire.API.Error -import Wire.API.Error.Brig qualified as E import Wire.API.Federation.Error import Wire.API.User import Wire.Arbitrary import Wire.UserKeyStore --- | All errors that are thrown by the user subsystem are subsumed under this sum type. -data UserSubsystemError - = -- | user is managed by scim or e2ei is enabled - -- FUTUREWORK(mangoiv): the name should probably resemble that - UserSubsystemDisplayNameManagedByScim - | UserSubsystemHandleManagedByScim - | UserSubsystemLocaleManagedByScim - | UserSubsystemNoIdentity - | UserSubsystemHandleExists - | UserSubsystemInvalidHandle - | UserSubsystemProfileNotFound - deriving (Eq, Show) - -userSubsystemErrorToWai :: UserSubsystemError -> Wai.Error -userSubsystemErrorToWai = - dynErrorToWai . \case - UserSubsystemProfileNotFound -> dynError @(MapError E.UserNotFound) - UserSubsystemDisplayNameManagedByScim -> dynError @(MapError E.NameManagedByScim) - UserSubsystemLocaleManagedByScim -> dynError @(MapError E.LocaleManagedByScim) - UserSubsystemNoIdentity -> dynError @(MapError E.NoIdentity) - UserSubsystemHandleExists -> dynError @(MapError E.HandleExists) - UserSubsystemInvalidHandle -> dynError @(MapError E.InvalidHandle) - UserSubsystemHandleManagedByScim -> dynError @(MapError E.HandleManagedByScim) - -instance Exception UserSubsystemError - -- | Who is performing this update operation? (Single source of truth: users managed by SCIM -- can't be updated by clients and vice versa.) data UpdateOriginType diff --git a/libs/wire-subsystems/src/Wire/UserSubsystem/Error.hs b/libs/wire-subsystems/src/Wire/UserSubsystem/Error.hs index 1ade57b4b9c..40006412b47 100644 --- a/libs/wire-subsystems/src/Wire/UserSubsystem/Error.hs +++ b/libs/wire-subsystems/src/Wire/UserSubsystem/Error.hs @@ -1,9 +1,9 @@ module Wire.UserSubsystem.Error where import Imports -import Network.Wai.Utilities qualified as Wai import Wire.API.Error import Wire.API.Error.Brig qualified as E +import Wire.Error -- | All errors that are thrown by the user subsystem are subsumed under this sum type. data UserSubsystemError @@ -18,15 +18,15 @@ data UserSubsystemError | UserSubsystemProfileNotFound deriving (Eq, Show) -userSubsystemErrorToWai :: UserSubsystemError -> Wai.Error -userSubsystemErrorToWai = - dynErrorToWai . \case - UserSubsystemProfileNotFound -> dynError @(MapError E.UserNotFound) - UserSubsystemDisplayNameManagedByScim -> dynError @(MapError E.NameManagedByScim) - UserSubsystemLocaleManagedByScim -> dynError @(MapError E.LocaleManagedByScim) - UserSubsystemNoIdentity -> dynError @(MapError E.NoIdentity) - UserSubsystemHandleExists -> dynError @(MapError E.HandleExists) - UserSubsystemInvalidHandle -> dynError @(MapError E.InvalidHandle) - UserSubsystemHandleManagedByScim -> dynError @(MapError E.HandleManagedByScim) +userSubsystemErrorToHttpError :: UserSubsystemError -> HttpError +userSubsystemErrorToHttpError = + StdError . \case + UserSubsystemProfileNotFound -> errorToWai @E.UserNotFound + UserSubsystemDisplayNameManagedByScim -> errorToWai @E.NameManagedByScim + UserSubsystemLocaleManagedByScim -> errorToWai @E.LocaleManagedByScim + UserSubsystemNoIdentity -> errorToWai @E.NoIdentity + UserSubsystemHandleExists -> errorToWai @E.HandleExists + UserSubsystemInvalidHandle -> errorToWai @E.InvalidHandle + UserSubsystemHandleManagedByScim -> errorToWai @E.HandleManagedByScim instance Exception UserSubsystemError diff --git a/libs/wire-subsystems/src/Wire/UserSubsystem/Interpreter.hs b/libs/wire-subsystems/src/Wire/UserSubsystem/Interpreter.hs index 1e5ed37182b..945f128e700 100644 --- a/libs/wire-subsystems/src/Wire/UserSubsystem/Interpreter.hs +++ b/libs/wire-subsystems/src/Wire/UserSubsystem/Interpreter.hs @@ -39,6 +39,7 @@ import Wire.UserEvents import Wire.UserKeyStore import Wire.UserStore as UserStore import Wire.UserSubsystem +import Wire.UserSubsystem.Error import Wire.UserSubsystem.HandleBlacklist data UserSubsystemConfig = UserSubsystemConfig diff --git a/libs/wire-subsystems/src/Wire/VerificationCode.hs b/libs/wire-subsystems/src/Wire/VerificationCode.hs new file mode 100644 index 00000000000..1caea31049d --- /dev/null +++ b/libs/wire-subsystems/src/Wire/VerificationCode.hs @@ -0,0 +1,116 @@ +module Wire.VerificationCode + ( Code (..), + Key (..), + Scope (..), + Value (..), + KeyValuePair (..), + Timeout (..), + Retries (..), + codeToKeyValuePair, + scopeFromAction, + ) +where + +import Cassandra hiding (Value) +import Data.Code +import Data.UUID (UUID) +import Imports hiding (lookup) +import Wire.API.User qualified as User +import Wire.API.User.Identity +import Wire.Arbitrary + +-- Note [Unique keys] +-- +-- We want unique, stable keys that we can associate the secret values with. +-- Using the plain natural identifiers (e.g. e-mail addresses or phone numbers) +-- has a few downsides: +-- +-- * The keys are often placed in URLs for verification purposes, +-- giving them unnecessary exposure. +-- * If the keys are not opaque, it can be harder to change their +-- structure, possibly embedding additional information. +-- * Since the keys are often placed in URLs, they must only contain +-- URL-safe characters or otherwise require appropriate encoding. +-- +-- Therefore we use the following simple construction: +-- +-- * Compute the SHA-256 truncated to 120 bits of the plain, normalised, +-- utf8-encoded natural identifier (i.e. e-mail address or phone number). +-- * Apply URL-safe base64 encoding to yield the final key of length 20. +-- +-- Truncation of SHA-2 outputs is a safe and common practice, only reducing +-- collision resistance (e.g. after 2^60 for truncated SHA-256/120 due to the +-- birthday paradox). Collisions have no security implications in this context; +-- at most it enables verification of one random e-mail address or phone +-- number via another, at least one of which must be accessible. It is only +-- important that keys be sufficiently unique and random collisions rare +-- while keeping the length reasonably short, so that keys may be used in +-- length-constrained contexts (e.g. SMS) or even be spelled out or typed. + +-------------------------------------------------------------------------------- +-- Code + +data Code = Code + { codeKey :: !Key, + codeScope :: !Scope, + codeValue :: !Value, + -- | This field is actually used as number of allowed "tries" rather than + -- "retries", so if a code has a retries = 1, verification can only be tried + -- once, and it cannot actually be "re"-tried after that. + codeRetries :: !Retries, + codeTTL :: !Timeout, + codeFor :: !Email, + codeAccount :: !(Maybe UUID) + } + deriving (Eq, Show) + +scopeFromAction :: User.VerificationAction -> Scope +scopeFromAction = \case + User.CreateScimToken -> CreateScimToken + User.Login -> AccountLogin + User.DeleteTeam -> DeleteTeam + +codeToKeyValuePair :: Code -> KeyValuePair +codeToKeyValuePair code = KeyValuePair code.codeKey code.codeValue + +-- | The same 'Key' can exist with different 'Value's in different +-- 'Scope's at the same time. +data Scope + = AccountDeletion + | IdentityVerification + | PasswordReset + | AccountLogin + | AccountApproval + | CreateScimToken + | DeleteTeam + deriving (Eq, Show, Ord, Generic) + deriving (Arbitrary) via GenericUniform Scope + +instance Cql Scope where + ctype = Tagged IntColumn + + toCql AccountDeletion = CqlInt 1 + toCql IdentityVerification = CqlInt 2 + toCql PasswordReset = CqlInt 3 + toCql AccountLogin = CqlInt 4 + toCql AccountApproval = CqlInt 5 + toCql CreateScimToken = CqlInt 6 + toCql DeleteTeam = CqlInt 7 + + fromCql (CqlInt 1) = pure AccountDeletion + fromCql (CqlInt 2) = pure IdentityVerification + fromCql (CqlInt 3) = pure PasswordReset + fromCql (CqlInt 4) = pure AccountLogin + fromCql (CqlInt 5) = pure AccountApproval + fromCql (CqlInt 6) = pure CreateScimToken + fromCql (CqlInt 7) = pure DeleteTeam + fromCql _ = Left "fromCql: Scope: int expected" + +newtype Retries = Retries {numRetries :: Word8} + deriving (Eq, Show, Ord, Num, Integral, Enum, Real, Arbitrary) + +instance Cql Retries where + ctype = Tagged IntColumn + toCql = CqlInt . fromIntegral . numRetries + fromCql (CqlInt n) = pure (Retries (fromIntegral n)) + fromCql _ = Left "fromCql: Retries: int expected" diff --git a/libs/wire-subsystems/src/Wire/VerificationCodeGen.hs b/libs/wire-subsystems/src/Wire/VerificationCodeGen.hs new file mode 100644 index 00000000000..7290a0fbae4 --- /dev/null +++ b/libs/wire-subsystems/src/Wire/VerificationCodeGen.hs @@ -0,0 +1,110 @@ +module Wire.VerificationCodeGen + ( VerificationCodeGen (genKey), + mkVerificationCodeGen, + mk6DigitVerificationCodeGen, + mkKey, + generateVerificationCode, + ) +where + +import Crypto.Hash +import Data.ByteArray qualified as BA +import Data.ByteString qualified as BS +import Data.Code +import Data.Range +import Data.Text qualified as Text +import Data.Text.Ascii qualified as Ascii +import Data.Text.Encoding qualified as Text +import Data.UUID (UUID) +import Imports hiding (lookup) +import Polysemy +import Text.Printf +import Wire.API.User.Identity +import Wire.Arbitrary +import Wire.Sem.Random +import Wire.Sem.Random qualified as Random +import Wire.UserKeyStore +import Wire.VerificationCode + +-------------------------------------------------------------------------------- +-- VerificationCodeGeneration + +data RandomValueType + = Random6DigitNumber + | Random15Bytes + deriving (Show, Eq, Generic) + deriving (Arbitrary) via GenericUniform RandomValueType + +-- | A contextual string that is hashed into the key to yield distinct keys in +-- different contexts for the same email address. +-- TODO: newtype KeyContext = KeyContext ByteString +data VerificationCodeGen = VerificationCodeGen + { genFor :: !Email, + genKey :: !Key, -- Note [Unique keys] + genValueType :: !RandomValueType + } + deriving (Show, Eq, Generic) + deriving (Arbitrary) via GenericUniform VerificationCodeGen + +-- | Initialise a 'Code' 'VerificationCodeGen'erator for a given natural key. +-- This generates a link for emails and a 6-digit code for phone. See also: +-- `mk6DigitVerificationCodeGen`. +mkVerificationCodeGen :: Email -> VerificationCodeGen +mkVerificationCodeGen email = + VerificationCodeGen email (mkKey email) Random15Bytes + +-- | Initialise a 'Code' 'VerificationCodeGen'erator for a given natural key. +-- This generates a 6-digit code, matter whether it is sent to a phone or to an +-- email address. See also: `mkVerificationCodeGen`. +mk6DigitVerificationCodeGen :: Email -> VerificationCodeGen +mk6DigitVerificationCodeGen email = VerificationCodeGen email (mkKey email) Random6DigitNumber + +mkKey :: Email -> Key +mkKey email = + Key + . unsafeRange + . Ascii.encodeBase64Url + . BS.take 15 + . BA.convert + . hash @_ @SHA256 + . Text.encodeUtf8 + . emailKeyUniq + $ mkEmailKey email + +-- | VerificationCodeGenerate a new 'Code'. +generateVerificationCode :: + (Member Random r) => + -- | The 'VerificationCodeGen'erator to use. + VerificationCodeGen -> + -- | The scope of the generated code. + Scope -> + -- | Maximum verification attempts. + Retries -> + -- | Time-to-live in seconds. + Timeout -> + -- | Associated account ID. + Maybe UUID -> + Sem r Code +generateVerificationCode gen scope retries ttl account = do + let key = genKey gen + val <- genValue gen.genValueType + pure $ mkCode key val + where + mkCode key val = + Code + { codeKey = key, + codeValue = val, + codeScope = scope, + codeRetries = retries, + codeTTL = ttl, + codeFor = genFor gen, + codeAccount = account + } + +genValue :: (Member Random r) => RandomValueType -> Sem r Value +genValue Random15Bytes = + Value . unsafeRange . Ascii.encodeBase64Url + <$> Random.bytes 15 +genValue Random6DigitNumber = + Value . unsafeRange . Ascii.unsafeFromText . Text.pack . printf "%06d" + <$> Random.nDigitNumber 6 diff --git a/libs/wire-subsystems/src/Wire/VerificationCodeStore.hs b/libs/wire-subsystems/src/Wire/VerificationCodeStore.hs new file mode 100644 index 00000000000..335c1f370ff --- /dev/null +++ b/libs/wire-subsystems/src/Wire/VerificationCodeStore.hs @@ -0,0 +1,17 @@ +{-# LANGUAGE TemplateHaskell #-} + +module Wire.VerificationCodeStore where + +import Data.RetryAfter +import Imports +import Polysemy +import Wire.VerificationCode + +data VerificationCodeStore m a where + InsertCode :: Code -> VerificationCodeStore m () + LookupCode :: Key -> Scope -> VerificationCodeStore m (Maybe Code) + DeleteCode :: Key -> Scope -> VerificationCodeStore m () + InsertThrottle :: Key -> Scope -> Word -> VerificationCodeStore m () + LookupThrottle :: Key -> Scope -> VerificationCodeStore m (Maybe RetryAfter) + +makeSem ''VerificationCodeStore diff --git a/libs/wire-subsystems/src/Wire/VerificationCodeStore/Cassandra.hs b/libs/wire-subsystems/src/Wire/VerificationCodeStore/Cassandra.hs new file mode 100644 index 00000000000..e2e013ec62d --- /dev/null +++ b/libs/wire-subsystems/src/Wire/VerificationCodeStore/Cassandra.hs @@ -0,0 +1,83 @@ +module Wire.VerificationCodeStore.Cassandra where + +import Cassandra hiding (Value) +import Data.RetryAfter +import Data.UUID +import Imports +import Polysemy +import Polysemy.Embed +import Wire.API.User.Identity +import Wire.VerificationCode +import Wire.VerificationCodeStore + +interpretVerificationCodeStoreCassandra :: (Member (Embed IO) r) => ClientState -> InterpreterFor VerificationCodeStore r +interpretVerificationCodeStoreCassandra casClient = + interpret $ + runEmbedded (runClient casClient) . \case + InsertCode code -> embed $ insertCodeImpl code + LookupCode key scope -> embed $ lookupCodeImpl key scope + DeleteCode key scope -> embed $ deleteCodeImpl key scope + InsertThrottle key scope ttl -> embed $ insertThrottleImpl key scope ttl + LookupThrottle key scope -> embed $ lookupThrottleImpl key scope + +insertCodeImpl :: (MonadClient m) => Code -> m () +insertCodeImpl c = do + let k = codeKey c + let s = codeScope c + let v = codeValue c + let r = fromIntegral (codeRetries c) + let a = codeAccount c + let e = codeFor c + let t = round (codeTTL c) + retry x5 (write cql (params LocalQuorum (k, s, v, r, e, a, t))) + where + cql :: PrepQuery W (Key, Scope, Value, Retries, Email, Maybe UUID, Int32) () + cql = + "INSERT INTO vcodes (key, scope, value, retries, email, account) \ + \VALUES (?, ?, ?, ?, ?, ?) USING TTL ?" + +-- | Lookup a pending code. +lookupCodeImpl :: (MonadClient m) => Key -> Scope -> m (Maybe Code) +lookupCodeImpl k s = toCode <$$> retry x1 (query1 cql (params LocalQuorum (k, s))) + where + cql :: PrepQuery R (Key, Scope) (Value, Int32, Retries, Email, Maybe UUID) + cql = + "SELECT value, ttl(value), retries, email, account \ + \FROM vcodes WHERE key = ? AND scope = ?" + + toCode :: (Value, Int32, Retries, Email, Maybe UUID) -> Code + toCode (val, ttl, retries, email, account) = + Code + { codeKey = k, + codeScope = s, + codeValue = val, + codeTTL = Timeout (fromIntegral ttl), + codeRetries = retries, + codeFor = email, + codeAccount = account + } + +-- | Delete a code associated with the given key and scope. +deleteCodeImpl :: (MonadClient m) => Key -> Scope -> m () +deleteCodeImpl k s = retry x5 $ write cql (params LocalQuorum (k, s)) + where + cql :: PrepQuery W (Key, Scope) () + cql = "DELETE FROM vcodes WHERE key = ? AND scope = ?" + +lookupThrottleImpl :: (MonadClient m) => Key -> Scope -> m (Maybe RetryAfter) +lookupThrottleImpl k s = do + fmap (RetryAfter . fromIntegral . runIdentity) <$> retry x1 (query1 cql (params LocalQuorum (k, s))) + where + cql :: PrepQuery R (Key, Scope) (Identity Int32) + cql = + "SELECT ttl(initial_delay) \ + \FROM vcodes_throttle WHERE key = ? AND scope = ?" + +insertThrottleImpl :: (MonadClient m) => Key -> Scope -> Word -> m () +insertThrottleImpl k s t = do + retry x5 (write cql (params LocalQuorum (k, s, fromIntegral t, fromIntegral t))) + where + cql :: PrepQuery W (Key, Scope, Int32, Int32) () + cql = + "INSERT INTO vcodes_throttle (key, scope, initial_delay) \ + \VALUES (?, ?, ?) USING TTL ?" diff --git a/libs/wire-subsystems/src/Wire/VerificationCodeSubsystem.hs b/libs/wire-subsystems/src/Wire/VerificationCodeSubsystem.hs new file mode 100644 index 00000000000..bfca9135e15 --- /dev/null +++ b/libs/wire-subsystems/src/Wire/VerificationCodeSubsystem.hs @@ -0,0 +1,63 @@ +{-# LANGUAGE TemplateHaskell #-} + +module Wire.VerificationCodeSubsystem where + +import Data.ByteString.Conversion +import Data.Code +import Data.RetryAfter +import Data.UUID (UUID) +import Imports hiding (lookup) +import Polysemy +import Wire.API.Error +import Wire.API.Error.Brig qualified as E +import Wire.Error +import Wire.VerificationCode +import Wire.VerificationCodeGen + +data VerificationCodeSubsystemError + = VerificationCodeThrottled RetryAfter + deriving (Show, Eq) + +verificationCodeSubsystemErrorToHttpError :: VerificationCodeSubsystemError -> HttpError +verificationCodeSubsystemErrorToHttpError = \case + VerificationCodeThrottled t -> + RichError + (errorToWai @E.VerificationCodeThrottled) + () + [("Retry-After", toByteString' (retryAfterSeconds t))] + +newtype CodeAlreadyExists = CodeAlreadyExists Code + deriving (Show, Eq) + +data VerificationCodeSubsystem m a where + CreateCode :: + -- | The 'Gen'erator to use. + VerificationCodeGen -> + -- | The scope of the generated code. + Scope -> + -- | Maximum verification attempts. + Retries -> + -- | Time-to-live in seconds. + Timeout -> + -- | Associated account ID. + Maybe UUID -> + VerificationCodeSubsystem m (Either CodeAlreadyExists Code) + CreateCodeOverwritePrevious :: + -- | The 'Gen'erator to use. + VerificationCodeGen -> + -- | The scope of the generated code. + Scope -> + -- | Maximum verification attempts. + Retries -> + -- | Time-to-live in seconds. + Timeout -> + -- | Associated account ID. + Maybe UUID -> + VerificationCodeSubsystem m Code + -- Returns the 'Code' iff verification suceeds. + VerifyCode :: Key -> Scope -> Value -> VerificationCodeSubsystem m (Maybe Code) + DeleteCode :: Key -> Scope -> VerificationCodeSubsystem m () + -- For internal endpoints + InternalLookupCode :: Key -> Scope -> VerificationCodeSubsystem m (Maybe Code) + +makeSem ''VerificationCodeSubsystem diff --git a/libs/wire-subsystems/src/Wire/VerificationCodeSubsystem/Interpreter.hs b/libs/wire-subsystems/src/Wire/VerificationCodeSubsystem/Interpreter.hs new file mode 100644 index 00000000000..156be1cbd90 --- /dev/null +++ b/libs/wire-subsystems/src/Wire/VerificationCodeSubsystem/Interpreter.hs @@ -0,0 +1,89 @@ +module Wire.VerificationCodeSubsystem.Interpreter where + +import Data.Code +import Data.RetryAfter (RetryAfter) +import Data.UUID +import Imports +import Polysemy +import Polysemy.Error +import Polysemy.Input +import Wire.Arbitrary +import Wire.Sem.Random +import Wire.VerificationCode +import Wire.VerificationCodeGen +import Wire.VerificationCodeStore as Store hiding (DeleteCode) +import Wire.VerificationCodeSubsystem + +interpretVerificationCodeSubsystem :: + ( Member VerificationCodeStore r, + Member Random r, + Member (Error VerificationCodeSubsystemError) r, + Member (Input VerificationCodeThrottleTTL) r + ) => + InterpreterFor VerificationCodeSubsystem r +interpretVerificationCodeSubsystem = interpret $ \case + CreateCode gen scope retries timeout mId -> createCodeImpl gen scope retries timeout mId + CreateCodeOverwritePrevious gen scope retries timeout mId -> createCodeOverwritePreviousImpl gen scope retries timeout mId + VerifyCode key scope val -> verifyCodeImpl key scope val + DeleteCode key scope -> Store.deleteCode key scope + InternalLookupCode key scope -> Store.lookupCode key scope + +newtype VerificationCodeThrottleTTL = VerificationCodeThrottleTTL Word + deriving (Show, Eq, Arbitrary, Num, Enum, Ord, Real, Integral) + +createCodeImpl :: + ( Member VerificationCodeStore r, + Member Random r, + Member (Error VerificationCodeSubsystemError) r, + Member (Input VerificationCodeThrottleTTL) r + ) => + VerificationCodeGen -> + Scope -> + Retries -> + Timeout -> + Maybe UUID -> + Sem r (Either CodeAlreadyExists Code) +createCodeImpl gen scope retries timeout mId = + lookupCode gen.genKey scope >>= \case + Just c -> pure . Left $ CodeAlreadyExists c + Nothing -> + Right <$> createCodeOverwritePreviousImpl gen scope retries timeout mId + +createCodeOverwritePreviousImpl :: + ( Member VerificationCodeStore r, + Member Random r, + Member (Error VerificationCodeSubsystemError) r, + Member (Input VerificationCodeThrottleTTL) r + ) => + VerificationCodeGen -> + Scope -> + Retries -> + Timeout -> + Maybe UUID -> + Sem r Code +createCodeOverwritePreviousImpl gen scope retries timeout mId = do + code <- generateVerificationCode gen scope retries timeout mId + maybe (pure code) (throw . VerificationCodeThrottled) =<< insert code + +insert :: (Member VerificationCodeStore r, Member (Input VerificationCodeThrottleTTL) r) => Code -> Sem r (Maybe RetryAfter) +insert code = do + VerificationCodeThrottleTTL ttl <- input + mRetryAfter <- lookupThrottle (codeKey code) (codeScope code) + case mRetryAfter of + Just ra -> pure (Just ra) + Nothing -> do + insertThrottle code.codeKey code.codeScope ttl + insertCode code + pure Nothing + +-- | Lookup and verify the code for the given key and scope +-- against the given value. +verifyCodeImpl :: (Member VerificationCodeStore r) => Key -> Scope -> Value -> Sem r (Maybe Code) +verifyCodeImpl k s v = lookupCode k s >>= maybe (pure Nothing) continue + where + continue c + | codeValue c == v && codeRetries c > 0 = pure (Just c) + | codeRetries c > 0 = do + insertCode (c {codeRetries = codeRetries c - 1}) + pure Nothing + | otherwise = pure Nothing diff --git a/libs/wire-subsystems/test/unit/Wire/AuthenticationSubsystem/InterpreterSpec.hs b/libs/wire-subsystems/test/unit/Wire/AuthenticationSubsystem/InterpreterSpec.hs index 9a12b831420..9781ddf3492 100644 --- a/libs/wire-subsystems/test/unit/Wire/AuthenticationSubsystem/InterpreterSpec.hs +++ b/libs/wire-subsystems/test/unit/Wire/AuthenticationSubsystem/InterpreterSpec.hs @@ -74,9 +74,6 @@ interpretDependencies localDomain preexistingUsers preexistingPasswords mAllowed . staticHashPasswordInterpreter . runError -defaultTime :: UTCTime -defaultTime = UTCTime (ModifiedJulianDay 0) 0 - spec :: Spec spec = describe "AuthenticationSubsystem.Interpreter" do describe "password reset" do diff --git a/libs/wire-subsystems/test/unit/Wire/MiniBackend.hs b/libs/wire-subsystems/test/unit/Wire/MiniBackend.hs index 35bf68b5782..d1fea2a4012 100644 --- a/libs/wire-subsystems/test/unit/Wire/MiniBackend.hs +++ b/libs/wire-subsystems/test/unit/Wire/MiniBackend.hs @@ -67,6 +67,7 @@ import Wire.UserEvents import Wire.UserKeyStore import Wire.UserStore import Wire.UserSubsystem +import Wire.UserSubsystem.Error import Wire.UserSubsystem.Interpreter newtype PendingStoredUser = PendingStoredUser StoredUser diff --git a/libs/wire-subsystems/test/unit/Wire/MockInterpreters.hs b/libs/wire-subsystems/test/unit/Wire/MockInterpreters.hs index 5e1c0ffc1ed..2d17f23096b 100644 --- a/libs/wire-subsystems/test/unit/Wire/MockInterpreters.hs +++ b/libs/wire-subsystems/test/unit/Wire/MockInterpreters.hs @@ -10,8 +10,10 @@ import Wire.MockInterpreters.HashPassword as MockInterpreters import Wire.MockInterpreters.Now as MockInterpreters import Wire.MockInterpreters.PasswordResetCodeStore as MockInterpreters import Wire.MockInterpreters.PasswordStore as MockInterpreters +import Wire.MockInterpreters.Random as MockInterpreters import Wire.MockInterpreters.SessionStore as MockInterpreters import Wire.MockInterpreters.UserEvents as MockInterpreters import Wire.MockInterpreters.UserKeyStore as MockInterpreters import Wire.MockInterpreters.UserStore as MockInterpreters import Wire.MockInterpreters.UserSubsystem as MockInterpreters +import Wire.MockInterpreters.VerificationCodeStore as MockInterpreters diff --git a/libs/wire-subsystems/test/unit/Wire/MockInterpreters/Now.hs b/libs/wire-subsystems/test/unit/Wire/MockInterpreters/Now.hs index 52d4116ecaf..826638a4042 100644 --- a/libs/wire-subsystems/test/unit/Wire/MockInterpreters/Now.hs +++ b/libs/wire-subsystems/test/unit/Wire/MockInterpreters/Now.hs @@ -18,5 +18,8 @@ interpretNowAsState = interpret $ \case Wire.Sem.Now.Get -> Polysemy.State.get +defaultTime :: UTCTime +defaultTime = UTCTime (ModifiedJulianDay 0) 0 + passTime :: (Member (State UTCTime) r) => NominalDiffTime -> Sem r () passTime t = modify (addUTCTime t) diff --git a/libs/wire-subsystems/test/unit/Wire/MockInterpreters/Random.hs b/libs/wire-subsystems/test/unit/Wire/MockInterpreters/Random.hs new file mode 100644 index 00000000000..f6c0e77371c --- /dev/null +++ b/libs/wire-subsystems/test/unit/Wire/MockInterpreters/Random.hs @@ -0,0 +1,37 @@ +module Wire.MockInterpreters.Random where + +import Crypto.Random +import Data.ByteString.Short (fromShort) +import Data.Id +import Imports +import Polysemy +import Polysemy.State +import System.Random hiding (Random) +import Wire.Sem.Random + +randomToStatefulStdGen :: (Member (State StdGen) r) => InterpreterFor Random r +randomToStatefulStdGen = interpret $ \case + Bytes n -> do + fromShort <$> withStatefulGen (genShortByteString n) + Uuid -> withStatefulGen random + ScimTokenId -> Id <$> withStatefulGen random + LiftRandom m -> do + seedInt <- withStatefulGen (random @Int) + let seed = seedFromInteger $ toInteger seedInt + drg = drgNewSeed seed + (x, _) = withDRG drg m + pure x + NDigitNumber n -> withStatefulGen $ randomR (0, 10 ^ n - 1) + +runRandomPure :: InterpreterFor Random r +runRandomPure = evalState defaulGen . randomToStatefulStdGen . raiseUnder + +defaulGen :: StdGen +defaulGen = mkStdGen 0xBAD + +withStatefulGen :: (Member (State StdGen) r) => (StdGen -> (a, StdGen)) -> Sem r a +withStatefulGen f = do + g <- get + let (x, g') = f g + put g' + pure x diff --git a/libs/wire-subsystems/test/unit/Wire/MockInterpreters/VerificationCodeStore.hs b/libs/wire-subsystems/test/unit/Wire/MockInterpreters/VerificationCodeStore.hs new file mode 100644 index 00000000000..73b732e5679 --- /dev/null +++ b/libs/wire-subsystems/test/unit/Wire/MockInterpreters/VerificationCodeStore.hs @@ -0,0 +1,62 @@ +module Wire.MockInterpreters.VerificationCodeStore where + +import Control.Error +import Data.Map qualified as Map +import Data.RetryAfter +import Data.Time +import Imports +import Polysemy +import Polysemy.State +import Wire.Sem.Now as Now +import Wire.VerificationCode +import Wire.VerificationCodeStore + +type ExpiresAt = UTCTime + +type CodeState = Map (Key, Scope) (Code, UTCTime) + +type ThrottleState = Map (Key, Scope) (Word, UTCTime) + +inMemoryVerificationCodeStore :: + forall r. + ( Member Now r, + Member (State CodeState) r, + Member (State ThrottleState) r + ) => + InterpreterFor VerificationCodeStore r +inMemoryVerificationCodeStore = + interpret + \case + InsertCode code -> do + expiresAt <- (addUTCTime code.codeTTL.timeoutDiffTime) <$> Now.get + modify $ Map.insert (code.codeKey, code.codeScope) (code, expiresAt) + LookupCode key scope -> lookupWithExpiry (key, scope) + DeleteCode key scope -> modify @CodeState $ Map.delete (key, scope) + InsertThrottle key scope ttl -> do + expiresAt <- (addUTCTime (fromIntegral ttl)) <$> Now.get + modify $ Map.insert (key, scope) (ttl, expiresAt) + LookupThrottle key scope -> RetryAfter . fromIntegral <$$> lookupWithExpiry (key, scope) + +runInMemoryVerificationCodeStore :: (Member Now r) => InterpreterFor VerificationCodeStore r +runInMemoryVerificationCodeStore = + evalState mempty + . evalState mempty + . inMemoryVerificationCodeStore + . raiseUnder @(State CodeState) + . raiseUnder @(State ThrottleState) + +lookupWithExpiry :: + ( Member Now r, + Member (State (Map k (v, UTCTime))) r, + Ord k + ) => + k -> + Sem r (Maybe v) +lookupWithExpiry k = runMaybeT $ do + (v, expiresAt) <- MaybeT $ gets $ Map.lookup k + now <- lift $ Now.get + if now <= expiresAt + then pure v + else MaybeT $ do + modify $ Map.delete k + pure Nothing diff --git a/libs/wire-subsystems/test/unit/Wire/UserSubsystem/InterpreterSpec.hs b/libs/wire-subsystems/test/unit/Wire/UserSubsystem/InterpreterSpec.hs index c1e62bf8cb8..4abd27efd0f 100644 --- a/libs/wire-subsystems/test/unit/Wire/UserSubsystem/InterpreterSpec.hs +++ b/libs/wire-subsystems/test/unit/Wire/UserSubsystem/InterpreterSpec.hs @@ -32,6 +32,7 @@ import Wire.MiniBackend import Wire.StoredUser import Wire.UserKeyStore import Wire.UserSubsystem +import Wire.UserSubsystem.Error import Wire.UserSubsystem.HandleBlacklist import Wire.UserSubsystem.Interpreter (UserSubsystemConfig (..)) diff --git a/libs/wire-subsystems/test/unit/Wire/VerificationCodeSubsystem/InterpreterSpec.hs b/libs/wire-subsystems/test/unit/Wire/VerificationCodeSubsystem/InterpreterSpec.hs new file mode 100644 index 00000000000..20ffabf6270 --- /dev/null +++ b/libs/wire-subsystems/test/unit/Wire/VerificationCodeSubsystem/InterpreterSpec.hs @@ -0,0 +1,200 @@ +module Wire.VerificationCodeSubsystem.InterpreterSpec where + +import Data.Time +import Imports +import Polysemy +import Polysemy.Error +import Polysemy.Input +import Polysemy.State +import Test.Hspec +import Test.Hspec.QuickCheck +import Test.QuickCheck +import Wire.MockInterpreters +import Wire.Sem.Now +import Wire.Sem.Random +import Wire.VerificationCode +import Wire.VerificationCodeGen +import Wire.VerificationCodeStore +import Wire.VerificationCodeSubsystem as Subsystem +import Wire.VerificationCodeSubsystem.Interpreter + +spec :: Spec +spec = describe "Wire.VerificationCodeSubsystem.Interpreter" $ do + describe "createCode/verifyCode" $ do + prop "should be able to create and verify codes" $ + \gen scope retries (abs -> timeout) mId throttle -> + let eitherProp = + runDependencies throttle + . interpretVerificationCodeSubsystem + $ do + c <- createCode gen scope retries timeout mId + case c of + Left (CodeAlreadyExists code) -> pure $ unexpectedCodeAlreadyExists code + Right code -> do + mCode <- verifyCode gen.genKey scope code.codeValue + pure $ retries > 0 ==> mCode === Just code + in assertRightProp eitherProp + + prop "should only allow verification with the same scope" $ + \gen scope retries (abs -> timeout) mId throttle arbitraryScope -> + let eitherProp = + runDependencies throttle + . interpretVerificationCodeSubsystem + $ do + c <- createCode gen scope retries timeout mId + case c of + Left (CodeAlreadyExists code) -> pure $ unexpectedCodeAlreadyExists code + Right code -> do + mCode <- verifyCode gen.genKey arbitraryScope code.codeValue + pure $ retries > 0 && arbitraryScope /= scope ==> mCode === Nothing + in assertRightProp eitherProp + + prop "should only allow verification with correct value" $ + \gen scope retries (abs -> timeout) mId throttle arbitraryVal -> + let eitherProp = + runDependencies throttle + . interpretVerificationCodeSubsystem + $ do + c <- createCode gen scope retries timeout mId + case c of + Left (CodeAlreadyExists code) -> pure $ unexpectedCodeAlreadyExists code + Right code -> do + mCode <- verifyCode gen.genKey scope arbitraryVal + pure $ retries > 0 && arbitraryVal /= code.codeValue ==> mCode === Nothing + in assertRightProp eitherProp + + prop "should allow retries" $ + \gen scope retries (abs -> timeout) mId throttle arbitraryVal -> + let eitherProp = + runDependencies throttle + . interpretVerificationCodeSubsystem + $ do + c <- createCode gen scope retries timeout mId + case c of + Left (CodeAlreadyExists code) -> pure $ unexpectedCodeAlreadyExists code + Right code -> do + codesWithArbitraryVal <- + catMaybes + <$> replicateM + (fromIntegral retries - 1) + (verifyCode gen.genKey scope arbitraryVal) + mCodeWithCorrectVal <- verifyCode gen.genKey scope code.codeValue + pure $ + retries > 1 && arbitraryVal /= code.codeValue ==> + codesWithArbitraryVal === [] + .&&. mCodeWithCorrectVal === Just (code {codeRetries = 1}) + in assertRightProp eitherProp + + prop "should only allow given number of retries" $ + \gen scope retries (abs -> timeout) mId throttle arbitraryVal -> + let eitherProp = + runDependencies throttle + . interpretVerificationCodeSubsystem + $ do + c <- createCode gen scope retries timeout mId + case c of + Left (CodeAlreadyExists code) -> pure $ unexpectedCodeAlreadyExists code + Right code -> do + codesWithArbitraryVal <- + catMaybes + <$> replicateM + (fromIntegral retries) + (verifyCode gen.genKey scope arbitraryVal) + mCodeWithCorrectVal <- verifyCode gen.genKey scope code.codeValue + pure $ + retries > 0 && arbitraryVal /= code.codeValue ==> + codesWithArbitraryVal === [] + .&&. mCodeWithCorrectVal === Nothing + in assertRightProp eitherProp + + describe "createCode" $ do + prop "should only allow one code at a time per (key, scope)" $ do + \gen scope retries (abs -> timeout) mId throttle -> + let eitherProp = + runDependencies throttle + . interpretVerificationCodeSubsystem + $ do + c1 <- createCode gen scope retries timeout mId + case c1 of + Left (CodeAlreadyExists code) -> pure $ unexpectedCodeAlreadyExists code + Right code -> do + c2 <- createCode gen scope retries timeout mId + pure $ c2 === Left (CodeAlreadyExists code) + in assertRightProp eitherProp + + describe "createCode/deleteCode/verifyCode" $ do + prop "should not allow verification using a deleted code" $ do + \gen scope retries (abs -> timeout) mId throttle -> + let eitherProp = + runDependencies throttle + . interpretVerificationCodeSubsystem + $ do + c <- createCode gen scope retries timeout mId + case c of + Left (CodeAlreadyExists code) -> pure $ unexpectedCodeAlreadyExists code + Right code -> do + Subsystem.deleteCode gen.genKey scope + mCode <- verifyCode gen.genKey scope code.codeValue + pure $ mCode === Nothing + in assertRightProp eitherProp + + describe "createCodeOverwritePrevious/verifyCode" $ do + prop "should allow creating code for the same scope and key, making previous code invalid" $ do + \gen scope retries (abs -> timeout) mId throttle -> + let eitherProp = + runDependencies throttle + . interpretVerificationCodeSubsystem + $ do + code1 <- createCodeOverwritePrevious gen scope retries timeout mId + passTime (fromIntegral throttle + 1) + code2 <- createCodeOverwritePrevious gen scope retries timeout mId + mCode1 <- verifyCode gen.genKey scope code1.codeValue + mCode2 <- verifyCode gen.genKey scope code2.codeValue + pure $ retries > 1 ==> mCode1 === Nothing .&&. mCode2 === Just (code2 {codeRetries = retries - 1}) + in assertRightProp eitherProp + + prop "should throttle creating codes " $ do + \gen scope retries (abs -> timeout) mId ((+ 1) -> throttle) -> + let eitherProp = + runDependencies throttle + . interpretVerificationCodeSubsystem + $ do + code <- createCodeOverwritePrevious gen scope retries timeout mId + mErrThrottled1 <- catchExpectedError $ createCodeOverwritePrevious gen scope retries timeout mId + mCode1 <- verifyCode gen.genKey scope code.codeValue + Subsystem.deleteCode gen.genKey scope + mErrThrottled2 <- catchExpectedError $ createCodeOverwritePrevious gen scope retries timeout mId + let expectedErr = Just $ VerificationCodeThrottled $ fromIntegral throttle + pure $ + mErrThrottled1 === expectedErr + .&&. mErrThrottled2 === expectedErr + .&&. (retries > 1 ==> mCode1 === Just code) + in assertRightProp eitherProp + + describe "internalLookupCode" $ do + prop "should allow looking up code by scope and key" $ do + \gen scope retries (abs -> timeout) mId throttle -> + let eitherProp = + runDependencies throttle + . interpretVerificationCodeSubsystem + $ do + code1 <- createCodeOverwritePrevious gen scope retries timeout mId + lookedUpCode <- internalLookupCode gen.genKey scope + pure $ lookedUpCode === Just code1 + in assertRightProp eitherProp + +runDependencies :: VerificationCodeThrottleTTL -> Sem '[Input VerificationCodeThrottleTTL, VerificationCodeStore, Now, State UTCTime, Random, Error e] a -> Either e a +runDependencies throttle = + run + . runError + . runRandomPure + . evalState defaultTime + . interpretNowAsState + . runInMemoryVerificationCodeStore + . runInputConst throttle + +assertRightProp :: (Show e) => Either e Property -> Property +assertRightProp = either (\e -> counterexample ("unexpected error: " <> show e) False) id + +unexpectedCodeAlreadyExists :: Code -> Property +unexpectedCodeAlreadyExists code = counterexample ("code shouldn't already exist, but exists: " <> show code) False diff --git a/libs/wire-subsystems/wire-subsystems.cabal b/libs/wire-subsystems/wire-subsystems.cabal index f5208751e20..a920191c681 100644 --- a/libs/wire-subsystems/wire-subsystems.cabal +++ b/libs/wire-subsystems/wire-subsystems.cabal @@ -81,6 +81,7 @@ library Wire.EmailSmsSubsystem Wire.EmailSmsSubsystem.Interpreter Wire.EmailSmsSubsystem.Template + Wire.Error Wire.FederationAPIAccess Wire.FederationAPIAccess.Interpreter Wire.GalleyAPIAccess @@ -109,6 +110,12 @@ library Wire.UserSubsystem.Error Wire.UserSubsystem.HandleBlacklist Wire.UserSubsystem.Interpreter + Wire.VerificationCode + Wire.VerificationCodeGen + Wire.VerificationCodeStore + Wire.VerificationCodeStore.Cassandra + Wire.VerificationCodeSubsystem + Wire.VerificationCodeSubsystem.Interpreter hs-source-dirs: src build-depends: @@ -125,6 +132,7 @@ library , cassandra-util , containers , cql + , crypton , currency-codes , data-default , data-timeout @@ -144,6 +152,7 @@ library , imports , iso639 , lens + , memory , mime , mime-mail , network @@ -198,14 +207,17 @@ test-suite wire-subsystems-tests Wire.MockInterpreters.Now Wire.MockInterpreters.PasswordResetCodeStore Wire.MockInterpreters.PasswordStore + Wire.MockInterpreters.Random Wire.MockInterpreters.SessionStore Wire.MockInterpreters.UserEvents Wire.MockInterpreters.UserKeyStore Wire.MockInterpreters.UserStore Wire.MockInterpreters.UserSubsystem + Wire.MockInterpreters.VerificationCodeStore Wire.NotificationSubsystem.InterpreterSpec Wire.UserStoreSpec Wire.UserSubsystem.InterpreterSpec + Wire.VerificationCodeSubsystem.InterpreterSpec build-tool-depends: hspec-discover:hspec-discover build-depends: @@ -234,6 +246,7 @@ test-suite wire-subsystems-tests , postie , QuickCheck , quickcheck-instances + , random , servant-client-core , streaming-commons , string-conversions diff --git a/services/brig/brig.cabal b/services/brig/brig.cabal index 661edec16d1..49d45527d52 100644 --- a/services/brig/brig.cabal +++ b/services/brig/brig.cabal @@ -105,7 +105,6 @@ library Brig.Calling.API Brig.Calling.Internal Brig.CanonicalInterpreter - Brig.Code Brig.Data.Activation Brig.Data.Client Brig.Data.Connection diff --git a/services/brig/src/Brig/API/Auth.hs b/services/brig/src/Brig/API/Auth.hs index 0a50fa7b698..018bf2be96b 100644 --- a/services/brig/src/Brig/API/Auth.hs +++ b/services/brig/src/Brig/API/Auth.hs @@ -61,6 +61,7 @@ import Wire.Sem.Paging.Cassandra (InternalPaging) import Wire.UserKeyStore import Wire.UserStore import Wire.UserSubsystem +import Wire.VerificationCodeSubsystem (VerificationCodeSubsystem) accessH :: ( Member TinyLog r, @@ -112,7 +113,8 @@ login :: Member (ConnectionStore InternalPaging) r, Member PasswordStore r, Member UserKeyStore r, - Member UserStore r + Member UserStore r, + Member VerificationCodeSubsystem r ) => Login -> Maybe Bool -> @@ -206,7 +208,7 @@ ssoLogin l (fromMaybe False -> persist) = do getLoginCode :: Phone -> Handler r PendingLoginCode getLoginCode _ = throwStd loginCodeNotFound -reauthenticate :: (Member GalleyAPIAccess r) => UserId -> ReAuthUser -> Handler r () +reauthenticate :: (Member GalleyAPIAccess r, Member VerificationCodeSubsystem r) => UserId -> ReAuthUser -> Handler r () reauthenticate uid body = do wrapClientE (User.reauthenticate uid (reAuthPassword body)) !>> reauthError case reAuthCodeAction body of diff --git a/services/brig/src/Brig/API/Client.hs b/services/brig/src/Brig/API/Client.hs index 8ce2c06251e..114a5f2c4ab 100644 --- a/services/brig/src/Brig/API/Client.hs +++ b/services/brig/src/Brig/API/Client.hs @@ -116,6 +116,7 @@ import Wire.Sem.Concurrency import Wire.Sem.FromUTC (FromUTC (fromUTCTime)) import Wire.Sem.Now as Now import Wire.Sem.Paging.Cassandra (InternalPaging) +import Wire.VerificationCodeSubsystem (VerificationCodeSubsystem) lookupLocalClient :: UserId -> ClientId -> (AppT r) (Maybe Client) lookupLocalClient uid = wrapClient . Data.lookupClient uid @@ -169,7 +170,8 @@ addClient :: Member (Input (Local ())) r, Member (Input UTCTime) r, Member (ConnectionStore InternalPaging) r, - Member EmailSmsSubsystem r + Member EmailSmsSubsystem r, + Member VerificationCodeSubsystem r ) => UserId -> Maybe ConnId -> @@ -189,7 +191,8 @@ addClientWithReAuthPolicy :: Member (Input UTCTime) r, Member DeleteQueue r, Member (ConnectionStore InternalPaging) r, - Member EmailSmsSubsystem r + Member EmailSmsSubsystem r, + Member VerificationCodeSubsystem r ) => Data.ReAuthPolicy -> UserId -> diff --git a/services/brig/src/Brig/API/Error.hs b/services/brig/src/Brig/API/Error.hs index c06300659e7..9c120e6d5b5 100644 --- a/services/brig/src/Brig/API/Error.hs +++ b/services/brig/src/Brig/API/Error.hs @@ -20,7 +20,6 @@ module Brig.API.Error where import Brig.API.Types import Control.Monad.Error.Class import Data.Aeson -import Data.Aeson.KeyMap qualified as KeyMap import Data.ByteString.Conversion import Data.Domain (Domain) import Data.Jwt.Tools (DPoPTokenGenerationError (..)) @@ -34,34 +33,17 @@ import Wire.API.Error import Wire.API.Error.Brig qualified as E import Wire.API.Federation.Error import Wire.API.User +import Wire.Error -data Error where - StdError :: !Wai.Error -> Error - RichError :: (ToJSON a) => !Wai.Error -> !a -> [Header] -> Error - -errorLabel :: Error -> LText -errorLabel (StdError e) = Wai.label e -errorLabel (RichError e _ _) = Wai.label e - -errorStatus :: Error -> Status -errorStatus (StdError e) = Wai.code e -errorStatus (RichError e _ _) = Wai.code e - -throwStd :: (MonadError Error m) => Wai.Error -> m a +throwStd :: (MonadError HttpError m) => Wai.Error -> m a throwStd = throwError . StdError -throwRich :: (MonadError Error m, ToJSON x) => Wai.Error -> x -> [Header] -> m a +throwRich :: (MonadError HttpError m, ToJSON x) => Wai.Error -> x -> [Header] -> m a throwRich e x h = throwError (RichError e x h) -instance ToJSON Error where - toJSON (StdError e) = toJSON e - toJSON (RichError e x _) = case (toJSON e, toJSON x) of - (Object o1, Object o2) -> Object (KeyMap.union o1 o2) - (j, _) -> j - -- Error Mapping ---------------------------------------------------------- -connError :: ConnectionError -> Error +connError :: ConnectionError -> HttpError connError TooManyConnections {} = StdError (errorToWai @'E.ConnectionLimitReached) connError InvalidTransition {} = StdError (errorToWai @'E.InvalidTransition) connError NotConnected {} = StdError (errorToWai @'E.NotConnected) @@ -76,14 +58,14 @@ connError ConnectMissingLegalholdConsent = StdError (errorToWai @'E.MissingLegal connError (ConnectFederationError e) = fedError e connError ConnectTeamFederationError = StdError (errorToWai @'E.TeamsNotFederating) -actError :: ActivationError -> Error +actError :: ActivationError -> HttpError actError (UserKeyExists _) = StdError (errorToWai @'E.UserKeyExists) actError InvalidActivationCodeWrongUser = StdError (errorToWai @'E.InvalidActivationCodeWrongUser) actError InvalidActivationCodeWrongCode = StdError (errorToWai @'E.InvalidActivationCodeWrongCode) actError (InvalidActivationEmail _ _) = StdError (errorToWai @'E.InvalidEmail) actError (InvalidActivationPhone _) = StdError (errorToWai @'E.InvalidPhone) -pwResetError :: PasswordResetError -> Error +pwResetError :: PasswordResetError -> HttpError pwResetError InvalidPasswordResetKey = StdError (errorToWai @'E.InvalidPasswordResetKey) pwResetError InvalidPasswordResetCode = StdError (errorToWai @'E.InvalidPasswordResetCode) pwResetError (PasswordResetInProgress Nothing) = StdError (errorToWai @'E.PasswordResetInProgress) @@ -94,30 +76,30 @@ pwResetError (PasswordResetInProgress (Just t)) = [("Retry-After", toByteString' t)] pwResetError ResetPasswordMustDiffer = StdError (errorToWai @'E.ResetPasswordMustDiffer) -sendActCodeError :: SendActivationCodeError -> Error +sendActCodeError :: SendActivationCodeError -> HttpError sendActCodeError (InvalidRecipient _) = StdError $ errorToWai @'E.InvalidEmail sendActCodeError (UserKeyInUse _) = StdError (errorToWai @'E.UserKeyExists) sendActCodeError (ActivationBlacklistedUserKey _) = StdError blacklistedEmail -changeEmailError :: ChangeEmailError -> Error +changeEmailError :: ChangeEmailError -> HttpError changeEmailError (InvalidNewEmail _ _) = StdError (errorToWai @'E.InvalidEmail) changeEmailError (EmailExists _) = StdError (errorToWai @'E.UserKeyExists) changeEmailError (ChangeBlacklistedEmail _) = StdError blacklistedEmail changeEmailError EmailManagedByScim = StdError $ propertyManagedByScim "email" -changeHandleError :: ChangeHandleError -> Error +changeHandleError :: ChangeHandleError -> HttpError changeHandleError ChangeHandleNoIdentity = StdError (errorToWai @'E.NoIdentity) changeHandleError ChangeHandleExists = StdError (errorToWai @'E.HandleExists) changeHandleError ChangeHandleInvalid = StdError (errorToWai @'E.InvalidHandle) changeHandleError ChangeHandleManagedByScim = StdError (errorToWai @'E.HandleManagedByScim) -legalHoldLoginError :: LegalHoldLoginError -> Error +legalHoldLoginError :: LegalHoldLoginError -> HttpError legalHoldLoginError LegalHoldLoginNoBindingTeam = StdError noBindingTeam legalHoldLoginError LegalHoldLoginLegalHoldNotEnabled = StdError legalHoldNotEnabled legalHoldLoginError (LegalHoldLoginError e) = loginError e legalHoldLoginError (LegalHoldReAuthError e) = reauthError e -loginError :: LoginError -> Error +loginError :: LoginError -> HttpError loginError LoginFailed = StdError (errorToWai @'E.BadCredentials) loginError LoginSuspended = StdError (errorToWai @'E.AccountSuspended) loginError LoginEphemeral = StdError (errorToWai @'E.AccountEphemeral) @@ -136,27 +118,27 @@ loginError (LoginBlocked wait) = loginError LoginCodeRequired = StdError (errorToWai @'E.CodeAuthenticationRequired) loginError LoginCodeInvalid = StdError (errorToWai @'E.CodeAuthenticationFailed) -authError :: AuthError -> Error +authError :: AuthError -> HttpError authError AuthInvalidUser = StdError (errorToWai @'E.BadCredentials) authError AuthInvalidCredentials = StdError (errorToWai @'E.BadCredentials) authError AuthSuspended = StdError (errorToWai @'E.AccountSuspended) authError AuthEphemeral = StdError (errorToWai @'E.AccountEphemeral) authError AuthPendingInvitation = StdError (errorToWai @'E.AccountPending) -reauthError :: ReAuthError -> Error +reauthError :: ReAuthError -> HttpError reauthError ReAuthMissingPassword = StdError (errorToWai @'E.MissingAuth) reauthError (ReAuthError e) = authError e reauthError ReAuthCodeVerificationRequired = StdError verificationCodeRequired reauthError ReAuthCodeVerificationNoPendingCode = StdError verificationCodeNoPendingCode reauthError ReAuthCodeVerificationNoEmail = StdError verificationCodeNoEmail -zauthError :: ZAuth.Failure -> Error +zauthError :: ZAuth.Failure -> HttpError zauthError ZAuth.Expired = StdError authTokenExpired zauthError ZAuth.Falsified = StdError authTokenInvalid zauthError ZAuth.Invalid = StdError authTokenInvalid zauthError ZAuth.Unsupported = StdError authTokenUnsupported -clientError :: ClientError -> Error +clientError :: ClientError -> HttpError clientError ClientNotFound = StdError (errorToWai @'E.ClientNotFound) clientError (ClientDataError e) = clientDataError e clientError (ClientUserNotFound _) = StdError (errorToWai @'E.InvalidUser) @@ -172,7 +154,7 @@ clientError ClientCodeAuthenticationRequired = StdError verificationCodeRequired -- Note that UnknownError, FfiError, and ImplementationError semantically should rather be 500s than 400s. -- However, the errors returned from the FFI are not always correct, -- and we don't want to bombard our environments with 500 log messages, so we treat them as 400s, for now. -certEnrollmentError :: CertEnrollmentError -> Error +certEnrollmentError :: CertEnrollmentError -> HttpError certEnrollmentError (RustError NoError) = StdError $ Wai.mkError status400 "internal-error" "The server experienced an internal error during DPoP token generation. Unexpected NoError." certEnrollmentError (RustError UnknownError) = StdError $ Wai.mkError status400 "internal-error" "The server experienced an internal error during DPoP token generation. Unknown error." certEnrollmentError (RustError FfiError) = StdError $ Wai.mkError status400 "internal-error" "The server experienced an internal error during DPoP token generation" @@ -225,13 +207,13 @@ certEnrollmentError NotATeamUser = StdError $ Wai.mkError status400 "not-a-team- certEnrollmentError MissingHandle = StdError $ Wai.mkError status400 "missing-handle" "The user has no handle" certEnrollmentError MissingName = StdError $ Wai.mkError status400 "missing-name" "The user has no name" -fedError :: FederationError -> Error +fedError :: FederationError -> HttpError fedError = StdError . federationErrorToWai -propDataError :: PropertiesDataError -> Error +propDataError :: PropertiesDataError -> HttpError propDataError TooManyProperties = StdError tooManyProperties -clientDataError :: ClientDataError -> Error +clientDataError :: ClientDataError -> HttpError clientDataError TooManyClients = StdError (errorToWai @'E.TooManyClients) clientDataError (ClientReAuthError e) = reauthError e clientDataError ClientMissingAuth = StdError (errorToWai @'E.MissingAuth) @@ -241,7 +223,7 @@ clientDataError KeyPackageDecodingError = StdError (errorToWai @'E.KeyPackageDec clientDataError InvalidKeyPackageRef = StdError (errorToWai @'E.InvalidKeyPackageRef) clientDataError MLSNotEnabled = StdError (errorToWai @'E.MLSNotEnabled) -deleteUserError :: DeleteUserError -> Error +deleteUserError :: DeleteUserError -> HttpError deleteUserError DeleteUserInvalid = StdError (errorToWai @'E.InvalidUser) deleteUserError DeleteUserInvalidCode = StdError (errorToWai @'E.InvalidCode) deleteUserError DeleteUserInvalidPassword = StdError (errorToWai @'E.BadCredentials) @@ -249,23 +231,20 @@ deleteUserError DeleteUserMissingPassword = StdError (errorToWai @'E.MissingAuth deleteUserError (DeleteUserPendingCode t) = RichError deletionCodePending (DeletionCodeTimeout t) [] deleteUserError DeleteUserOwnerDeletingSelf = StdError (errorToWai @'E.OwnerDeletingSelf) deleteUserError (DeleteUserVerificationCodeThrottled t) = - RichError - verificationCodeThrottled - () - [("Retry-After", toByteString' (retryAfterSeconds t))] + verificationCodeThrottledError (VerificationCodeThrottled t) -accountStatusError :: AccountStatusError -> Error +accountStatusError :: AccountStatusError -> HttpError accountStatusError InvalidAccountStatus = StdError invalidAccountStatus accountStatusError AccountNotFound = StdError (notFound "Account not found") -updateProfileError :: UpdateProfileError -> Error +updateProfileError :: UpdateProfileError -> HttpError updateProfileError DisplayNameManagedByScim = StdError (propertyManagedByScim "name") updateProfileError ProfileNotFound = StdError (errorToWai @'E.UserNotFound) -verificationCodeThrottledError :: VerificationCodeThrottledError -> Error +verificationCodeThrottledError :: VerificationCodeThrottledError -> HttpError verificationCodeThrottledError (VerificationCodeThrottled t) = RichError - verificationCodeThrottled + (dynErrorToWai $ dynError @(MapError 'E.VerificationCodeThrottled)) () [("Retry-After", toByteString' (retryAfterSeconds t))] @@ -401,9 +380,6 @@ loginsTooFrequent = Wai.mkError status429 "client-error" "Logins too frequent" tooManyFailedLogins :: Wai.Error tooManyFailedLogins = Wai.mkError status403 "client-error" "Too many failed logins" -verificationCodeThrottled :: Wai.Error -verificationCodeThrottled = Wai.mkError status429 "too-many-requests" "Too many request to generate a verification code." - tooLargeRichInfo :: Wai.Error tooLargeRichInfo = Wai.mkError status413 "too-large-rich-info" "Rich info has exceeded the limit" diff --git a/services/brig/src/Brig/API/Federation.hs b/services/brig/src/Brig/API/Federation.hs index 68c1f4f6cc7..58af99451bf 100644 --- a/services/brig/src/Brig/API/Federation.hs +++ b/services/brig/src/Brig/API/Federation.hs @@ -71,6 +71,7 @@ import Wire.API.User.Search hiding (searchPolicy) import Wire.API.UserEvent import Wire.API.UserMap (UserMap) import Wire.DeleteQueue +import Wire.Error import Wire.GalleyAPIAccess (GalleyAPIAccess) import Wire.NotificationSubsystem import Wire.Sem.Concurrency @@ -148,7 +149,7 @@ getUserByHandle :: ) => Domain -> Handle -> - ExceptT Error (AppT r) (Maybe UserProfile) + ExceptT HttpError (AppT r) (Maybe UserProfile) getUserByHandle domain handle = do searchPolicy <- lookupSearchPolicy domain @@ -172,7 +173,7 @@ getUsersByIds :: (Member UserSubsystem r) => Domain -> [UserId] -> - ExceptT Error (AppT r) [UserProfile] + ExceptT HttpError (AppT r) [UserProfile] getUsersByIds _ uids = do luids <- qualifyLocal uids lift $ liftSem $ getLocalUserProfiles luids @@ -212,7 +213,7 @@ searchUsers :: ) => Domain -> SearchRequest -> - ExceptT Error (AppT r) SearchResponse + ExceptT HttpError (AppT r) SearchResponse searchUsers domain (SearchRequest _ mTeam (Just [])) = do searchPolicy <- lookupSearchPolicyWithTeam domain mTeam pure $ SearchResponse [] searchPolicy @@ -229,18 +230,18 @@ searchUsers domain (SearchRequest searchTerm mTeam mOnlyInTeams) = do contacts <- go [] maxResults searches pure $ SearchResponse contacts searchPolicy where - go :: [Contact] -> Int -> [Int -> ExceptT Error (AppT r) [Contact]] -> ExceptT Error (AppT r) [Contact] + go :: [Contact] -> Int -> [Int -> ExceptT HttpError (AppT r) [Contact]] -> ExceptT HttpError (AppT r) [Contact] go contacts _ [] = pure contacts go contacts maxResult (search : searches) = do contactsNew <- search maxResult go (contacts <> contactsNew) (maxResult - length contactsNew) searches - fullSearch :: Int -> ExceptT Error (AppT r) [Contact] + fullSearch :: Int -> ExceptT HttpError (AppT r) [Contact] fullSearch n | n > 0 = lift $ searchResults <$> Q.searchIndex (Q.FederatedSearch mOnlyInTeams) searchTerm n | otherwise = pure [] - exactHandleSearch :: Int -> ExceptT Error (AppT r) [Contact] + exactHandleSearch :: Int -> ExceptT HttpError (AppT r) [Contact] exactHandleSearch n | n > 0 = do let maybeHandle = Handle.parseHandle searchTerm diff --git a/services/brig/src/Brig/API/Handler.hs b/services/brig/src/Brig/API/Handler.hs index 8f53a1fd738..2971f28e4e9 100644 --- a/services/brig/src/Brig/API/Handler.hs +++ b/services/brig/src/Brig/API/Handler.hs @@ -59,11 +59,12 @@ import Wire.API.Allowlists qualified as Allowlists import Wire.API.Error import Wire.API.Error.Brig import Wire.API.User (Email) +import Wire.Error ------------------------------------------------------------------------------- -- HTTP Handler Monad -type Handler r = ExceptT Error (AppT r) +type Handler r = ExceptT HttpError (AppT r) toServantHandler :: Env -> (Handler BrigCanonicalEffects) a -> Servant.Handler a toServantHandler env action = do @@ -71,7 +72,7 @@ toServantHandler env action = do reqId = unRequestId $ view requestId env a <- liftIO $ - runBrigToIO env (runExceptT action) + (runBrigToIO env (runExceptT action)) `catches` brigErrorHandlers logger reqId case a of Left werr -> handleWaiErrors logger reqId werr @@ -84,7 +85,9 @@ toServantHandler env action = do \case -- throw in IO so that the `catchErrors` middleware can turn this error -- into a response and log accordingly - StdError werr -> liftIO $ throwIO werr + StdError werr -> do + Server.logError' logger (Just reqId) werr + liftIO $ throwIO werr RichError werr body headers -> do when (statusCode (WaiError.code werr) < 500) $ -- 5xx are logged by the middleware, so we only log errors < 500 to avoid duplicated entries @@ -97,7 +100,7 @@ newtype UserNotAllowedToJoinTeam = UserNotAllowedToJoinTeam WaiError.Error instance Exception UserNotAllowedToJoinTeam -brigErrorHandlers :: Logger -> ByteString -> [Catch.Handler IO (Either Error a)] +brigErrorHandlers :: Logger -> ByteString -> [Catch.Handler IO (Either HttpError a)] brigErrorHandlers logger reqId = [ Catch.Handler $ \(ex :: ZV.Failure) -> pure (Left (zauthError ex)), @@ -106,6 +109,7 @@ brigErrorHandlers logger reqId = AWS.SESInvalidDomain -> pure (Left (StdError (errorToWai @'InvalidEmail))) _ -> throwM ex, + Catch.Handler $ \(e :: HttpError) -> pure $ Left e, Catch.Handler $ \(UserNotAllowedToJoinTeam e) -> pure (Left $ StdError e), Catch.Handler $ \(e :: SomeException) -> do Log.err logger $ @@ -121,7 +125,7 @@ brigErrorHandlers logger reqId = -- This could go to libs/wai-utilities. There is a `parseJson'` in -- "Network.Wai.Utilities.Request", but adding `parseJsonBody` there would require to move -- more code out of brig. -parseJsonBody :: (FromJSON a, MonadIO m) => JsonRequest a -> ExceptT Error m a +parseJsonBody :: (FromJSON a, MonadIO m) => JsonRequest a -> ExceptT HttpError m a parseJsonBody req = parseBody req !>> StdError . badRequest -- | If an Allowlist is configured, consult it, otherwise a no-op. {#RefActivationAllowlist} diff --git a/services/brig/src/Brig/API/Internal.hs b/services/brig/src/Brig/API/Internal.hs index 5608df7d27c..1fb6a157040 100644 --- a/services/brig/src/Brig/API/Internal.hs +++ b/services/brig/src/Brig/API/Internal.hs @@ -32,7 +32,6 @@ import Brig.API.OAuth (internalOauthAPI) import Brig.API.Types import Brig.API.User qualified as API import Brig.App -import Brig.Code qualified as Code import Brig.Data.Activation import Brig.Data.Client qualified as Data import Brig.Data.Connection qualified as Data @@ -63,6 +62,7 @@ import Brig.User.Search.Index qualified as Index import Control.Error hiding (bool) import Control.Lens (view) import Data.ByteString.Conversion (toByteString) +import Data.Code qualified as Code import Data.CommaSeparatedList import Data.Default import Data.Domain (Domain) @@ -112,6 +112,9 @@ import Wire.UserKeyStore import Wire.UserStore import Wire.UserSubsystem import Wire.UserSubsystem qualified as UserSubsystem +import Wire.VerificationCode +import Wire.VerificationCodeGen +import Wire.VerificationCodeSubsystem servantSitemap :: forall r p. @@ -133,7 +136,8 @@ servantSitemap :: Member TinyLog r, Member (UserPendingActivationStore p) r, Member EmailSending r, - Member EmailSmsSubsystem r + Member EmailSmsSubsystem r, + Member VerificationCodeSubsystem r ) => ServerT BrigIRoutes.API (Handler r) servantSitemap = @@ -182,7 +186,8 @@ accountAPI :: Member (Input (Local ())) r, Member (Input UTCTime) r, Member (ConnectionStore InternalPaging) r, - Member EmailSmsSubsystem r + Member EmailSmsSubsystem r, + Member VerificationCodeSubsystem r ) => ServerT BrigIRoutes.AccountAPI (Handler r) accountAPI = @@ -261,7 +266,8 @@ authAPI :: Member NotificationSubsystem r, Member (Input (Local ())) r, Member (Input UTCTime) r, - Member (ConnectionStore InternalPaging) r + Member (ConnectionStore InternalPaging) r, + Member VerificationCodeSubsystem r ) => ServerT BrigIRoutes.AuthAPI (Handler r) authAPI = @@ -370,16 +376,13 @@ getMLSClients usr suite = do (cid,) . (> 0) <$> Data.countKeyPackages lusr cid suiteTag -getVerificationCode :: UserId -> VerificationAction -> Handler r (Maybe Code.Value) -getVerificationCode uid action = do - user <- wrapClientE $ API.lookupUser NoPendingInvitations uid - maybe (pure Nothing) (lookupCode action) (userEmail =<< user) - where - lookupCode :: VerificationAction -> Email -> (Handler r) (Maybe Code.Value) - lookupCode a e = do - key <- Code.mkKey e - code <- wrapClientE $ Code.lookup key (Code.scopeFromAction a) - pure $ Code.codeValue <$> code +getVerificationCode :: forall r. (Member VerificationCodeSubsystem r) => UserId -> VerificationAction -> Handler r (Maybe Code.Value) +getVerificationCode uid action = runMaybeT do + user <- MaybeT . wrapClientE $ API.lookupUser NoPendingInvitations uid + email <- MaybeT . pure $ userEmail user + let key = mkKey email + code <- MaybeT . lift . liftSem $ internalLookupCode key (scopeFromAction action) + pure code.codeValue internalSearchIndexAPI :: forall r. ServerT BrigIRoutes.ISearchIndexAPI (Handler r) internalSearchIndexAPI = @@ -400,7 +403,8 @@ addClientInternalH :: Member (Input (Local ())) r, Member (Input UTCTime) r, Member (ConnectionStore InternalPaging) r, - Member EmailSmsSubsystem r + Member EmailSmsSubsystem r, + Member VerificationCodeSubsystem r ) => UserId -> Maybe Bool -> diff --git a/services/brig/src/Brig/API/Public.hs b/services/brig/src/Brig/API/Public.hs index ed2d88f293d..c10860e9189 100644 --- a/services/brig/src/Brig/API/Public.hs +++ b/services/brig/src/Brig/API/Public.hs @@ -39,7 +39,6 @@ import Brig.API.User qualified as API import Brig.API.Util import Brig.App import Brig.Calling.API qualified as Calling -import Brig.Code qualified as Code import Brig.Data.Connection qualified as Data import Brig.Data.Nonce as Nonce import Brig.Data.User qualified as Data @@ -73,6 +72,7 @@ import Data.ByteString (fromStrict, toStrict) import Data.ByteString.Lazy qualified as Lazy import Data.ByteString.Lazy.Char8 qualified as LBS import Data.ByteString.UTF8 qualified as UTF8 +import Data.Code qualified as Code import Data.CommaSeparatedList import Data.Default import Data.Domain @@ -155,6 +155,7 @@ import Wire.AuthenticationSubsystem (AuthenticationSubsystem, createPasswordRese import Wire.DeleteQueue import Wire.EmailSending (EmailSending) import Wire.EmailSmsSubsystem +import Wire.Error import Wire.GalleyAPIAccess (GalleyAPIAccess) import Wire.GalleyAPIAccess qualified as GalleyAPIAccess import Wire.NotificationSubsystem @@ -167,6 +168,9 @@ import Wire.UserKeyStore import Wire.UserStore (UserStore) import Wire.UserSubsystem hiding (checkHandle, checkHandles) import Wire.UserSubsystem qualified as UserSubsystem +import Wire.VerificationCode +import Wire.VerificationCodeGen +import Wire.VerificationCodeSubsystem -- User API ----------------------------------------------------------- @@ -302,7 +306,8 @@ servantSitemap :: Member TinyLog r, Member (UserPendingActivationStore p) r, Member EmailSmsSubsystem r, - Member EmailSending r + Member EmailSending r, + Member VerificationCodeSubsystem r ) => ServerT BrigAPI (Handler r) servantSitemap = @@ -570,7 +575,7 @@ getMultiUserPrekeyBundleUnqualifiedH zusr userClients = do API.claimLocalMultiPrekeyBundles (ProtectedUser zusr) userClients !>> clientError getMultiUserPrekeyBundleHInternal :: - (MonadReader Env m, MonadError Brig.API.Error.Error m) => + (MonadReader Env m, MonadError HttpError m) => Public.QualifiedUserClients -> m () getMultiUserPrekeyBundleHInternal qualUserClients = do @@ -613,7 +618,8 @@ addClient :: Member (Input (Local ())) r, Member (Input UTCTime) r, Member (ConnectionStore InternalPaging) r, - Member EmailSmsSubsystem r + Member EmailSmsSubsystem r, + Member VerificationCodeSubsystem r ) => UserId -> ConnId -> @@ -1230,7 +1236,8 @@ deleteSelfUser :: Member (Input (Local ())) r, Member (Input UTCTime) r, Member (ConnectionStore InternalPaging) r, - Member EmailSmsSubsystem r + Member EmailSmsSubsystem r, + Member VerificationCodeSubsystem r ) => UserId -> Public.DeleteUser -> @@ -1246,7 +1253,8 @@ verifyDeleteUser :: Member (Input (Local ())) r, Member UserKeyStore r, Member (Input UTCTime) r, - Member (ConnectionStore InternalPaging) r + Member (ConnectionStore InternalPaging) r, + Member VerificationCodeSubsystem r ) => Public.VerifyDeleteUser -> Handler r () @@ -1330,7 +1338,8 @@ sendVerificationCode :: forall r. ( Member GalleyAPIAccess r, Member UserKeyStore r, - Member EmailSmsSubsystem r + Member EmailSmsSubsystem r, + Member VerificationCodeSubsystem r ) => Public.SendVerificationCode -> (Handler r) () @@ -1341,17 +1350,17 @@ sendVerificationCode req = do featureEnabled <- getFeatureStatus mbAccount case (mbAccount, featureEnabled) of (Just account, True) -> do - gen <- Code.mk6DigitGen email + let gen = mk6DigitVerificationCodeGen email timeout <- setVerificationTimeout <$> view settings code <- - Code.generate - gen - (Code.scopeFromAction action) - (Code.Retries 3) - timeout - (Just $ toUUID $ Public.userId $ accountUser account) - tryInsertVerificationCode code $ verificationCodeThrottledError . VerificationCodeThrottled - sendMail email (Code.codeValue code) (Just $ Public.userLocale $ accountUser account) action + lift . liftSem $ + createCodeOverwritePrevious + gen + (scopeFromAction action) + (Retries 3) + timeout + (Just $ toUUID $ Public.userId $ accountUser account) + sendMail email code.codeValue (Just $ Public.userLocale $ accountUser account) action _ -> pure () where getAccount :: Public.Email -> (Handler r) (Maybe UserAccount) diff --git a/services/brig/src/Brig/API/User.hs b/services/brig/src/Brig/API/User.hs index 7dcc669eb44..6f10a8e0790 100644 --- a/services/brig/src/Brig/API/User.hs +++ b/services/brig/src/Brig/API/User.hs @@ -79,7 +79,6 @@ import Brig.API.Handler qualified as API (UserNotAllowedToJoinTeam (..)) import Brig.API.Types import Brig.API.Util import Brig.App -import Brig.Code qualified as Code import Brig.Data.Activation (ActivationEvent (..), activationErrorToRegisterError) import Brig.Data.Activation qualified as Data import Brig.Data.Client qualified as Data @@ -149,6 +148,7 @@ import Wire.API.UserEvent import Wire.AuthenticationSubsystem (AuthenticationSubsystem, internalLookupPasswordResetCode) import Wire.DeleteQueue import Wire.EmailSmsSubsystem +import Wire.Error import Wire.GalleyAPIAccess as GalleyAPIAccess import Wire.NotificationSubsystem import Wire.PasswordStore (PasswordStore, lookupHashedPassword, upsertHashedPassword) @@ -158,6 +158,9 @@ import Wire.UserKeyStore import Wire.UserStore import Wire.UserSubsystem as User import Wire.UserSubsystem.HandleBlacklist +import Wire.VerificationCode qualified as VerificationCode +import Wire.VerificationCodeGen (mkVerificationCodeGen) +import Wire.VerificationCodeSubsystem ------------------------------------------------------------------------------- -- Create User @@ -171,10 +174,10 @@ identityErrorToRegisterError = \case IdentityErrorBlacklistedEmail -> RegisterErrorBlacklistedEmail IdentityErrorUserKeyExists -> RegisterErrorUserKeyExists -identityErrorToBrigError :: IdentityError -> Error.Error +identityErrorToBrigError :: IdentityError -> HttpError identityErrorToBrigError = \case - IdentityErrorBlacklistedEmail -> Error.StdError $ errorToWai @'E.BlacklistedEmail - IdentityErrorUserKeyExists -> Error.StdError $ errorToWai @'E.UserKeyExists + IdentityErrorBlacklistedEmail -> StdError $ errorToWai @'E.BlacklistedEmail + IdentityErrorUserKeyExists -> StdError $ errorToWai @'E.UserKeyExists verifyUniquenessAndCheckBlacklist :: ( Member BlacklistStore r, @@ -500,9 +503,9 @@ createUserInviteViaScim :: Member TinyLog r ) => NewUserScimInvitation -> - ExceptT Error.Error (AppT r) UserAccount + ExceptT HttpError (AppT r) UserAccount createUserInviteViaScim (NewUserScimInvitation tid uid loc name rawEmail _) = do - email <- either (const . throwE . Error.StdError $ errorToWai @'E.InvalidEmail) pure (validateEmail rawEmail) + email <- either (const . throwE . StdError $ errorToWai @'E.InvalidEmail) pure (validateEmail rawEmail) let emKey = mkEmailKey email verifyUniquenessAndCheckBlacklist emKey !>> identityErrorToBrigError account <- lift . wrapClient $ newAccountInviteViaScim uid tid loc name email @@ -559,7 +562,7 @@ changeManagedBy uid conn (ManagedByUpdate mb) = do -- | Call 'changeEmail' and process result: if email changes to itself, succeed, if not, send -- validation email. -changeSelfEmail :: (Member BlacklistStore r, Member UserKeyStore r, Member EmailSmsSubsystem r) => UserId -> Email -> UpdateOriginType -> ExceptT Error.Error (AppT r) ChangeEmailResponse +changeSelfEmail :: (Member BlacklistStore r, Member UserKeyStore r, Member EmailSmsSubsystem r) => UserId -> Email -> UpdateOriginType -> ExceptT HttpError (AppT r) ChangeEmailResponse changeSelfEmail u email allowScim = do changeEmail u email allowScim !>> Error.changeEmailError >>= \case ChangeEmailIdempotent -> @@ -923,7 +926,8 @@ deleteSelfUser :: Member UserStore r, Member (Input UTCTime) r, Member (ConnectionStore InternalPaging) r, - Member EmailSmsSubsystem r + Member EmailSmsSubsystem r, + Member VerificationCodeSubsystem r ) => UserId -> Maybe PlainTextPassword6 -> @@ -965,29 +969,20 @@ deleteSelfUser uid pwd = do throwE DeleteUserInvalidPassword lift . liftSem $ deleteAccount a >> pure Nothing sendCode a target = do - gen <- Code.mkGen target - pending <- lift . wrapClient $ Code.lookup (Code.genKey gen) Code.AccountDeletion - case pending of - Just c -> throwE $! DeleteUserPendingCode (Code.codeTTL c) - Nothing -> do + let gen = mkVerificationCodeGen target + (lift . liftSem $ createCode gen VerificationCode.AccountDeletion (VerificationCode.Retries 3) (VerificationCode.Timeout 600) (Just (toUUID uid))) >>= \case + Left (CodeAlreadyExists c) -> throwE $! DeleteUserPendingCode (VerificationCode.codeTTL c) + Right c -> do lift . liftSem . Log.info $ field "user" (toByteString uid) . msg (val "Sending verification code for account deletion") - c <- - Code.generate - gen - Code.AccountDeletion - (Code.Retries 3) - (Code.Timeout 600) - (Just (toUUID uid)) - tryInsertVerificationCode c DeleteUserVerificationCodeThrottled - let k = Code.codeKey c - let v = Code.codeValue c + let k = VerificationCode.codeKey c + let v = VerificationCode.codeValue c let l = userLocale (accountUser a) let n = userDisplayName (accountUser a) lift (liftSem $ sendAccountDeletionEmail target n k v l) - `onException` wrapClientE (Code.delete k Code.AccountDeletion) - pure $! Just $! Code.codeTTL c + `onException` lift (liftSem $ deleteCode k VerificationCode.AccountDeletion) + pure $! Just $! VerificationCode.codeTTL c -- | Conclude validation and scheduling of user's deletion request that was initiated in -- 'deleteUser'. Called via @post /delete@. @@ -1002,18 +997,19 @@ verifyDeleteUser :: Member (Input (Local ())) r, Member UserStore r, Member (Input UTCTime) r, - Member (ConnectionStore InternalPaging) r + Member (ConnectionStore InternalPaging) r, + Member VerificationCodeSubsystem r ) => VerifyDeleteUser -> ExceptT DeleteUserError (AppT r) () verifyDeleteUser d = do let key = verifyDeleteUserKey d let code = verifyDeleteUserCode d - c <- lift . wrapClient $ Code.verify key Code.AccountDeletion code - a <- maybe (throwE DeleteUserInvalidCode) pure (Code.codeAccount =<< c) + c <- lift . liftSem $ verifyCode key VerificationCode.AccountDeletion code + a <- maybe (throwE DeleteUserInvalidCode) pure (VerificationCode.codeAccount =<< c) account <- lift . wrapClient $ Data.lookupAccount (Id a) for_ account $ lift . liftSem . deleteAccount - lift . wrapClient $ Code.delete key Code.AccountDeletion + lift . liftSem $ deleteCode key VerificationCode.AccountDeletion -- | Check if `deleteAccount` succeeded and run it again if needed. -- Called via @delete /i/user/:uid@. diff --git a/services/brig/src/Brig/API/Util.hs b/services/brig/src/Brig/API/Util.hs index 65f8c25d4eb..6a1d1d532d7 100644 --- a/services/brig/src/Brig/API/Util.hs +++ b/services/brig/src/Brig/API/Util.hs @@ -28,7 +28,6 @@ module Brig.API.Util traverseConcurrentlyWithErrorsAppT, exceptTToMaybe, ensureLocal, - tryInsertVerificationCode, ) where @@ -36,10 +35,7 @@ import Brig.API.Error import Brig.API.Handler import Brig.API.Types import Brig.App -import Brig.Code qualified as Code import Brig.Data.User qualified as Data -import Brig.Options (set2FACodeGenerationDelaySecs) -import Control.Lens (view) import Control.Monad.Catch (throwM) import Control.Monad.Trans.Except import Data.Bifunctor @@ -155,9 +151,3 @@ traverseConcurrentlyWithErrorsAppT f t = do exceptTToMaybe :: (Monad m) => ExceptT e m () -> m (Maybe e) exceptTToMaybe = (pure . either Just (const Nothing)) <=< runExceptT - -tryInsertVerificationCode :: Code.Code -> (RetryAfter -> e) -> ExceptT e (AppT r) () -tryInsertVerificationCode code e = do - ttl <- set2FACodeGenerationDelaySecs <$> view settings - mRetryAfter <- wrapClientE $ Code.insert code ttl - mapM_ (throwE . e) mRetryAfter diff --git a/services/brig/src/Brig/Calling/API.hs b/services/brig/src/Brig/Calling/API.hs index f963925f821..e97c51e19c2 100644 --- a/services/brig/src/Brig/Calling/API.hs +++ b/services/brig/src/Brig/Calling/API.hs @@ -58,6 +58,7 @@ import System.Logger.Class qualified as Log import System.Random.MWC qualified as MWC import Wire.API.Call.Config qualified as Public import Wire.API.Team.Feature (AllFeatureConfigs (afcConferenceCalling), FeatureStatus (FeatureStatusDisabled, FeatureStatusEnabled), wsStatus) +import Wire.Error import Wire.GalleyAPIAccess (GalleyAPIAccess, getAllFeatureConfigsForUser) import Wire.Network.DNS.SRV (srvTarget) diff --git a/services/brig/src/Brig/CanonicalInterpreter.hs b/services/brig/src/Brig/CanonicalInterpreter.hs index 6f0d99f1c89..d9e69961f19 100644 --- a/services/brig/src/Brig/CanonicalInterpreter.hs +++ b/services/brig/src/Brig/CanonicalInterpreter.hs @@ -24,7 +24,6 @@ import Control.Monad.Catch (throwM) import Data.Qualified (Local, toLocalUnsafe) import Data.Time.Clock (UTCTime, getCurrentTime) import Imports -import Network.Wai.Utilities qualified as Wai import Polysemy import Polysemy.Async import Polysemy.Conc @@ -43,6 +42,7 @@ import Wire.EmailSending.SES import Wire.EmailSending.SMTP import Wire.EmailSmsSubsystem import Wire.EmailSmsSubsystem.Interpreter +import Wire.Error import Wire.FederationAPIAccess qualified import Wire.FederationAPIAccess.Interpreter (FederationAPIAccessConfig (..), interpretFederationAPIAccess) import Wire.GalleyAPIAccess (GalleyAPIAccess) @@ -65,6 +65,8 @@ import Wire.Sem.Logger.TinyLog (loggerToTinyLogReqId) import Wire.Sem.Now (Now) import Wire.Sem.Now.IO (nowToIOAction) import Wire.Sem.Paging.Cassandra (InternalPaging) +import Wire.Sem.Random +import Wire.Sem.Random.IO import Wire.SessionStore import Wire.SessionStore.Cassandra (interpretSessionStoreCassandra) import Wire.UserEvents @@ -73,26 +75,35 @@ import Wire.UserKeyStore.Cassandra import Wire.UserStore import Wire.UserStore.Cassandra import Wire.UserSubsystem +import Wire.UserSubsystem.Error import Wire.UserSubsystem.Interpreter +import Wire.VerificationCodeStore +import Wire.VerificationCodeStore.Cassandra +import Wire.VerificationCodeSubsystem +import Wire.VerificationCodeSubsystem.Interpreter type BrigCanonicalEffects = '[ AuthenticationSubsystem, UserSubsystem, EmailSmsSubsystem, + VerificationCodeSubsystem, DeleteQueue, UserEvents, Error UserSubsystemError, Error AuthenticationSubsystemError, Error Wire.API.Federation.Error.FederationError, - Error Wai.Error, + Error VerificationCodeSubsystemError, + Error HttpError, Wire.FederationAPIAccess.FederationAPIAccess Wire.API.Federation.Client.FederatorClient, HashPassword, UserKeyStore, UserStore, SessionStore, PasswordStore, + VerificationCodeStore, SFT, ConnectionStore InternalPaging, + Input VerificationCodeThrottleTTL, Input UTCTime, Input (Local ()), Input (Maybe AllowlistEmailDomains), @@ -106,6 +117,7 @@ type BrigCanonicalEffects = UserPendingActivationStore InternalPaging, Now, Delay, + Random, PasswordResetCodeStore, GalleyAPIAccess, EmailSending, @@ -153,6 +165,7 @@ runBrigToIO e (AppT ma) = do . emailSendingInterpreter e . interpretGalleyAPIAccessToRpc (e ^. disabledVersions) (e ^. galleyEndpoint) . passwordResetCodeStoreToCassandra @Cas.Client + . randomToIO . runDelay . nowToIOAction (e ^. currentTime) . userPendingActivationStoreToCassandra @@ -166,20 +179,24 @@ runBrigToIO e (AppT ma) = do . runInputConst (e ^. settings . Opt.allowlistEmailDomains) . runInputConst (toLocalUnsafe (e ^. settings . Opt.federationDomain) ()) . runInputSem (embed getCurrentTime) + . runInputConst (e ^. settings . to Opt.set2FACodeGenerationDelaySecs . to fromIntegral) . connectionStoreToCassandra . interpretSFT (e ^. httpManager) + . interpretVerificationCodeStoreCassandra (e ^. casClient) . interpretPasswordStore (e ^. casClient) . interpretSessionStoreCassandra (e ^. casClient) . interpretUserStoreCassandra (e ^. casClient) . interpretUserKeyStoreCassandra (e ^. casClient) . runHashPassword . interpretFederationAPIAccess federationApiAccessConfig - . rethrowWaiErrorIO - . mapError federationErrorToWai - . mapError authenticationSubsystemErrorToWai - . mapError userSubsystemErrorToWai + . rethrowHttpErrorIO + . mapError verificationCodeSubsystemErrorToHttpError + . mapError (StdError . federationErrorToWai) + . mapError authenticationSubsystemErrorToHttpError + . mapError userSubsystemErrorToHttpError . runUserEvents . runDeleteQueue (e ^. internalEvents) + . interpretVerificationCodeSubsystem . emailSmsSubsystemInterpreter (e ^. usrTemplates) (e ^. templateBranding) . runUserSubsystem userSubsystemConfig . interpretAuthenticationSubsystem @@ -187,8 +204,8 @@ runBrigToIO e (AppT ma) = do ) $ runReaderT ma e -rethrowWaiErrorIO :: (Member (Final IO) r) => InterpreterFor (Error Wai.Error) r -rethrowWaiErrorIO act = do +rethrowHttpErrorIO :: (Member (Final IO) r) => InterpreterFor (Error HttpError) r +rethrowHttpErrorIO act = do eithError <- errorToIOFinal act case eithError of Left err -> embedToFinal $ throwM $ err diff --git a/services/brig/src/Brig/Code.hs b/services/brig/src/Brig/Code.hs deleted file mode 100644 index c35695a9e2e..00000000000 --- a/services/brig/src/Brig/Code.hs +++ /dev/null @@ -1,339 +0,0 @@ -{-# LANGUAGE GeneralizedNewtypeDeriving #-} - --- This file is part of the Wire Server implementation. --- --- Copyright (C) 2022 Wire Swiss GmbH --- --- This program is free software: you can redistribute it and/or modify it under --- the terms of the GNU Affero General Public License as published by the Free --- Software Foundation, either version 3 of the License, or (at your option) any --- later version. --- --- This program is distributed in the hope that it will be useful, but WITHOUT --- ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS --- FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for more --- details. --- --- You should have received a copy of the GNU Affero General Public License along --- with this program. If not, see . - --- | Random, time-limited codes for e-mail addresses and phone numbers --- for use in a variety of 'Scope's. --- --- TODO: This module is supposed to (eventually) supersede the existing --- code verification functionality in the following modules: --- Brig.Data.Activation --- Brig.Data.PasswordReset --- Brig.Data.LoginCode -module Brig.Code - ( -- * Code - Code, - Key (..), - Scope (..), - Value (..), - KeyValuePair (..), - Timeout (..), - Retries (..), - codeFor, - codeKey, - codeValue, - codeToKeyValuePair, - codeTTL, - codeAccount, - scopeFromAction, - - -- * Generation - Gen (genKey), - mkGen, - generate, - mk6DigitGen, - mkKey, - - -- * Storage - insert, - lookup, - verify, - delete, - ) -where - -import Cassandra hiding (Value) -import Data.ByteString qualified as BS -import Data.Code -import Data.Range -import Data.RetryAfter (RetryAfter (RetryAfter)) -import Data.Text qualified as Text -import Data.Text.Ascii qualified as Ascii -import Data.Text.Encoding qualified as Text -import Data.UUID (UUID) -import Imports hiding (lookup) -import OpenSSL.BN (randIntegerZeroToNMinusOne) -import OpenSSL.EVP.Digest (Digest, digestBS, getDigestByName) -import OpenSSL.Random (randBytes) -import Text.Printf (printf) -import Wire.API.User qualified as User -import Wire.API.User.Identity -import Wire.UserKeyStore - --------------------------------------------------------------------------------- --- Code - -data Code = Code - { codeKey :: !Key, - codeScope :: !Scope, - codeValue :: !Value, - codeRetries :: !Retries, - codeTTL :: !Timeout, - codeFor :: !Email, - codeAccount :: !(Maybe UUID) - } - deriving (Eq, Show) - -scopeFromAction :: User.VerificationAction -> Scope -scopeFromAction = \case - User.CreateScimToken -> CreateScimToken - User.Login -> AccountLogin - User.DeleteTeam -> DeleteTeam - -codeToKeyValuePair :: Code -> KeyValuePair -codeToKeyValuePair code = KeyValuePair code.codeKey code.codeValue - --- | The same 'Key' can exist with different 'Value's in different --- 'Scope's at the same time. -data Scope - = AccountDeletion - | IdentityVerification - | PasswordReset - | AccountLogin - | AccountApproval - | CreateScimToken - | DeleteTeam - deriving (Eq, Show) - -instance Cql Scope where - ctype = Tagged IntColumn - - toCql AccountDeletion = CqlInt 1 - toCql IdentityVerification = CqlInt 2 - toCql PasswordReset = CqlInt 3 - toCql AccountLogin = CqlInt 4 - toCql AccountApproval = CqlInt 5 - toCql CreateScimToken = CqlInt 6 - toCql DeleteTeam = CqlInt 7 - - fromCql (CqlInt 1) = pure AccountDeletion - fromCql (CqlInt 2) = pure IdentityVerification - fromCql (CqlInt 3) = pure PasswordReset - fromCql (CqlInt 4) = pure AccountLogin - fromCql (CqlInt 5) = pure AccountApproval - fromCql (CqlInt 6) = pure CreateScimToken - fromCql (CqlInt 7) = pure DeleteTeam - fromCql _ = Left "fromCql: Scope: int expected" - -newtype Retries = Retries {numRetries :: Word8} - deriving (Eq, Show, Ord, Num, Integral, Enum, Real) - -instance Cql Retries where - ctype = Tagged IntColumn - toCql = CqlInt . fromIntegral . numRetries - fromCql (CqlInt n) = pure (Retries (fromIntegral n)) - fromCql _ = Left "fromCql: Retries: int expected" - --------------------------------------------------------------------------------- --- Generation - --- | A contextual string that is hashed into the key to yield distinct keys in --- different contexts for the same email address. --- TODO: newtype KeyContext = KeyContext ByteString -data Gen = Gen - { genFor :: !Email, - genKey :: !Key, -- Note [Unique keys] - genValue :: IO Value - } - -mkKey :: (MonadIO m) => Email -> m Key -mkKey cfor = liftIO $ do - Just sha256 <- getDigestByName "SHA256" - let uniqueK = emailKeyUniq (mkEmailKey cfor) - pure $ mkKey' sha256 (Text.encodeUtf8 uniqueK) - --- | Initialise a 'Code' 'Gen'erator for a given natural key. This generates a link for emails and a 6-digit code for phone. See also: `mk6DigitGen`. -mkGen :: (MonadIO m) => Email -> m Gen -mkGen cfor = liftIO $ do - Just sha256 <- getDigestByName "SHA256" - pure (mkEmailLinkGen cfor sha256) - --- | Initialise a 'Code' 'Gen'erator for a given natural key. This generates a 6-digit code, matter whether it is sent to a phone or to an email address. See also: `mkGen`. -mk6DigitGen :: (MonadIO m) => Email -> m Gen -mk6DigitGen cfor = liftIO $ do - Just sha256 <- getDigestByName "SHA256" - pure $ mk6DigitGen' cfor sha256 - -mk6DigitGen' :: Email -> Digest -> Gen -mk6DigitGen' cfor d = - let uniqueK = emailKeyUniq (mkEmailKey cfor) - key = mkKey' d $ Text.encodeUtf8 uniqueK - val = Value . unsafeRange . Ascii.unsafeFromText . Text.pack . printf "%06d" <$> randIntegerZeroToNMinusOne (10 ^ (6 :: Int)) - in Gen cfor key val - -mkEmailLinkGen :: Email -> Digest -> Gen -mkEmailLinkGen e d = - let key = mkKey' d (Text.encodeUtf8 (emailKeyUniq (mkEmailKey e))) - val = Value . unsafeRange . Ascii.encodeBase64Url <$> randBytes 15 - in Gen e key val - -mkKey' :: Digest -> ByteString -> Key -mkKey' d = Key . unsafeRange . Ascii.encodeBase64Url . BS.take 15 . digestBS d - --- | Generate a new 'Code'. -generate :: - (MonadIO m) => - -- | The 'Gen'erator to use. - Gen -> - -- | The scope of the generated code. - Scope -> - -- | Maximum verification attempts. - Retries -> - -- | Time-to-live in seconds. - Timeout -> - -- | Associated account ID. - Maybe UUID -> - m Code -generate gen scope retries ttl account = do - let key = genKey gen - val <- liftIO $ genValue gen - pure $ mkCode key val - where - mkCode key val = - Code - { codeKey = key, - codeValue = val, - codeScope = scope, - codeRetries = retries, - codeTTL = ttl, - codeFor = genFor gen, - codeAccount = account - } - --- Note [Unique keys] --- --- We want unique, stable keys that we can associate the secret values with. --- Using the plain natural identifiers (e.g. e-mail addresses or phone numbers) --- has a few downsides: --- --- * The keys are often placed in URLs for verification purposes, --- giving them unnecessary exposure. --- * If the keys are not opaque, it can be harder to change their --- structure, possibly embedding additional information. --- * Since the keys are often placed in URLs, they must only contain --- URL-safe characters or otherwise require appropriate encoding. --- --- Therefore we use the following simple construction: --- --- * Compute the SHA-256 truncated to 120 bits of the plain, normalised, --- utf8-encoded natural identifier (i.e. e-mail address or phone number). --- * Apply URL-safe base64 encoding to yield the final key of length 20. --- --- Truncation of SHA-2 outputs is a safe and common practice, only reducing --- collision resistance (e.g. after 2^60 for truncated SHA-256/120 due to the --- birthday paradox). Collisions have no security implications in this context; --- at most it enables verification of one random e-mail address or phone --- number via another, at least one of which must be accessible. It is only --- important that keys be sufficiently unique and random collisions rare --- while keeping the length reasonably short, so that keys may be used in --- length-constrained contexts (e.g. SMS) or even be spelled out or typed. - --------------------------------------------------------------------------------- --- Storage - -insert :: (MonadClient m) => Code -> Int -> m (Maybe RetryAfter) -insert code ttl = do - mRetryAfter <- lookupThrottle (codeKey code) (codeScope code) - case mRetryAfter of - Just ra -> pure (Just ra) - Nothing -> do - insertThrottle code ttl - insertInternal code - pure Nothing - where - insertThrottle :: (MonadClient m) => Code -> Int -> m () - insertThrottle c t = do - let k = codeKey c - let s = codeScope c - retry x5 (write cql (params LocalQuorum (k, s, fromIntegral t, fromIntegral t))) - where - cql :: PrepQuery W (Key, Scope, Int32, Int32) () - cql = - "INSERT INTO vcodes_throttle (key, scope, initial_delay) \ - \VALUES (?, ?, ?) USING TTL ?" - -insertInternal :: (MonadClient m) => Code -> m () -insertInternal c = do - let k = codeKey c - let s = codeScope c - let v = codeValue c - let r = fromIntegral (codeRetries c) - let a = codeAccount c - let e = codeFor c - let t = round (codeTTL c) - retry x5 (write cql (params LocalQuorum (k, s, v, r, e, a, t))) - where - cql :: PrepQuery W (Key, Scope, Value, Retries, Email, Maybe UUID, Int32) () - cql = - "INSERT INTO vcodes (key, scope, value, retries, email, account) \ - \VALUES (?, ?, ?, ?, ?, ?) USING TTL ?" - --- | Check if code generation should be throttled. -lookupThrottle :: (MonadClient m) => Key -> Scope -> m (Maybe RetryAfter) -lookupThrottle k s = do - fmap (RetryAfter . fromIntegral . runIdentity) <$> retry x1 (query1 cql (params LocalQuorum (k, s))) - where - cql :: PrepQuery R (Key, Scope) (Identity Int32) - cql = - "SELECT ttl(initial_delay) \ - \FROM vcodes_throttle WHERE key = ? AND scope = ?" - --- | Lookup a pending code. -lookup :: (MonadClient m) => Key -> Scope -> m (Maybe Code) -lookup k s = fmap (toCode k s) <$> retry x1 (query1 cql (params LocalQuorum (k, s))) - where - cql :: PrepQuery R (Key, Scope) (Value, Int32, Retries, Maybe Email, Maybe UUID) - cql = - "SELECT value, ttl(value), retries, email, account \ - \FROM vcodes WHERE key = ? AND scope = ?" - --- | Lookup and verify the code for the given key and scope --- against the given value. -verify :: (MonadClient m) => Key -> Scope -> Value -> m (Maybe Code) -verify k s v = lookup k s >>= maybe (pure Nothing) continue - where - continue c - | codeValue c == v && codeRetries c > 0 = pure (Just c) - | codeRetries c > 0 = do - insertInternal (c {codeRetries = codeRetries c - 1}) - pure Nothing - | otherwise = pure Nothing - --- | Delete a code associated with the given key and scope. -delete :: (MonadClient m) => Key -> Scope -> m () -delete k s = retry x5 $ write cql (params LocalQuorum (k, s)) - where - cql :: PrepQuery W (Key, Scope) () - cql = "DELETE FROM vcodes WHERE key = ? AND scope = ?" - --------------------------------------------------------------------------------- --- Internal - -toCode :: Key -> Scope -> (Value, Int32, Retries, Maybe Email, Maybe UUID) -> Code -toCode k s (val, ttl, retries, email, account) = case email of - Nothing -> error "toCode: email or phone must be present" - Just e -> - Code - { codeKey = k, - codeScope = s, - codeValue = val, - codeTTL = Timeout (fromIntegral ttl), - codeRetries = retries, - codeFor = e, - codeAccount = account - } diff --git a/services/brig/src/Brig/Provider/API.hs b/services/brig/src/Brig/Provider/API.hs index 10ad0a73870..c9e13f86cdf 100644 --- a/services/brig/src/Brig/Provider/API.hs +++ b/services/brig/src/Brig/Provider/API.hs @@ -32,10 +32,8 @@ import Bilge.RPC (HasRequestId) import Brig.API.Client qualified as Client import Brig.API.Error import Brig.API.Handler -import Brig.API.Types (PasswordResetError (..), VerificationCodeThrottledError (VerificationCodeThrottled)) -import Brig.API.Util +import Brig.API.Types (PasswordResetError (..)) import Brig.App -import Brig.Code qualified as Code import Brig.Data.Client qualified as User import Brig.Data.User qualified as User import Brig.Options (Settings (..)) @@ -55,6 +53,7 @@ import Control.Monad.Catch (MonadMask) import Control.Monad.Except import Data.ByteString.Conversion import Data.ByteString.Lazy.Char8 qualified as LC8 +import Data.Code qualified as Code import Data.CommaSeparatedList (CommaSeparatedList (fromCommaSeparatedList)) import Data.Conduit (runConduit, (.|)) import Data.Conduit.List qualified as C @@ -120,10 +119,14 @@ import Wire.API.User.Client.Prekey qualified as Public (PrekeyId) import Wire.API.User.Identity qualified as Public (Email) import Wire.DeleteQueue import Wire.EmailSending (EmailSending) +import Wire.Error import Wire.GalleyAPIAccess (GalleyAPIAccess) import Wire.GalleyAPIAccess qualified as GalleyAPIAccess import Wire.Sem.Concurrency (Concurrency, ConcurrencySafety (Unsafe)) import Wire.UserKeyStore (mkEmailKey) +import Wire.VerificationCode as VerificationCode +import Wire.VerificationCodeGen +import Wire.VerificationCodeSubsystem botAPI :: ( Member GalleyAPIAccess r, @@ -161,7 +164,7 @@ servicesAPI = :<|> Named @"get-whitelisted-services-by-team-id" searchTeamServiceProfiles :<|> Named @"post-team-whitelist-by-team-id" updateServiceWhitelist -providerAPI :: (Member GalleyAPIAccess r, Member EmailSending r) => ServerT ProviderAPI (Handler r) +providerAPI :: (Member GalleyAPIAccess r, Member EmailSending r, Member VerificationCodeSubsystem r) => ServerT ProviderAPI (Handler r) providerAPI = Named @"provider-register" newAccount :<|> Named @"provider-activate" activateAccountKey @@ -175,13 +178,13 @@ providerAPI = :<|> Named @"provider-get-account" getAccount :<|> Named @"provider-get-profile" getProviderProfile -internalProviderAPI :: (Member GalleyAPIAccess r) => ServerT BrigIRoutes.ProviderAPI (Handler r) +internalProviderAPI :: (Member GalleyAPIAccess r, Member VerificationCodeSubsystem r) => ServerT BrigIRoutes.ProviderAPI (Handler r) internalProviderAPI = Named @"get-provider-activation-code" getActivationCodeH -------------------------------------------------------------------------------- -- Public API (Unauthenticated) -newAccount :: (Member GalleyAPIAccess r, Member EmailSending r) => Public.NewProvider -> (Handler r) Public.NewProviderResponse +newAccount :: (Member GalleyAPIAccess r, Member EmailSending r, Member VerificationCodeSubsystem r) => Public.NewProvider -> (Handler r) Public.NewProviderResponse newAccount new = do guardSecondFactorDisabled Nothing email <- case validateEmail (Public.newProviderEmail new) of @@ -200,25 +203,25 @@ newAccount new = do safePass <- mkSafePasswordScrypt newPass pure (safePass, Just newPass) pid <- wrapClientE $ DB.insertAccount name safePass url descr - gen <- Code.mkGen email + let gen = mkVerificationCodeGen email code <- - Code.generate - gen - Code.IdentityVerification - (Code.Retries 3) - (Code.Timeout (3600 * 24)) -- 24h - (Just (toUUID pid)) - tryInsertVerificationCode code $ verificationCodeThrottledError . VerificationCodeThrottled - let key = Code.codeKey code - let val = Code.codeValue code + lift . liftSem $ + createCodeOverwritePrevious + gen + IdentityVerification + (Retries 3) + (Timeout (3600 * 24)) -- 24h + (Just (toUUID pid)) + let key = codeKey code + let val = codeValue code lift $ sendActivationMail name email key val False pure $ Public.NewProviderResponse pid newPass -activateAccountKey :: (Member GalleyAPIAccess r, Member EmailSending r) => Code.Key -> Code.Value -> (Handler r) (Maybe Public.ProviderActivationResponse) +activateAccountKey :: (Member GalleyAPIAccess r, Member EmailSending r, Member VerificationCodeSubsystem r) => Code.Key -> Code.Value -> (Handler r) (Maybe Public.ProviderActivationResponse) activateAccountKey key val = do guardSecondFactorDisabled Nothing - c <- wrapClientE (Code.verify key Code.IdentityVerification val) >>= maybeInvalidCode - (pid, email) <- case (Code.codeAccount c, Just (Code.codeFor c)) of + c <- (lift . liftSem $ verifyCode key IdentityVerification val) >>= maybeInvalidCode + (pid, email) <- case (codeAccount c, Just (codeFor c)) of (Just p, Just e) -> pure (Id p, e) _ -> throwStd (errorToWai @'E.InvalidCode) (name, memail, _url, _descr) <- wrapClientE (DB.lookupAccountData pid) >>= maybeInvalidCode @@ -226,8 +229,8 @@ activateAccountKey key val = do Just email' | email == email' -> pure Nothing Just email' -> do -- Ensure we remove any pending password reset - gen <- Code.mkGen email' - lift $ wrapClient $ Code.delete (Code.genKey gen) Code.PasswordReset + let gen = mkVerificationCodeGen email' + lift $ liftSem $ deleteCode gen.genKey VerificationCode.PasswordReset -- Activate the new and remove the old key activate pid (Just email') email pure . Just $ Public.ProviderActivationResponse email @@ -237,15 +240,15 @@ activateAccountKey key val = do lift $ sendApprovalConfirmMail name email pure . Just $ Public.ProviderActivationResponse email -getActivationCodeH :: (Member GalleyAPIAccess r) => Public.Email -> (Handler r) Code.KeyValuePair +getActivationCodeH :: (Member GalleyAPIAccess r, Member VerificationCodeSubsystem r) => Public.Email -> (Handler r) Code.KeyValuePair getActivationCodeH e = do guardSecondFactorDisabled Nothing email <- case validateEmail e of Right em -> pure em Left _ -> throwStd (errorToWai @'E.InvalidEmail) - gen <- Code.mkGen email - code <- wrapClientE $ Code.lookup (Code.genKey gen) Code.IdentityVerification - maybe (throwStd activationKeyNotFound) (pure . Code.codeToKeyValuePair) code + let gen = mkVerificationCodeGen email + code <- lift . liftSem $ internalLookupCode gen.genKey IdentityVerification + maybe (throwStd activationKeyNotFound) (pure . codeToKeyValuePair) code login :: (Member GalleyAPIAccess r) => ProviderLogin -> Handler r ProviderTokenCookie login l = do @@ -258,29 +261,22 @@ login l = do s <- view settings pure $ ProviderTokenCookie (ProviderToken token) (not (setCookieInsecure s)) -beginPasswordReset :: (Member GalleyAPIAccess r, Member EmailSending r) => Public.PasswordReset -> (Handler r) () +beginPasswordReset :: (Member GalleyAPIAccess r, Member EmailSending r, Member VerificationCodeSubsystem r) => Public.PasswordReset -> (Handler r) () beginPasswordReset (Public.PasswordReset target) = do guardSecondFactorDisabled Nothing pid <- wrapClientE (DB.lookupKey (mkEmailKey target)) >>= maybeBadCredentials - gen <- Code.mkGen target - pending <- lift . wrapClient $ Code.lookup (Code.genKey gen) Code.PasswordReset - code <- case pending of - Just p -> throwE $ pwResetError (PasswordResetInProgress . Just $ Code.codeTTL p) - Nothing -> - Code.generate - gen - Code.PasswordReset - (Code.Retries 3) - (Code.Timeout 3600) -- 1h - (Just (toUUID pid)) - tryInsertVerificationCode code $ verificationCodeThrottledError . VerificationCodeThrottled - lift $ sendPasswordResetMail target (Code.codeKey code) (Code.codeValue code) - -completePasswordReset :: (Member GalleyAPIAccess r) => Public.CompletePasswordReset -> (Handler r) () + let gen = mkVerificationCodeGen target + (lift . liftSem $ createCode gen VerificationCode.PasswordReset (Retries 3) (Timeout 3600) (Just (toUUID pid))) >>= \case + Left (CodeAlreadyExists code) -> + throwE $ pwResetError (PasswordResetInProgress $ Just code.codeTTL) + Right code -> + lift $ sendPasswordResetMail target (code.codeKey) (code.codeValue) + +completePasswordReset :: (Member GalleyAPIAccess r, Member VerificationCodeSubsystem r) => Public.CompletePasswordReset -> (Handler r) () completePasswordReset (Public.CompletePasswordReset key val newpwd) = do guardSecondFactorDisabled Nothing - code <- wrapClientE (Code.verify key Code.PasswordReset val) >>= maybeInvalidCode - case Id <$> Code.codeAccount code of + code <- (lift . liftSem $ verifyCode key VerificationCode.PasswordReset val) >>= maybeInvalidCode + case Id <$> code.codeAccount of Nothing -> throwStd (errorToWai @'E.InvalidPasswordResetCode) Just pid -> do oldpass <- wrapClientE (DB.lookupPassword pid) >>= maybeBadCredentials @@ -288,7 +284,7 @@ completePasswordReset (Public.CompletePasswordReset key val newpwd) = do throwStd (errorToWai @'E.ResetPasswordMustDiffer) wrapClientE $ do DB.updateAccountPassword pid newpwd - Code.delete key Code.PasswordReset + lift . liftSem $ deleteCode key VerificationCode.PasswordReset -------------------------------------------------------------------------------- -- Provider API @@ -309,7 +305,7 @@ updateAccountProfile pid upd = do (updateProviderUrl upd) (updateProviderDescr upd) -updateAccountEmail :: (Member GalleyAPIAccess r, Member EmailSending r) => ProviderId -> Public.EmailUpdate -> (Handler r) () +updateAccountEmail :: (Member GalleyAPIAccess r, Member EmailSending r, Member VerificationCodeSubsystem r) => ProviderId -> Public.EmailUpdate -> (Handler r) () updateAccountEmail pid (Public.EmailUpdate new) = do guardSecondFactorDisabled Nothing email <- case validateEmail new of @@ -317,16 +313,16 @@ updateAccountEmail pid (Public.EmailUpdate new) = do Left _ -> throwStd (errorToWai @'E.InvalidEmail) let emailKey = mkEmailKey email wrapClientE (DB.lookupKey emailKey) >>= mapM_ (const $ throwStd emailExists) - gen <- Code.mkGen email + let gen = mkVerificationCodeGen email code <- - Code.generate - gen - Code.IdentityVerification - (Code.Retries 3) - (Code.Timeout (3600 * 24)) -- 24h - (Just (toUUID pid)) - tryInsertVerificationCode code $ verificationCodeThrottledError . VerificationCodeThrottled - lift $ sendActivationMail (Name "name") email (Code.codeKey code) (Code.codeValue code) True + lift . liftSem $ + createCodeOverwritePrevious + gen + IdentityVerification + (Retries 3) + (Timeout (3600 * 24)) -- 24h + (Just (toUUID pid)) + lift $ sendActivationMail (Name "name") email code.codeKey code.codeValue True updateAccountPassword :: (Member GalleyAPIAccess r) => ProviderId -> Public.PasswordChange -> (Handler r) () updateAccountPassword pid upd = do @@ -729,7 +725,7 @@ removeBot zusr zcon cid bid = do Just _ -> do lift $ Public.RemoveBotResponse <$$> wrapHttpClient (deleteBot zusr (Just zcon) bid cid) -guardConvAdmin :: Conversation -> ExceptT Error (AppT r) () +guardConvAdmin :: Conversation -> ExceptT HttpError (AppT r) () guardConvAdmin conv = do let selfMember = cmSelf . cnvMembers $ conv unless (memConvRoleName selfMember == roleNameWireAdmin) $ (throwStd (errorToWai @'E.AccessDenied)) @@ -806,7 +802,7 @@ botDeleteSelf bid cid = do guardSecondFactorDisabled :: (Member GalleyAPIAccess r) => Maybe UserId -> - ExceptT Error (AppT r) () + ExceptT HttpError (AppT r) () guardSecondFactorDisabled mbUserId = do enabled <- lift $ liftSem $ (==) Feature.FeatureStatusEnabled . Feature.wsStatus . Feature.afcSndFactorPasswordChallenge <$> GalleyAPIAccess.getAllFeatureConfigsForUser mbUserId when enabled $ (throwStd (errorToWai @'E.AccessDenied)) @@ -883,28 +879,28 @@ mkBotUserView u = Ext.botUserViewTeam = userTeam u } -maybeInvalidProvider :: (Monad m) => Maybe a -> (ExceptT Error m) a +maybeInvalidProvider :: (Monad m) => Maybe a -> (ExceptT HttpError m) a maybeInvalidProvider = maybe (throwStd (errorToWai @'E.ProviderNotFound)) pure -maybeInvalidCode :: (Monad m) => Maybe a -> (ExceptT Error m) a +maybeInvalidCode :: (Monad m) => Maybe a -> (ExceptT HttpError m) a maybeInvalidCode = maybe (throwStd (errorToWai @'E.InvalidCode)) pure -maybeServiceNotFound :: (Monad m) => Maybe a -> (ExceptT Error m) a +maybeServiceNotFound :: (Monad m) => Maybe a -> (ExceptT HttpError m) a maybeServiceNotFound = maybe (throwStd (errorToWai @'E.ServiceNotFound)) pure -maybeConvNotFound :: (Monad m) => Maybe a -> (ExceptT Error m) a +maybeConvNotFound :: (Monad m) => Maybe a -> (ExceptT HttpError m) a maybeConvNotFound = maybe (throwStd (notFound "Conversation not found")) pure -maybeBadCredentials :: (Monad m) => Maybe a -> (ExceptT Error m) a +maybeBadCredentials :: (Monad m) => Maybe a -> (ExceptT HttpError m) a maybeBadCredentials = maybe (throwStd (errorToWai @'E.BadCredentials)) pure -maybeInvalidServiceKey :: (Monad m) => Maybe a -> (ExceptT Error m) a +maybeInvalidServiceKey :: (Monad m) => Maybe a -> (ExceptT HttpError m) a maybeInvalidServiceKey = maybe (throwStd (errorToWai @'E.InvalidServiceKey)) pure -maybeInvalidUser :: (Monad m) => Maybe a -> (ExceptT Error m) a +maybeInvalidUser :: (Monad m) => Maybe a -> (ExceptT HttpError m) a maybeInvalidUser = maybe (throwStd (errorToWai @'E.InvalidUser)) pure -rangeChecked :: (KnownNat n, KnownNat m, Within a n m, Monad monad) => a -> (ExceptT Error monad) (Range n m a) +rangeChecked :: (KnownNat n, KnownNat m, Within a n m, Monad monad) => a -> (ExceptT HttpError monad) (Range n m a) rangeChecked = either (throwStd . invalidRange . fromString) pure . checkedEither badGatewayWith :: String -> Wai.Error diff --git a/services/brig/src/Brig/Team/API.hs b/services/brig/src/Brig/Team/API.hs index 68b1328b8b4..900506d6bd7 100644 --- a/services/brig/src/Brig/Team/API.hs +++ b/services/brig/src/Brig/Team/API.hs @@ -78,6 +78,7 @@ import Wire.API.User hiding (fromEmail) import Wire.API.User qualified as Public import Wire.API.User.Identity qualified as Email import Wire.EmailSending (EmailSending) +import Wire.Error import Wire.GalleyAPIAccess (GalleyAPIAccess, ShowOrHideInvitationUrl (..)) import Wire.GalleyAPIAccess qualified as GalleyAPIAccess import Wire.NotificationSubsystem diff --git a/services/brig/src/Brig/Team/Util.hs b/services/brig/src/Brig/Team/Util.hs index 20a677b79a8..6ab5eab896d 100644 --- a/services/brig/src/Brig/Team/Util.hs +++ b/services/brig/src/Brig/Team/Util.hs @@ -30,18 +30,19 @@ import Polysemy (Member) import Wire.API.Team.Member import Wire.API.Team.Permission import Wire.API.User (User (userTeam)) +import Wire.Error import Wire.GalleyAPIAccess (GalleyAPIAccess) import Wire.GalleyAPIAccess qualified as GalleyAPIAccess -- | If the user is in a team, it has to have these permissions. If not, it is a personal -- user with account validation and thus given the permission implicitly. (Used for -- `SearchContactcs`.) -ensurePermissionsOrPersonalUser :: (Member GalleyAPIAccess r, IsPerm perm) => UserId -> [perm] -> ExceptT Error (AppT r) () +ensurePermissionsOrPersonalUser :: (Member GalleyAPIAccess r, IsPerm perm) => UserId -> [perm] -> ExceptT HttpError (AppT r) () ensurePermissionsOrPersonalUser u perms = do mbUser <- lift $ wrapHttp $ Data.lookupUser NoPendingInvitations u maybe (pure ()) (\tid -> ensurePermissions u tid perms) (userTeam =<< mbUser :: Maybe TeamId) -ensurePermissions :: (Member GalleyAPIAccess r, IsPerm perm) => UserId -> TeamId -> [perm] -> ExceptT Error (AppT r) () +ensurePermissions :: (Member GalleyAPIAccess r, IsPerm perm) => UserId -> TeamId -> [perm] -> ExceptT HttpError (AppT r) () ensurePermissions u t perms = do m <- lift $ liftSem $ GalleyAPIAccess.getTeamMember u t unless (check m) $ @@ -54,7 +55,7 @@ ensurePermissions u t perms = do -- | Privilege escalation detection (make sure no `RoleMember` user creates a `RoleOwner`). -- -- There is some code duplication with 'Galley.API.Teams.ensureNotElevated'. -ensurePermissionToAddUser :: (Member GalleyAPIAccess r) => UserId -> TeamId -> Permissions -> ExceptT Error (AppT r) () +ensurePermissionToAddUser :: (Member GalleyAPIAccess r) => UserId -> TeamId -> Permissions -> ExceptT HttpError (AppT r) () ensurePermissionToAddUser u t inviteePerms = do minviter <- lift $ liftSem $ GalleyAPIAccess.getTeamMember u t unless (check minviter) $ diff --git a/services/brig/src/Brig/User/Auth.hs b/services/brig/src/Brig/User/Auth.hs index 362d5ac3c46..ba4f765436a 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.Code qualified as Code import Brig.Data.Activation qualified as Data import Brig.Data.Client import Brig.Data.User qualified as Data @@ -51,6 +50,7 @@ import Cassandra import Control.Error hiding (bool) import Control.Lens (to, view) import Data.ByteString.Conversion (toByteString) +import Data.Code qualified as Code import Data.Handle (Handle) import Data.Id import Data.List.NonEmpty qualified as NE @@ -80,6 +80,10 @@ import Wire.PasswordStore (PasswordStore) import Wire.Sem.Paging.Cassandra (InternalPaging) import Wire.UserKeyStore import Wire.UserStore +import Wire.VerificationCode qualified as VerificationCode +import Wire.VerificationCodeGen qualified as VerificationCodeGen +import Wire.VerificationCodeSubsystem (VerificationCodeSubsystem) +import Wire.VerificationCodeSubsystem qualified as VerificationCodeSubsystem login :: forall r. @@ -92,7 +96,8 @@ login :: Member (ConnectionStore InternalPaging) r, Member PasswordStore r, Member UserKeyStore r, - Member UserStore r + Member UserStore r, + Member VerificationCodeSubsystem r ) => Login -> CookieType -> @@ -123,7 +128,7 @@ login (SmsLogin _) _ = do verifyCode :: forall r. - (Member GalleyAPIAccess r) => + (Member GalleyAPIAccess r, Member VerificationCodeSubsystem r) => Maybe Code.Value -> VerificationAction -> UserId -> @@ -137,8 +142,9 @@ verifyCode mbCode action uid = do when (featureEnabled && not isSsoUser) $ do case (mbCode, mbEmail) of (Just code, Just email) -> do - key <- Code.mkKey email - codeValid <- isJust <$> wrapHttpClientE (Code.verify key (Code.scopeFromAction action) code) + let key = VerificationCodeGen.mkKey email + scope = VerificationCode.scopeFromAction action + codeValid <- isJust <$> lift (liftSem $ VerificationCodeSubsystem.verifyCode key scope code) unless codeValid $ throwE VerificationCodeNoPendingCode (Nothing, _) -> throwE VerificationCodeRequired (_, Nothing) -> throwE VerificationCodeNoEmail diff --git a/services/brig/test/integration/API/Provider.hs b/services/brig/test/integration/API/Provider.hs index 9f9b3b342cf..0d2aad8a5db 100644 --- a/services/brig/test/integration/API/Provider.hs +++ b/services/brig/test/integration/API/Provider.hs @@ -27,7 +27,6 @@ where import API.Team.Util qualified as Team import Bilge hiding (accept, head, timeout) import Bilge.Assert -import Brig.Code qualified as Code import Cassandra qualified as DB import Control.Arrow ((&&&)) import Control.Concurrent.Async qualified as Async @@ -40,6 +39,7 @@ import Data.ByteString qualified as BS import Data.ByteString.Char8 qualified as C8 import Data.ByteString.Conversion import Data.ByteString.Lazy.Char8 qualified as LC8 +import Data.Code qualified as Code import Data.Domain import Data.Handle (parseHandle) import Data.HashMap.Strict qualified as HashMap @@ -100,6 +100,9 @@ import Wire.API.User as User hiding (EmailUpdate, PasswordChange, mkName) import Wire.API.User.Auth (CookieType (..)) import Wire.API.User.Client import Wire.API.User.Client.Prekey +import Wire.VerificationCode qualified as Code +import Wire.VerificationCodeGen +import Wire.VerificationCodeStore.Cassandra qualified as VerificationCodeStore tests :: Domain -> Config -> Manager -> DB.ClientState -> Brig -> Cannon -> Galley -> Nginz -> IO TestTree tests dom conf p db b c g n = do @@ -263,7 +266,7 @@ testPasswordResetProvider db brig = do resetPw :: PlainTextPassword6 -> Email -> Http ResponseLBS resetPw newPw email = do -- Get the code directly from the DB - gen <- Code.mkGen email + let gen = mkVerificationCodeGen email Just vcode <- lookupCode db gen Code.PasswordReset let passwordResetData = CompletePasswordReset @@ -281,7 +284,7 @@ testPasswordResetAfterEmailUpdateProvider db brig = do initiateEmailUpdateProvider brig pid (EmailUpdate newEmail) !!! const 202 === statusCode initiatePasswordResetProvider brig (PasswordReset origEmail) !!! const 201 === statusCode -- Get password reset code directly from the DB - genOrig <- Code.mkGen origEmail + let genOrig = mkVerificationCodeGen origEmail Just vcodePw <- lookupCode db genOrig Code.PasswordReset let passwordResetData = CompletePasswordReset @@ -289,7 +292,7 @@ testPasswordResetAfterEmailUpdateProvider db brig = do (Code.codeValue vcodePw) (plainTextPassword6Unsafe "doesnotmatter") -- Activate the new email - genNew <- Code.mkGen newEmail + let genNew = mkVerificationCodeGen newEmail Just vcodeEm <- lookupCode db genNew Code.IdentityVerification activateProvider brig (Code.codeKey vcodeEm) (Code.codeValue vcodeEm) !!! const 200 === statusCode @@ -1646,8 +1649,8 @@ getUserClients brig bid uid = -------------------------------------------------------------------------------- -- DB Operations -lookupCode :: (MonadIO m) => DB.ClientState -> Code.Gen -> Code.Scope -> m (Maybe Code.Code) -lookupCode db gen = liftIO . DB.runClient db . Code.lookup (Code.genKey gen) +lookupCode :: (MonadIO m) => DB.ClientState -> VerificationCodeGen -> Code.Scope -> m (Maybe Code.Code) +lookupCode db gen = liftIO . DB.runClient db . VerificationCodeStore.lookupCodeImpl gen.genKey -------------------------------------------------------------------------------- -- Utilities @@ -1675,7 +1678,7 @@ testRegisterProvider db' brig = do case db' of Just db -> do -- Activate email - gen <- Code.mkGen email + let gen = mkVerificationCodeGen email Just vcode <- lookupCode db gen Code.IdentityVerification activateProvider brig (Code.codeKey vcode) (Code.codeValue vcode) !!! const 200 === statusCode @@ -1713,7 +1716,7 @@ testRegisterProvider db' brig = do randomProvider :: (HasCallStack) => DB.ClientState -> Brig -> Http Provider randomProvider db brig = do email <- randomEmail - gen <- Code.mkGen email + let gen = mkVerificationCodeGen email -- Register let new = defNewProvider email _rs <- diff --git a/services/brig/test/integration/API/User/Client.hs b/services/brig/test/integration/API/User/Client.hs index c992714c106..fef7075b728 100644 --- a/services/brig/test/integration/API/User/Client.hs +++ b/services/brig/test/integration/API/User/Client.hs @@ -30,7 +30,6 @@ import API.User.Util import API.User.Util qualified as Util import Bilge hiding (accept, head, timeout) import Bilge.Assert -import Brig.Code qualified as Code import Brig.Options qualified as Opt import Brig.Options qualified as Opts import Cassandra qualified as DB @@ -41,6 +40,7 @@ import Data.Aeson qualified as A import Data.Aeson.KeyMap qualified as M import Data.Aeson.Lens import Data.ByteString.Conversion +import Data.Code qualified as Code import Data.Coerce (coerce) import Data.Default import Data.Domain (Domain (..)) @@ -83,6 +83,8 @@ import Wire.API.User.Client.DPoPAccessToken import Wire.API.User.Client.Prekey import Wire.API.UserMap (QualifiedUserMap (..), UserMap (..), WrappedQualifiedUserMap) import Wire.API.Wrapped (Wrapped (..)) +import Wire.VerificationCode qualified as Code +import Wire.VerificationCodeGen tests :: ConnectionLimit -> Opt.Timeout -> Opt.Opts -> Manager -> DB.ClientState -> Nginz -> Brig -> Cannon -> Galley -> TestTree tests _cl _at opts p db n b c g = @@ -151,7 +153,7 @@ testAddGetClientVerificationCode db brig galley = do Util.setTeamFeatureLockStatus @Public.SndFactorPasswordChallengeConfig galley tid Public.LockStatusUnlocked Util.setTeamSndFactorPasswordChallenge galley tid Public.FeatureStatusEnabled Util.generateVerificationCode brig (Public.SendVerificationCode Public.Login email) - k <- Code.mkKey email + let k = mkKey email codeValue <- Code.codeValue <$$> lookupCode db k Code.AccountLogin checkLoginSucceeds $ PasswordLogin $ @@ -207,8 +209,8 @@ testAddGetClientCodeExpired db opts brig galley = do Util.setTeamFeatureLockStatus @Public.SndFactorPasswordChallengeConfig galley tid Public.LockStatusUnlocked Util.setTeamSndFactorPasswordChallenge galley tid Public.FeatureStatusEnabled Util.generateVerificationCode brig (Public.SendVerificationCode Public.Login email) - k <- Code.mkKey email - codeValue <- Code.codeValue <$$> lookupCode db k Code.AccountLogin + let k = mkKey email + codeValue <- (.codeValue) <$$> lookupCode db k Code.AccountLogin checkLoginSucceeds $ PasswordLogin $ PasswordLoginData (LoginByEmail email) defPassword (Just defCookieLabel) codeValue diff --git a/services/brig/test/integration/API/User/Util.hs b/services/brig/test/integration/API/User/Util.hs index e3c90c3f9c9..d862c73ddd1 100644 --- a/services/brig/test/integration/API/User/Util.hs +++ b/services/brig/test/integration/API/User/Util.hs @@ -23,7 +23,6 @@ module API.User.Util where import Bilge hiding (accept, timeout) import Bilge.Assert -import Brig.Code qualified as Code import Brig.Options (Opts) import Brig.Types.Team.LegalHold (LegalHoldClientRequest (..)) import Brig.ZAuth (Token) @@ -37,6 +36,7 @@ import Data.ByteString.Builder (toLazyByteString) import Data.ByteString.Char8 (pack) import Data.ByteString.Conversion import Data.ByteString.Lazy qualified as LB +import Data.Code qualified as Code import Data.Domain import Data.Handle (parseHandle) import Data.Id @@ -76,6 +76,8 @@ import Wire.API.User.Client.DPoPAccessToken (Proof) import Wire.API.User.Client.Prekey import Wire.API.User.Handle import Wire.API.User.Password +import Wire.VerificationCode qualified as Code +import Wire.VerificationCodeStore.Cassandra qualified as VerificationCodeStore newtype ConnectionLimit = ConnectionLimit Int64 @@ -534,7 +536,7 @@ setTeamFeatureLockStatus galley tid status = put (galley . paths ["i", "teams", toByteString' tid, "features", Public.featureNameBS @cfg, toByteString' status]) !!! const 200 === statusCode lookupCode :: (MonadIO m) => DB.ClientState -> Code.Key -> Code.Scope -> m (Maybe Code.Code) -lookupCode db k = liftIO . DB.runClient db . Code.lookup k +lookupCode db k = liftIO . DB.runClient db . VerificationCodeStore.lookupCodeImpl k getNonce :: (MonadHttp m) => diff --git a/services/brig/test/integration/Util.hs b/services/brig/test/integration/Util.hs index 87570a7da58..f2aae1e00de 100644 --- a/services/brig/test/integration/Util.hs +++ b/services/brig/test/integration/Util.hs @@ -27,7 +27,6 @@ import Bilge.Assert import Brig.AWS.Types import Brig.App (applog, fsWatcher, sftEnv, turnEnv) import Brig.Calling as Calling -import Brig.Code qualified as Code import Brig.Options qualified as Opt import Brig.Run qualified as Run import Brig.Types.Activation @@ -50,6 +49,7 @@ import Data.ByteString.Builder (toLazyByteString) import Data.ByteString.Char8 (pack) import Data.ByteString.Char8 qualified as B8 import Data.ByteString.Conversion +import Data.Code qualified as Code import Data.Default import Data.Domain (Domain (..), domainText, mkDomain) import Data.Handle (Handle (..)) From f2150bd07b8f3030733f8ae0d04ee7b66d55f3e2 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Marko=20Dimja=C5=A1evi=C4=87?= Date: Mon, 8 Jul 2024 10:25:17 +0200 Subject: [PATCH 62/64] Rename effect EmailSmsSubsystem to EmailSubsystem (#4123) --- .../AuthenticationSubsystem/Interpreter.hs | 6 ++--- ...EmailSmsSubsystem.hs => EmailSubsystem.hs} | 26 +++++++++---------- .../Interpreter.hs | 12 ++++----- .../Template.hs | 2 +- .../InterpreterSpec.hs | 6 ++--- .../test/unit/Wire/MockInterpreters.hs | 2 +- ...EmailSmsSubsystem.hs => EmailSubsystem.hs} | 10 +++---- libs/wire-subsystems/wire-subsystems.cabal | 8 +++--- services/brig/src/Brig/API/Auth.hs | 4 +-- services/brig/src/Brig/API/Client.hs | 6 ++--- services/brig/src/Brig/API/Internal.hs | 12 ++++----- services/brig/src/Brig/API/Public.hs | 18 ++++++------- services/brig/src/Brig/API/User.hs | 8 +++--- services/brig/src/Brig/App.hs | 2 +- .../brig/src/Brig/CanonicalInterpreter.hs | 8 +++--- services/brig/src/Brig/Provider/Email.hs | 4 +-- services/brig/src/Brig/Provider/Template.hs | 2 +- services/brig/src/Brig/Team/DB.hs | 2 +- services/brig/src/Brig/Team/Email.hs | 2 +- services/brig/src/Brig/Template.hs | 2 +- services/brig/src/Brig/User/Template.hs | 2 +- 21 files changed, 72 insertions(+), 72 deletions(-) rename libs/wire-subsystems/src/Wire/{EmailSmsSubsystem.hs => EmailSubsystem.hs} (63%) rename libs/wire-subsystems/src/Wire/{EmailSmsSubsystem => EmailSubsystem}/Interpreter.hs (97%) rename libs/wire-subsystems/src/Wire/{EmailSmsSubsystem => EmailSubsystem}/Template.hs (99%) rename libs/wire-subsystems/test/unit/Wire/MockInterpreters/{EmailSmsSubsystem.hs => EmailSubsystem.hs} (65%) diff --git a/libs/wire-subsystems/src/Wire/AuthenticationSubsystem/Interpreter.hs b/libs/wire-subsystems/src/Wire/AuthenticationSubsystem/Interpreter.hs index b0e5f2429fa..94024d5b4cf 100644 --- a/libs/wire-subsystems/src/Wire/AuthenticationSubsystem/Interpreter.hs +++ b/libs/wire-subsystems/src/Wire/AuthenticationSubsystem/Interpreter.hs @@ -41,7 +41,7 @@ import Wire.API.User import Wire.API.User.Password import Wire.AuthenticationSubsystem import Wire.AuthenticationSubsystem.Error -import Wire.EmailSmsSubsystem +import Wire.EmailSubsystem import Wire.HashPassword import Wire.PasswordResetCodeStore import Wire.PasswordStore @@ -63,7 +63,7 @@ interpretAuthenticationSubsystem :: Member (Input (Maybe AllowlistEmailDomains)) r, Member UserSubsystem r, Member PasswordStore r, - Member EmailSmsSubsystem r + Member EmailSubsystem r ) => InterpreterFor AuthenticationSubsystem r interpretAuthenticationSubsystem = interpret $ \case @@ -97,7 +97,7 @@ createPasswordResetCodeImpl :: Member (Input (Maybe AllowlistEmailDomains)) r, Member TinyLog r, Member UserSubsystem r, - Member EmailSmsSubsystem r + Member EmailSubsystem r ) => EmailKey -> Sem r () diff --git a/libs/wire-subsystems/src/Wire/EmailSmsSubsystem.hs b/libs/wire-subsystems/src/Wire/EmailSubsystem.hs similarity index 63% rename from libs/wire-subsystems/src/Wire/EmailSmsSubsystem.hs rename to libs/wire-subsystems/src/Wire/EmailSubsystem.hs index 82d767badfc..13f0093ddd8 100644 --- a/libs/wire-subsystems/src/Wire/EmailSmsSubsystem.hs +++ b/libs/wire-subsystems/src/Wire/EmailSubsystem.hs @@ -1,6 +1,6 @@ {-# LANGUAGE TemplateHaskell #-} -module Wire.EmailSmsSubsystem where +module Wire.EmailSubsystem where import Data.Code qualified as Code import Imports @@ -10,16 +10,16 @@ import Wire.API.User import Wire.API.User.Activation (ActivationCode, ActivationKey) import Wire.API.User.Client (Client (..)) -data EmailSmsSubsystem m a where - SendPasswordResetMail :: Email -> PasswordResetPair -> Maybe Locale -> EmailSmsSubsystem m () - SendVerificationMail :: Email -> ActivationKey -> ActivationCode -> Maybe Locale -> EmailSmsSubsystem m () - SendCreateScimTokenVerificationMail :: Email -> Code.Value -> Maybe Locale -> EmailSmsSubsystem m () - SendLoginVerificationMail :: Email -> Code.Value -> Maybe Locale -> EmailSmsSubsystem m () - SendActivationMail :: Email -> Name -> ActivationKey -> ActivationCode -> Maybe Locale -> EmailSmsSubsystem m () - SendEmailAddressUpdateMail :: Email -> Name -> ActivationKey -> ActivationCode -> Maybe Locale -> EmailSmsSubsystem m () - SendNewClientEmail :: Email -> Name -> Client -> Locale -> EmailSmsSubsystem m () - SendAccountDeletionEmail :: Email -> Name -> Code.Key -> Code.Value -> Locale -> EmailSmsSubsystem m () - SendTeamActivationMail :: Email -> Name -> ActivationKey -> ActivationCode -> Maybe Locale -> Text -> EmailSmsSubsystem m () - SendTeamDeletionVerificationMail :: Email -> Code.Value -> Maybe Locale -> EmailSmsSubsystem m () +data EmailSubsystem m a where + SendPasswordResetMail :: Email -> PasswordResetPair -> Maybe Locale -> EmailSubsystem m () + SendVerificationMail :: Email -> ActivationKey -> ActivationCode -> Maybe Locale -> EmailSubsystem m () + SendCreateScimTokenVerificationMail :: Email -> Code.Value -> Maybe Locale -> EmailSubsystem m () + SendLoginVerificationMail :: Email -> Code.Value -> Maybe Locale -> EmailSubsystem m () + SendActivationMail :: Email -> Name -> ActivationKey -> ActivationCode -> Maybe Locale -> EmailSubsystem m () + SendEmailAddressUpdateMail :: Email -> Name -> ActivationKey -> ActivationCode -> Maybe Locale -> EmailSubsystem m () + SendNewClientEmail :: Email -> Name -> Client -> Locale -> EmailSubsystem m () + SendAccountDeletionEmail :: Email -> Name -> Code.Key -> Code.Value -> Locale -> EmailSubsystem m () + SendTeamActivationMail :: Email -> Name -> ActivationKey -> ActivationCode -> Maybe Locale -> Text -> EmailSubsystem m () + SendTeamDeletionVerificationMail :: Email -> Code.Value -> Maybe Locale -> EmailSubsystem m () -makeSem ''EmailSmsSubsystem +makeSem ''EmailSubsystem diff --git a/libs/wire-subsystems/src/Wire/EmailSmsSubsystem/Interpreter.hs b/libs/wire-subsystems/src/Wire/EmailSubsystem/Interpreter.hs similarity index 97% rename from libs/wire-subsystems/src/Wire/EmailSmsSubsystem/Interpreter.hs rename to libs/wire-subsystems/src/Wire/EmailSubsystem/Interpreter.hs index cbde4f6bb98..519c5101cb0 100644 --- a/libs/wire-subsystems/src/Wire/EmailSmsSubsystem/Interpreter.hs +++ b/libs/wire-subsystems/src/Wire/EmailSubsystem/Interpreter.hs @@ -1,7 +1,7 @@ {-# LANGUAGE RecordWildCards #-} -module Wire.EmailSmsSubsystem.Interpreter - ( emailSmsSubsystemInterpreter, +module Wire.EmailSubsystem.Interpreter + ( emailSubsystemInterpreter, mkMimeAddress, ) where @@ -21,11 +21,11 @@ import Wire.API.User.Activation import Wire.API.User.Client (Client (..)) import Wire.API.User.Password import Wire.EmailSending (EmailSending, sendMail) -import Wire.EmailSmsSubsystem -import Wire.EmailSmsSubsystem.Template +import Wire.EmailSubsystem +import Wire.EmailSubsystem.Template -emailSmsSubsystemInterpreter :: (Member EmailSending r) => Localised UserTemplates -> TemplateBranding -> InterpreterFor EmailSmsSubsystem r -emailSmsSubsystemInterpreter tpls branding = interpret \case +emailSubsystemInterpreter :: (Member EmailSending r) => Localised UserTemplates -> TemplateBranding -> InterpreterFor EmailSubsystem r +emailSubsystemInterpreter tpls branding = interpret \case SendPasswordResetMail email (key, code) mLocale -> sendPasswordResetMailImpl tpls branding email key code mLocale SendVerificationMail email key code mLocale -> sendVerificationMailImpl tpls branding email key code mLocale SendTeamDeletionVerificationMail email code mLocale -> sendTeamDeletionVerificationMailImpl tpls branding email code mLocale diff --git a/libs/wire-subsystems/src/Wire/EmailSmsSubsystem/Template.hs b/libs/wire-subsystems/src/Wire/EmailSubsystem/Template.hs similarity index 99% rename from libs/wire-subsystems/src/Wire/EmailSmsSubsystem/Template.hs rename to libs/wire-subsystems/src/Wire/EmailSubsystem/Template.hs index 60327d0d9c1..9c123e1c0e3 100644 --- a/libs/wire-subsystems/src/Wire/EmailSmsSubsystem/Template.hs +++ b/libs/wire-subsystems/src/Wire/EmailSubsystem/Template.hs @@ -17,7 +17,7 @@ -- You should have received a copy of the GNU Affero General Public License along -- with this program. If not, see . -module Wire.EmailSmsSubsystem.Template +module Wire.EmailSubsystem.Template ( Localised (..), TemplateBranding, forLocale, diff --git a/libs/wire-subsystems/test/unit/Wire/AuthenticationSubsystem/InterpreterSpec.hs b/libs/wire-subsystems/test/unit/Wire/AuthenticationSubsystem/InterpreterSpec.hs index 9781ddf3492..39dda77c340 100644 --- a/libs/wire-subsystems/test/unit/Wire/AuthenticationSubsystem/InterpreterSpec.hs +++ b/libs/wire-subsystems/test/unit/Wire/AuthenticationSubsystem/InterpreterSpec.hs @@ -24,7 +24,7 @@ import Wire.API.User.Auth import Wire.API.User.Password import Wire.AuthenticationSubsystem import Wire.AuthenticationSubsystem.Interpreter -import Wire.EmailSmsSubsystem +import Wire.EmailSubsystem import Wire.HashPassword import Wire.MockInterpreters import Wire.PasswordResetCodeStore @@ -49,7 +49,7 @@ type AllEffects = PasswordResetCodeStore, State (Map PasswordResetKey (PRQueryData Identity)), TinyLog, - EmailSmsSubsystem, + EmailSubsystem, State (Map Email [SentMail]), UserSubsystem ] @@ -59,7 +59,7 @@ interpretDependencies localDomain preexistingUsers preexistingPasswords mAllowed run . userSubsystemTestInterpreter preexistingUsers . evalState mempty - . emailSmsSubsystemInterpreter + . emailSubsystemInterpreter . discardTinyLogs . evalState mempty . inMemoryPasswordResetCodeStore diff --git a/libs/wire-subsystems/test/unit/Wire/MockInterpreters.hs b/libs/wire-subsystems/test/unit/Wire/MockInterpreters.hs index 2d17f23096b..9145369b703 100644 --- a/libs/wire-subsystems/test/unit/Wire/MockInterpreters.hs +++ b/libs/wire-subsystems/test/unit/Wire/MockInterpreters.hs @@ -3,7 +3,7 @@ module Wire.MockInterpreters (module MockInterpreters) where -- Run this from project root to generate the imports: -- ls libs/wire-subsystems/test/unit/Wire/MockInterpreters | sed 's|\(.*\)\.hs|import Wire.MockInterpreters.\1 as MockInterpreters|' -import Wire.MockInterpreters.EmailSmsSubsystem as MockInterpreters +import Wire.MockInterpreters.EmailSubsystem as MockInterpreters import Wire.MockInterpreters.Error as MockInterpreters import Wire.MockInterpreters.GalleyAPIAccess as MockInterpreters import Wire.MockInterpreters.HashPassword as MockInterpreters diff --git a/libs/wire-subsystems/test/unit/Wire/MockInterpreters/EmailSmsSubsystem.hs b/libs/wire-subsystems/test/unit/Wire/MockInterpreters/EmailSubsystem.hs similarity index 65% rename from libs/wire-subsystems/test/unit/Wire/MockInterpreters/EmailSmsSubsystem.hs rename to libs/wire-subsystems/test/unit/Wire/MockInterpreters/EmailSubsystem.hs index af38731ed23..57c9fac0c9e 100644 --- a/libs/wire-subsystems/test/unit/Wire/MockInterpreters/EmailSmsSubsystem.hs +++ b/libs/wire-subsystems/test/unit/Wire/MockInterpreters/EmailSubsystem.hs @@ -1,11 +1,11 @@ -module Wire.MockInterpreters.EmailSmsSubsystem where +module Wire.MockInterpreters.EmailSubsystem where import Data.Map qualified as Map import Imports import Polysemy import Polysemy.State import Wire.API.User -import Wire.EmailSmsSubsystem +import Wire.EmailSubsystem data SentMail = SentMail { locale :: Maybe Locale, @@ -16,10 +16,10 @@ data SentMail = SentMail data SentMailContent = PasswordResetMail PasswordResetPair deriving (Show, Eq) -emailSmsSubsystemInterpreter :: (Member (State (Map Email [SentMail])) r) => InterpreterFor EmailSmsSubsystem r -emailSmsSubsystemInterpreter = interpret \case +emailSubsystemInterpreter :: (Member (State (Map Email [SentMail])) r) => InterpreterFor EmailSubsystem r +emailSubsystemInterpreter = interpret \case SendPasswordResetMail email keyCodePair mLocale -> modify $ Map.insertWith (<>) email [SentMail mLocale $ PasswordResetMail keyCodePair] - _ -> error "emailSmsSubsystemInterpreter: implement on demand" + _ -> error "emailSubsystemInterpreter: implement on demand" getEmailsSentTo :: (Member (State (Map Email [SentMail])) r) => Email -> Sem r [SentMail] getEmailsSentTo email = gets $ Map.findWithDefault [] email diff --git a/libs/wire-subsystems/wire-subsystems.cabal b/libs/wire-subsystems/wire-subsystems.cabal index a920191c681..a603df5d43f 100644 --- a/libs/wire-subsystems/wire-subsystems.cabal +++ b/libs/wire-subsystems/wire-subsystems.cabal @@ -78,9 +78,9 @@ library Wire.EmailSending Wire.EmailSending.SES Wire.EmailSending.SMTP - Wire.EmailSmsSubsystem - Wire.EmailSmsSubsystem.Interpreter - Wire.EmailSmsSubsystem.Template + Wire.EmailSubsystem + Wire.EmailSubsystem.Interpreter + Wire.EmailSubsystem.Template Wire.Error Wire.FederationAPIAccess Wire.FederationAPIAccess.Interpreter @@ -200,7 +200,7 @@ test-suite wire-subsystems-tests Wire.AuthenticationSubsystem.InterpreterSpec Wire.MiniBackend Wire.MockInterpreters - Wire.MockInterpreters.EmailSmsSubsystem + Wire.MockInterpreters.EmailSubsystem Wire.MockInterpreters.Error Wire.MockInterpreters.GalleyAPIAccess Wire.MockInterpreters.HashPassword diff --git a/services/brig/src/Brig/API/Auth.hs b/services/brig/src/Brig/API/Auth.hs index 018bf2be96b..581876fe0ce 100644 --- a/services/brig/src/Brig/API/Auth.hs +++ b/services/brig/src/Brig/API/Auth.hs @@ -53,7 +53,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.EmailSmsSubsystem (EmailSmsSubsystem) +import Wire.EmailSubsystem (EmailSubsystem) import Wire.GalleyAPIAccess import Wire.NotificationSubsystem import Wire.PasswordStore (PasswordStore) @@ -141,7 +141,7 @@ logout uts (Just at) = Auth.logout (List1 uts) at !>> zauthError changeSelfEmailH :: ( Member BlacklistStore r, Member UserKeyStore r, - Member EmailSmsSubsystem r + Member EmailSubsystem r ) => [Either Text SomeUserToken] -> Maybe (Either Text SomeAccessToken) -> diff --git a/services/brig/src/Brig/API/Client.hs b/services/brig/src/Brig/API/Client.hs index 114a5f2c4ab..e4511fae9a1 100644 --- a/services/brig/src/Brig/API/Client.hs +++ b/services/brig/src/Brig/API/Client.hs @@ -108,7 +108,7 @@ import Wire.API.User.Client.Prekey import Wire.API.UserEvent import Wire.API.UserMap (QualifiedUserMap (QualifiedUserMap, qualifiedUserMap), UserMap (userMap)) import Wire.DeleteQueue -import Wire.EmailSmsSubsystem (EmailSmsSubsystem, sendNewClientEmail) +import Wire.EmailSubsystem (EmailSubsystem, sendNewClientEmail) import Wire.GalleyAPIAccess (GalleyAPIAccess) import Wire.GalleyAPIAccess qualified as GalleyAPIAccess import Wire.NotificationSubsystem @@ -170,7 +170,7 @@ addClient :: Member (Input (Local ())) r, Member (Input UTCTime) r, Member (ConnectionStore InternalPaging) r, - Member EmailSmsSubsystem r, + Member EmailSubsystem r, Member VerificationCodeSubsystem r ) => UserId -> @@ -191,7 +191,7 @@ addClientWithReAuthPolicy :: Member (Input UTCTime) r, Member DeleteQueue r, Member (ConnectionStore InternalPaging) r, - Member EmailSmsSubsystem r, + Member EmailSubsystem r, Member VerificationCodeSubsystem r ) => Data.ReAuthPolicy -> diff --git a/services/brig/src/Brig/API/Internal.hs b/services/brig/src/Brig/API/Internal.hs index 1fb6a157040..1e05d13e6cf 100644 --- a/services/brig/src/Brig/API/Internal.hs +++ b/services/brig/src/Brig/API/Internal.hs @@ -102,7 +102,7 @@ import Wire.API.UserEvent import Wire.AuthenticationSubsystem (AuthenticationSubsystem) import Wire.DeleteQueue import Wire.EmailSending (EmailSending) -import Wire.EmailSmsSubsystem (EmailSmsSubsystem) +import Wire.EmailSubsystem (EmailSubsystem) import Wire.GalleyAPIAccess (GalleyAPIAccess, ShowOrHideInvitationUrl (..)) import Wire.NotificationSubsystem import Wire.Rpc @@ -136,7 +136,7 @@ servantSitemap :: Member TinyLog r, Member (UserPendingActivationStore p) r, Member EmailSending r, - Member EmailSmsSubsystem r, + Member EmailSubsystem r, Member VerificationCodeSubsystem r ) => ServerT BrigIRoutes.API (Handler r) @@ -186,7 +186,7 @@ accountAPI :: Member (Input (Local ())) r, Member (Input UTCTime) r, Member (ConnectionStore InternalPaging) r, - Member EmailSmsSubsystem r, + Member EmailSubsystem r, Member VerificationCodeSubsystem r ) => ServerT BrigIRoutes.AccountAPI (Handler r) @@ -403,7 +403,7 @@ addClientInternalH :: Member (Input (Local ())) r, Member (Input UTCTime) r, Member (ConnectionStore InternalPaging) r, - Member EmailSmsSubsystem r, + Member EmailSubsystem r, Member VerificationCodeSubsystem r ) => UserId -> @@ -524,14 +524,14 @@ deleteUserNoAuthH uid = do AccountAlreadyDeleted -> pure UserResponseAccountAlreadyDeleted AccountDeleted -> pure UserResponseAccountDeleted -changeSelfEmailMaybeSendH :: (Member BlacklistStore r, Member UserKeyStore r, Member EmailSmsSubsystem r) => UserId -> EmailUpdate -> Maybe Bool -> (Handler r) ChangeEmailResponse +changeSelfEmailMaybeSendH :: (Member BlacklistStore r, Member UserKeyStore r, Member EmailSubsystem r) => UserId -> EmailUpdate -> Maybe Bool -> (Handler r) ChangeEmailResponse changeSelfEmailMaybeSendH u body (fromMaybe False -> validate) = do let email = euEmail body changeSelfEmailMaybeSend u (if validate then ActuallySendEmail else DoNotSendEmail) email UpdateOriginScim data MaybeSendEmail = ActuallySendEmail | DoNotSendEmail -changeSelfEmailMaybeSend :: (Member BlacklistStore r, Member UserKeyStore r, Member EmailSmsSubsystem r) => UserId -> MaybeSendEmail -> Email -> UpdateOriginType -> (Handler r) ChangeEmailResponse +changeSelfEmailMaybeSend :: (Member BlacklistStore r, Member UserKeyStore r, Member EmailSubsystem r) => UserId -> MaybeSendEmail -> Email -> UpdateOriginType -> (Handler r) ChangeEmailResponse changeSelfEmailMaybeSend u ActuallySendEmail email allowScim = do API.changeSelfEmail u email allowScim changeSelfEmailMaybeSend u DoNotSendEmail email allowScim = do diff --git a/services/brig/src/Brig/API/Public.hs b/services/brig/src/Brig/API/Public.hs index c10860e9189..e468afda8af 100644 --- a/services/brig/src/Brig/API/Public.hs +++ b/services/brig/src/Brig/API/Public.hs @@ -154,7 +154,7 @@ import Wire.API.Wrapped qualified as Public import Wire.AuthenticationSubsystem (AuthenticationSubsystem, createPasswordResetCode, resetPassword) import Wire.DeleteQueue import Wire.EmailSending (EmailSending) -import Wire.EmailSmsSubsystem +import Wire.EmailSubsystem import Wire.Error import Wire.GalleyAPIAccess (GalleyAPIAccess) import Wire.GalleyAPIAccess qualified as GalleyAPIAccess @@ -305,7 +305,7 @@ servantSitemap :: Member SFT r, Member TinyLog r, Member (UserPendingActivationStore p) r, - Member EmailSmsSubsystem r, + Member EmailSubsystem r, Member EmailSending r, Member VerificationCodeSubsystem r ) => @@ -618,7 +618,7 @@ addClient :: Member (Input (Local ())) r, Member (Input UTCTime) r, Member (ConnectionStore InternalPaging) r, - Member EmailSmsSubsystem r, + Member EmailSubsystem r, Member VerificationCodeSubsystem r ) => UserId -> @@ -749,7 +749,7 @@ createUser :: Member (Input (Local ())) r, Member (Input UTCTime) r, Member (ConnectionStore InternalPaging) r, - Member EmailSmsSubsystem r, + Member EmailSubsystem r, Member EmailSending r ) => Public.NewUserPublic -> @@ -804,7 +804,7 @@ createUser (Public.NewUserPublic new) = lift . runExceptT $ do -- pure $ CreateUserResponse cok userId (Public.SelfProfile usr) pure $ Public.RegisterSuccess cok (Public.SelfProfile usr) where - sendActivationEmail :: (Member EmailSmsSubsystem r) => Public.Email -> Public.Name -> ActivationPair -> Maybe Public.Locale -> Maybe Public.NewTeamUser -> (AppT r) () + sendActivationEmail :: (Member EmailSubsystem r) => Public.Email -> Public.Name -> ActivationPair -> Maybe Public.Locale -> Maybe Public.NewTeamUser -> (AppT r) () sendActivationEmail email name (key, code) locale mTeamUser | Just teamUser <- mTeamUser, Public.NewTeamCreator creator <- teamUser, @@ -1071,7 +1071,7 @@ completePasswordReset req = do -- docs/reference/user/registration.md {#RefRegistration} sendActivationCode :: ( Member BlacklistStore r, - Member EmailSmsSubsystem r, + Member EmailSubsystem r, Member GalleyAPIAccess r, Member UserKeyStore r ) => @@ -1236,7 +1236,7 @@ deleteSelfUser :: Member (Input (Local ())) r, Member (Input UTCTime) r, Member (ConnectionStore InternalPaging) r, - Member EmailSmsSubsystem r, + Member EmailSubsystem r, Member VerificationCodeSubsystem r ) => UserId -> @@ -1265,7 +1265,7 @@ updateUserEmail :: ( Member BlacklistStore r, Member UserKeyStore r, Member GalleyAPIAccess r, - Member EmailSmsSubsystem r + Member EmailSubsystem r ) => UserId -> UserId -> @@ -1338,7 +1338,7 @@ sendVerificationCode :: forall r. ( Member GalleyAPIAccess r, Member UserKeyStore r, - Member EmailSmsSubsystem r, + Member EmailSubsystem r, Member VerificationCodeSubsystem r ) => Public.SendVerificationCode -> diff --git a/services/brig/src/Brig/API/User.hs b/services/brig/src/Brig/API/User.hs index 6f10a8e0790..0e820430a54 100644 --- a/services/brig/src/Brig/API/User.hs +++ b/services/brig/src/Brig/API/User.hs @@ -147,7 +147,7 @@ import Wire.API.User.RichInfo import Wire.API.UserEvent import Wire.AuthenticationSubsystem (AuthenticationSubsystem, internalLookupPasswordResetCode) import Wire.DeleteQueue -import Wire.EmailSmsSubsystem +import Wire.EmailSubsystem import Wire.Error import Wire.GalleyAPIAccess as GalleyAPIAccess import Wire.NotificationSubsystem @@ -562,7 +562,7 @@ changeManagedBy uid conn (ManagedByUpdate mb) = do -- | Call 'changeEmail' and process result: if email changes to itself, succeed, if not, send -- validation email. -changeSelfEmail :: (Member BlacklistStore r, Member UserKeyStore r, Member EmailSmsSubsystem r) => UserId -> Email -> UpdateOriginType -> ExceptT HttpError (AppT r) ChangeEmailResponse +changeSelfEmail :: (Member BlacklistStore r, Member UserKeyStore r, Member EmailSubsystem r) => UserId -> Email -> UpdateOriginType -> ExceptT HttpError (AppT r) ChangeEmailResponse changeSelfEmail u email allowScim = do changeEmail u email allowScim !>> Error.changeEmailError >>= \case ChangeEmailIdempotent -> @@ -805,7 +805,7 @@ onActivated (EmailActivated uid email) = do -- docs/reference/user/activation.md {#RefActivationRequest} sendActivationCode :: ( Member BlacklistStore r, - Member EmailSmsSubsystem r, + Member EmailSubsystem r, Member GalleyAPIAccess r, Member UserKeyStore r ) => @@ -926,7 +926,7 @@ deleteSelfUser :: Member UserStore r, Member (Input UTCTime) r, Member (ConnectionStore InternalPaging) r, - Member EmailSmsSubsystem r, + Member EmailSubsystem r, Member VerificationCodeSubsystem r ) => UserId -> diff --git a/services/brig/src/Brig/App.hs b/services/brig/src/Brig/App.hs index 4f8d67e3a7e..9d475b37262 100644 --- a/services/brig/src/Brig/App.hs +++ b/services/brig/src/Brig/App.hs @@ -153,7 +153,7 @@ import Wire.API.Locale (Locale) import Wire.API.Routes.Version import Wire.API.User.Identity (Email) import Wire.EmailSending.SMTP qualified as SMTP -import Wire.EmailSmsSubsystem.Template (TemplateBranding, forLocale) +import Wire.EmailSubsystem.Template (TemplateBranding, forLocale) import Wire.SessionStore import Wire.SessionStore.Cassandra import Wire.UserKeyStore diff --git a/services/brig/src/Brig/CanonicalInterpreter.hs b/services/brig/src/Brig/CanonicalInterpreter.hs index d9e69961f19..13158e6f03d 100644 --- a/services/brig/src/Brig/CanonicalInterpreter.hs +++ b/services/brig/src/Brig/CanonicalInterpreter.hs @@ -40,8 +40,8 @@ import Wire.DeleteQueue import Wire.EmailSending import Wire.EmailSending.SES import Wire.EmailSending.SMTP -import Wire.EmailSmsSubsystem -import Wire.EmailSmsSubsystem.Interpreter +import Wire.EmailSubsystem +import Wire.EmailSubsystem.Interpreter import Wire.Error import Wire.FederationAPIAccess qualified import Wire.FederationAPIAccess.Interpreter (FederationAPIAccessConfig (..), interpretFederationAPIAccess) @@ -85,7 +85,7 @@ import Wire.VerificationCodeSubsystem.Interpreter type BrigCanonicalEffects = '[ AuthenticationSubsystem, UserSubsystem, - EmailSmsSubsystem, + EmailSubsystem, VerificationCodeSubsystem, DeleteQueue, UserEvents, @@ -197,7 +197,7 @@ runBrigToIO e (AppT ma) = do . runUserEvents . runDeleteQueue (e ^. internalEvents) . interpretVerificationCodeSubsystem - . emailSmsSubsystemInterpreter (e ^. usrTemplates) (e ^. templateBranding) + . emailSubsystemInterpreter (e ^. usrTemplates) (e ^. templateBranding) . runUserSubsystem userSubsystemConfig . interpretAuthenticationSubsystem ) diff --git a/services/brig/src/Brig/Provider/Email.hs b/services/brig/src/Brig/Provider/Email.hs index 0f0097bf0b2..1b8f329c240 100644 --- a/services/brig/src/Brig/Provider/Email.hs +++ b/services/brig/src/Brig/Provider/Email.hs @@ -41,8 +41,8 @@ import Polysemy import Wire.API.Provider import Wire.API.User import Wire.EmailSending -import Wire.EmailSmsSubsystem.Interpreter (mkMimeAddress) -import Wire.EmailSmsSubsystem.Template (TemplateBranding, renderHtmlWithBranding, renderTextWithBranding) +import Wire.EmailSubsystem.Interpreter (mkMimeAddress) +import Wire.EmailSubsystem.Template (TemplateBranding, renderHtmlWithBranding, renderTextWithBranding) ------------------------------------------------------------------------------- -- Activation Email diff --git a/services/brig/src/Brig/Provider/Template.hs b/services/brig/src/Brig/Provider/Template.hs index 5de44d0a77c..951ff9add7e 100644 --- a/services/brig/src/Brig/Provider/Template.hs +++ b/services/brig/src/Brig/Provider/Template.hs @@ -36,7 +36,7 @@ import Data.Misc (HttpsUrl) import Data.Text.Encoding (encodeUtf8) import Imports import Wire.API.User.Identity -import Wire.EmailSmsSubsystem.Template +import Wire.EmailSubsystem.Template data ProviderTemplates = ProviderTemplates { activationEmail :: !ActivationEmailTemplate, diff --git a/services/brig/src/Brig/Team/DB.hs b/services/brig/src/Brig/Team/DB.hs index b4129349417..a31875142c1 100644 --- a/services/brig/src/Brig/Team/DB.hs +++ b/services/brig/src/Brig/Team/DB.hs @@ -61,7 +61,7 @@ import UnliftIO.Async (pooledMapConcurrentlyN_) import Wire.API.Team.Invitation hiding (HeadInvitationByEmailResult (..)) import Wire.API.Team.Role import Wire.API.User -import Wire.EmailSmsSubsystem.Template (renderTextWithBranding) +import Wire.EmailSubsystem.Template (renderTextWithBranding) import Wire.GalleyAPIAccess (ShowOrHideInvitationUrl (..)) mkInvitationCode :: IO InvitationCode diff --git a/services/brig/src/Brig/Team/Email.hs b/services/brig/src/Brig/Team/Email.hs index 837dfa5108a..07b38e1a57b 100644 --- a/services/brig/src/Brig/Team/Email.hs +++ b/services/brig/src/Brig/Team/Email.hs @@ -38,7 +38,7 @@ import Network.Mail.Mime import Polysemy import Wire.API.User import Wire.EmailSending -import Wire.EmailSmsSubsystem.Template (TemplateBranding, renderHtmlWithBranding, renderTextWithBranding) +import Wire.EmailSubsystem.Template (TemplateBranding, renderHtmlWithBranding, renderTextWithBranding) ------------------------------------------------------------------------------- -- Invitation Email diff --git a/services/brig/src/Brig/Template.hs b/services/brig/src/Brig/Template.hs index 4295aa5c709..906f395d8ef 100644 --- a/services/brig/src/Brig/Template.hs +++ b/services/brig/src/Brig/Template.hs @@ -44,7 +44,7 @@ import Data.Text.Template (Template, template) import Imports hiding (readFile) import System.IO.Error (isDoesNotExistError) import Wire.API.User -import Wire.EmailSmsSubsystem.Template (Localised (Localised)) +import Wire.EmailSubsystem.Template (Localised (Localised)) -- | See 'genTemplateBranding'. type TemplateBranding = Text -> Text diff --git a/services/brig/src/Brig/User/Template.hs b/services/brig/src/Brig/User/Template.hs index fb035d90339..0667a4b2cd2 100644 --- a/services/brig/src/Brig/User/Template.hs +++ b/services/brig/src/Brig/User/Template.hs @@ -40,7 +40,7 @@ where import Brig.Options qualified as Opt import Brig.Template import Imports -import Wire.EmailSmsSubsystem.Template +import Wire.EmailSubsystem.Template loadUserTemplates :: Opt.Opts -> IO (Localised UserTemplates) loadUserTemplates o = readLocalesDir defLocale templateDir "user" $ \fp -> From b85a01894f3a140547be884a57614b72e64bbb09 Mon Sep 17 00:00:00 2001 From: Zebot Date: Mon, 8 Jul 2024 09:28:11 +0000 Subject: [PATCH 63/64] Add changelog for Release 2024-07-08 --- CHANGELOG.md | 151 ++++++++++++++++++ .../0-release-notes/remove-phone-support.md | 4 - .../remove-internal-phone-endpoints.md | 10 -- changelog.d/2-features/WPB-2690-coturn-drain | 1 - changelog.d/2-features/WPB-6954 | 1 - changelog.d/2-features/WPB-8824 | 1 - changelog.d/2-features/WPB-9871 | 1 - changelog.d/2-features/coturn-params | 1 - .../2-features/email-templates-v1.0.110 | 1 - changelog.d/2-features/rabbit-tls | 1 - changelog.d/2-features/redis-tls | 20 --- changelog.d/3-bug-fixes/WBP-9677 | 1 - changelog.d/3-bug-fixes/WPB-5491 | 1 - changelog.d/3-bug-fixes/WPB-8890 | 1 - .../3-bug-fixes/WPB-9488-fix-update-origin | 1 - changelog.d/3-bug-fixes/WPB-9685 | 1 - .../3-bug-fixes/WPB-9708-scim-gc-logic | 1 - .../3-bug-fixes/expose-provider-assets | 1 - .../3-bug-fixes/federator-client-cert-chain | 3 - .../filter-duplicates-when-resending-props | 1 - changelog.d/3-bug-fixes/redis | 1 - changelog.d/3-bug-fixes/repeated-rtsopts | 1 - changelog.d/3-bug-fixes/request-id-logging | 1 - changelog.d/3-bug-fixes/tmp-pid | 1 - .../3-bug-fixes/wpb9362-lh-logic-glitch | 1 - changelog.d/4-docs/WPB-7036 | 1 - changelog.d/5-internal/WBP7005 | 1 - changelog.d/5-internal/WPB-6442 | 1 - changelog.d/5-internal/WPB-8757 | 1 - changelog.d/5-internal/WPB-8880 | 1 - changelog.d/5-internal/WPB-8890-subsystems | 1 - changelog.d/5-internal/WPB-8943 | 1 - changelog.d/5-internal/WPB-9495 | 1 - changelog.d/5-internal/WPB-9667-weeder | 1 - .../5-internal/WPB-9831-email-subsystem | 1 - .../cabal-project-local-improvements | 1 - changelog.d/5-internal/elasticsearch | 1 - changelog.d/5-internal/federator-metrics | 1 - .../5-internal/federator-simplification | 3 - .../k8ssandra-test-cluster-chart-variables | 1 - changelog.d/5-internal/make-handle-abstract | 1 - changelog.d/5-internal/metrics-core | 1 - changelog.d/5-internal/more-metadata-in-meta | 1 - .../5-internal/reduce-thread-killed-log-noise | 1 - .../5-internal/verification-code-subsystem | 1 - changelog.d/5-internal/wpb-6350 | 1 - 46 files changed, 151 insertions(+), 80 deletions(-) delete mode 100644 changelog.d/0-release-notes/remove-phone-support.md delete mode 100644 changelog.d/1-api-changes/remove-internal-phone-endpoints.md delete mode 100644 changelog.d/2-features/WPB-2690-coturn-drain delete mode 100644 changelog.d/2-features/WPB-6954 delete mode 100644 changelog.d/2-features/WPB-8824 delete mode 100644 changelog.d/2-features/WPB-9871 delete mode 100644 changelog.d/2-features/coturn-params delete mode 100644 changelog.d/2-features/email-templates-v1.0.110 delete mode 100644 changelog.d/2-features/rabbit-tls delete mode 100644 changelog.d/2-features/redis-tls delete mode 100644 changelog.d/3-bug-fixes/WBP-9677 delete mode 100644 changelog.d/3-bug-fixes/WPB-5491 delete mode 100644 changelog.d/3-bug-fixes/WPB-8890 delete mode 100644 changelog.d/3-bug-fixes/WPB-9488-fix-update-origin delete mode 100644 changelog.d/3-bug-fixes/WPB-9685 delete mode 100644 changelog.d/3-bug-fixes/WPB-9708-scim-gc-logic delete mode 100644 changelog.d/3-bug-fixes/expose-provider-assets delete mode 100644 changelog.d/3-bug-fixes/federator-client-cert-chain delete mode 100644 changelog.d/3-bug-fixes/filter-duplicates-when-resending-props delete mode 100644 changelog.d/3-bug-fixes/redis delete mode 100644 changelog.d/3-bug-fixes/repeated-rtsopts delete mode 100644 changelog.d/3-bug-fixes/request-id-logging delete mode 100644 changelog.d/3-bug-fixes/tmp-pid delete mode 100644 changelog.d/3-bug-fixes/wpb9362-lh-logic-glitch delete mode 100644 changelog.d/4-docs/WPB-7036 delete mode 100644 changelog.d/5-internal/WBP7005 delete mode 100644 changelog.d/5-internal/WPB-6442 delete mode 100644 changelog.d/5-internal/WPB-8757 delete mode 100644 changelog.d/5-internal/WPB-8880 delete mode 100644 changelog.d/5-internal/WPB-8890-subsystems delete mode 100644 changelog.d/5-internal/WPB-8943 delete mode 100644 changelog.d/5-internal/WPB-9495 delete mode 100644 changelog.d/5-internal/WPB-9667-weeder delete mode 100644 changelog.d/5-internal/WPB-9831-email-subsystem delete mode 100644 changelog.d/5-internal/cabal-project-local-improvements delete mode 100644 changelog.d/5-internal/elasticsearch delete mode 100644 changelog.d/5-internal/federator-metrics delete mode 100644 changelog.d/5-internal/federator-simplification delete mode 100644 changelog.d/5-internal/k8ssandra-test-cluster-chart-variables delete mode 100644 changelog.d/5-internal/make-handle-abstract delete mode 100644 changelog.d/5-internal/metrics-core delete mode 100644 changelog.d/5-internal/more-metadata-in-meta delete mode 100644 changelog.d/5-internal/reduce-thread-killed-log-noise delete mode 100644 changelog.d/5-internal/verification-code-subsystem delete mode 100644 changelog.d/5-internal/wpb-6350 diff --git a/CHANGELOG.md b/CHANGELOG.md index b5b8da28b1a..16fbd73b4aa 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,154 @@ +# [2024-07-08] (Chart Release 5.4.0) + +## Release notes + + +* Phone registration and login is not supported anymore. All API endpoints dealing with phone numbers and phone activation codes now fail with a 400 error. Brig options related to phone number support have now been deleted, namely: + - `setTwilio` + - `setNexmo` + - `setAllowlistPhonePrefixes`. (#4045) + + +## API changes + + +* Internal API endpoints related to phone numbers have been removed. + + In brig: + - `iGetPhonePrefix` + - `iDeletePhonePrefix` + - `iPostPhonePrefix`. + + In stern: + - `get-users-by-phone` + - `put-phone`. (#4045) + + +## Features + + +* charts/coturn: support putting coturn into 'drain' mode when terminating pods, denying new incoming client connections. This speeds up graceful coturn restarts significantly. (#4098) + +* Set SFT usernames's `shared` field according to team settings (#4117) + +* Updated the `mlsE2EId` feature config with two additional fields `crlProxy` and `useProxyOnMobile` (#4051) + +* reject MLS messages for future epochs (#4110) + +* Introduce more configuration options to the `coturn` helm chart (#4083) + +* Update email templates to v1.0.121. (#4064) + +* Support connecting to RabbitMQ over TLS. See "Configure RabbitMQ" section in the documentation for details. (#4094) + +* Support connecting to Redis over TLS + + It can be enabled by setting these options on the wire-server helm chart: + + ```yaml + gundeck: + config: + redis: + enableTls: true + + # When custom CAs are required, one of these must be set: + tlsCa: + tlsCaSecretRef: + name: + key: + + # When TLS needs to be used without verification: + insecureSkipVerifyTls: true + ``` + (#4016) + + +## Bug fixes and other updates + + +* fixed stern endpoint `/i/users/meta-info` (#4101) + +* Log password reset errors instead of propagating them (#4114) + +* Log request ids in brig. (#4086) + +* Do not set update origin "scim" in public brig api. (#4072) + +* Disabling legalhold before user's approval doesn't result in an error (#4104) + +* Make scim-delete-user idempotent. Hide information about existing users (make delete idempotent) (#4120) + +* Expose /providers/assets via nginz (#4082) + +* federator: Expect a client certificate to be the certificate chain + + Without this openssl doesn't forward to whole chain causing mTLS to not succeed. (#4089) + +* Only resend proposals once after external commit (#4103) + +* gundeck: Better tolerance for redis-cluster restarts (#4084) + +* GHC does not support repeated --with-rtsopts options, and it simply applies the last one. This means many of the baked-in options were actually not being passed, including -N for some of the services and -T for cannon. (#4118) + +* Ensure that a Request ID is logged whenever unexpected errors are caught in any service (#4059) + +* charts/coturn: use allowed dir to write PID file (#4098) + +* Make pending LH requests (with no LH devices listening yet) not throw LH policy errors. This helps eg. in cases where a LH request is issued to the wrong user by accident, and the user can clear up the mistake. (#4056) + + +## Documentation + + +* Adjust documentation for migrated helm charts (#4058) + + +## Internal changes + + +* Adapt EJPD data to current requirements. (#3945) + +* Port team feature tests to the `integration` package (#4063) + +* Ported flaky legalhold test to the new integration test suite (#4057) + +* Added profile update operations to the user subsystem. (#4046) + +* Introduce authentication subsystem with password reset. (#4086) + +* update nixpkgs and hence GHC version as well as some other tooling. (#4071) + +* nginz: Added `allowlisted_fqdn_origins` to `nginx_conf` value (#4087) + +* Add weeder for dead code elimination. (#4088) + +* Introduce email subsystem (#4111) + +* replace cabal.project.local template and update cabal.project (#4119) + +* Add HTTP proxy in the local setup for elasticsearch in federation-v0. This makes it possible to use a single elasticsearch instance for both the main backends and federation-v0. (#4062) + +* federator: Add metrics for garbage collections and unexpected errors that were caught (#4085) + +* federator: Simplify polysemy setup to make it similar to other services so the + interpreter is only used for hoisting the servant application and not explicitly + inside handler of an endpoint (#4059) + +* Added prometheus enable and datacenter size variables for k8ssandra-test-cluster helm chart. (#4011) + +* Make `Handle` type abstract to guarantee it always contains *valid* Handles. (#4076) + +* metrics-core: Delete `Data.Metrics` in favour of defining metrics closer to where they are being emitted (#4085) + +* add more metadata into the meta attribute of all nix derivations produced locally (#4069) + +* Do not log anything when warp kills a worker thread. (#4112) + +* Introduce VerificationCodSubsystem (#4121) + +* add tests for bots that use self-signed certs and add documentation on why we cannot test the bots to work with PKI (#4027) + + # [2024-05-21] (Chart Release 5.3.0) ## API changes diff --git a/changelog.d/0-release-notes/remove-phone-support.md b/changelog.d/0-release-notes/remove-phone-support.md deleted file mode 100644 index 609832ac624..00000000000 --- a/changelog.d/0-release-notes/remove-phone-support.md +++ /dev/null @@ -1,4 +0,0 @@ -Phone registration and login is not supported anymore. All API endpoints dealing with phone numbers and phone activation codes now fail with a 400 error. Brig options related to phone number support have now been deleted, namely: - - `setTwilio` - - `setNexmo` - - `setAllowlistPhonePrefixes`. diff --git a/changelog.d/1-api-changes/remove-internal-phone-endpoints.md b/changelog.d/1-api-changes/remove-internal-phone-endpoints.md deleted file mode 100644 index ed80d0eca54..00000000000 --- a/changelog.d/1-api-changes/remove-internal-phone-endpoints.md +++ /dev/null @@ -1,10 +0,0 @@ -Internal API endpoints related to phone numbers have been removed. - -In brig: -- `iGetPhonePrefix` -- `iDeletePhonePrefix` -- `iPostPhonePrefix`. - -In stern: -- `get-users-by-phone` -- `put-phone`. diff --git a/changelog.d/2-features/WPB-2690-coturn-drain b/changelog.d/2-features/WPB-2690-coturn-drain deleted file mode 100644 index f805466c3c5..00000000000 --- a/changelog.d/2-features/WPB-2690-coturn-drain +++ /dev/null @@ -1 +0,0 @@ -charts/coturn: support putting coturn into 'drain' mode when terminating pods, denying new incoming client connections. This speeds up graceful coturn restarts significantly. diff --git a/changelog.d/2-features/WPB-6954 b/changelog.d/2-features/WPB-6954 deleted file mode 100644 index b2208e9d728..00000000000 --- a/changelog.d/2-features/WPB-6954 +++ /dev/null @@ -1 +0,0 @@ -Set SFT usernames's `shared` field according to team settings diff --git a/changelog.d/2-features/WPB-8824 b/changelog.d/2-features/WPB-8824 deleted file mode 100644 index e93a613602f..00000000000 --- a/changelog.d/2-features/WPB-8824 +++ /dev/null @@ -1 +0,0 @@ -Updated the `mlsE2EId` feature config with two additional fields `crlProxy` and `useProxyOnMobile` diff --git a/changelog.d/2-features/WPB-9871 b/changelog.d/2-features/WPB-9871 deleted file mode 100644 index cf474cbd534..00000000000 --- a/changelog.d/2-features/WPB-9871 +++ /dev/null @@ -1 +0,0 @@ -reject MLS messages for future epochs diff --git a/changelog.d/2-features/coturn-params b/changelog.d/2-features/coturn-params deleted file mode 100644 index ceab29645df..00000000000 --- a/changelog.d/2-features/coturn-params +++ /dev/null @@ -1 +0,0 @@ -Introduce more configuration options to the `coturn` helm chart diff --git a/changelog.d/2-features/email-templates-v1.0.110 b/changelog.d/2-features/email-templates-v1.0.110 deleted file mode 100644 index d8807d1328a..00000000000 --- a/changelog.d/2-features/email-templates-v1.0.110 +++ /dev/null @@ -1 +0,0 @@ -Update email templates to v1.0.121. diff --git a/changelog.d/2-features/rabbit-tls b/changelog.d/2-features/rabbit-tls deleted file mode 100644 index 21114d011dd..00000000000 --- a/changelog.d/2-features/rabbit-tls +++ /dev/null @@ -1 +0,0 @@ -Support connecting to RabbitMQ over TLS. See "Configure RabbitMQ" section in the documentation for details. diff --git a/changelog.d/2-features/redis-tls b/changelog.d/2-features/redis-tls deleted file mode 100644 index d2823f0cf1e..00000000000 --- a/changelog.d/2-features/redis-tls +++ /dev/null @@ -1,20 +0,0 @@ -Support connecting to Redis over TLS - -It can be enabled by setting these options on the wire-server helm chart: - -```yaml -gundeck: - config: - redis: - enableTls: true - - # When custom CAs are required, one of these must be set: - tlsCa: - tlsCaSecretRef: - name: - key: - - # When TLS needs to be used without verification: - insecureSkipVerifyTls: true -``` -(##) diff --git a/changelog.d/3-bug-fixes/WBP-9677 b/changelog.d/3-bug-fixes/WBP-9677 deleted file mode 100644 index d769d8c7458..00000000000 --- a/changelog.d/3-bug-fixes/WBP-9677 +++ /dev/null @@ -1 +0,0 @@ -fixed stern endpoint `/i/users/meta-info` diff --git a/changelog.d/3-bug-fixes/WPB-5491 b/changelog.d/3-bug-fixes/WPB-5491 deleted file mode 100644 index 4e1a919a248..00000000000 --- a/changelog.d/3-bug-fixes/WPB-5491 +++ /dev/null @@ -1 +0,0 @@ -Log password reset errors instead of propagating them diff --git a/changelog.d/3-bug-fixes/WPB-8890 b/changelog.d/3-bug-fixes/WPB-8890 deleted file mode 100644 index f462e51abe5..00000000000 --- a/changelog.d/3-bug-fixes/WPB-8890 +++ /dev/null @@ -1 +0,0 @@ -Log request ids in brig. diff --git a/changelog.d/3-bug-fixes/WPB-9488-fix-update-origin b/changelog.d/3-bug-fixes/WPB-9488-fix-update-origin deleted file mode 100644 index c22e8f3ff7d..00000000000 --- a/changelog.d/3-bug-fixes/WPB-9488-fix-update-origin +++ /dev/null @@ -1 +0,0 @@ -Do not set update origin "scim" in public brig api. diff --git a/changelog.d/3-bug-fixes/WPB-9685 b/changelog.d/3-bug-fixes/WPB-9685 deleted file mode 100644 index ba18992bbd5..00000000000 --- a/changelog.d/3-bug-fixes/WPB-9685 +++ /dev/null @@ -1 +0,0 @@ -Disabling legalhold before user's approval doesn't result in an error diff --git a/changelog.d/3-bug-fixes/WPB-9708-scim-gc-logic b/changelog.d/3-bug-fixes/WPB-9708-scim-gc-logic deleted file mode 100644 index 42a461c408e..00000000000 --- a/changelog.d/3-bug-fixes/WPB-9708-scim-gc-logic +++ /dev/null @@ -1 +0,0 @@ -Make scim-delete-user idempotent. Hide information about existing users (make delete idempotent) \ No newline at end of file diff --git a/changelog.d/3-bug-fixes/expose-provider-assets b/changelog.d/3-bug-fixes/expose-provider-assets deleted file mode 100644 index b23a510bfd8..00000000000 --- a/changelog.d/3-bug-fixes/expose-provider-assets +++ /dev/null @@ -1 +0,0 @@ -Expose /providers/assets via nginz \ No newline at end of file diff --git a/changelog.d/3-bug-fixes/federator-client-cert-chain b/changelog.d/3-bug-fixes/federator-client-cert-chain deleted file mode 100644 index b05a5385ef6..00000000000 --- a/changelog.d/3-bug-fixes/federator-client-cert-chain +++ /dev/null @@ -1,3 +0,0 @@ -federator: Expect a client certificate to be the certificate chain - -Without this openssl doesn't forward to whole chain causing mTLS to not succeed. \ No newline at end of file diff --git a/changelog.d/3-bug-fixes/filter-duplicates-when-resending-props b/changelog.d/3-bug-fixes/filter-duplicates-when-resending-props deleted file mode 100644 index 80b1f8a703a..00000000000 --- a/changelog.d/3-bug-fixes/filter-duplicates-when-resending-props +++ /dev/null @@ -1 +0,0 @@ -Only resend proposals once after external commit diff --git a/changelog.d/3-bug-fixes/redis b/changelog.d/3-bug-fixes/redis deleted file mode 100644 index 06767cd9fe7..00000000000 --- a/changelog.d/3-bug-fixes/redis +++ /dev/null @@ -1 +0,0 @@ -gundeck: Better tolerance for redis-cluster restarts diff --git a/changelog.d/3-bug-fixes/repeated-rtsopts b/changelog.d/3-bug-fixes/repeated-rtsopts deleted file mode 100644 index abd9caa6320..00000000000 --- a/changelog.d/3-bug-fixes/repeated-rtsopts +++ /dev/null @@ -1 +0,0 @@ -GHC does not support repeated --with-rtsopts options, and it simply applies the last one. This means many of the baked-in options were actually not being passed, including -N for some of the services and -T for cannon. diff --git a/changelog.d/3-bug-fixes/request-id-logging b/changelog.d/3-bug-fixes/request-id-logging deleted file mode 100644 index 17d0fea68fc..00000000000 --- a/changelog.d/3-bug-fixes/request-id-logging +++ /dev/null @@ -1 +0,0 @@ -Ensure that a Request ID is logged whenever unexpected errors are caught in any service \ No newline at end of file diff --git a/changelog.d/3-bug-fixes/tmp-pid b/changelog.d/3-bug-fixes/tmp-pid deleted file mode 100644 index f3be4e444a0..00000000000 --- a/changelog.d/3-bug-fixes/tmp-pid +++ /dev/null @@ -1 +0,0 @@ -charts/coturn: use allowed dir to write PID file diff --git a/changelog.d/3-bug-fixes/wpb9362-lh-logic-glitch b/changelog.d/3-bug-fixes/wpb9362-lh-logic-glitch deleted file mode 100644 index ebd0f8e3ce7..00000000000 --- a/changelog.d/3-bug-fixes/wpb9362-lh-logic-glitch +++ /dev/null @@ -1 +0,0 @@ -Make pending LH requests (with no LH devices listening yet) not throw LH policy errors. This helps eg. in cases where a LH request is issued to the wrong user by accident, and the user can clear up the mistake. \ No newline at end of file diff --git a/changelog.d/4-docs/WPB-7036 b/changelog.d/4-docs/WPB-7036 deleted file mode 100644 index 0a261a1dfc9..00000000000 --- a/changelog.d/4-docs/WPB-7036 +++ /dev/null @@ -1 +0,0 @@ -Adjust documentation for migrated helm charts diff --git a/changelog.d/5-internal/WBP7005 b/changelog.d/5-internal/WBP7005 deleted file mode 100644 index 1e85e4457e2..00000000000 --- a/changelog.d/5-internal/WBP7005 +++ /dev/null @@ -1 +0,0 @@ -Adapt EJPD data to current requirements. diff --git a/changelog.d/5-internal/WPB-6442 b/changelog.d/5-internal/WPB-6442 deleted file mode 100644 index efb05804505..00000000000 --- a/changelog.d/5-internal/WPB-6442 +++ /dev/null @@ -1 +0,0 @@ -Port team feature tests to the `integration` package diff --git a/changelog.d/5-internal/WPB-8757 b/changelog.d/5-internal/WPB-8757 deleted file mode 100644 index 55c87d5d8e3..00000000000 --- a/changelog.d/5-internal/WPB-8757 +++ /dev/null @@ -1 +0,0 @@ -Ported flaky legalhold test to the new integration test suite diff --git a/changelog.d/5-internal/WPB-8880 b/changelog.d/5-internal/WPB-8880 deleted file mode 100644 index 3527e5de73b..00000000000 --- a/changelog.d/5-internal/WPB-8880 +++ /dev/null @@ -1 +0,0 @@ -Added profile update operations to the user subsystem. diff --git a/changelog.d/5-internal/WPB-8890-subsystems b/changelog.d/5-internal/WPB-8890-subsystems deleted file mode 100644 index 7e5a1a62024..00000000000 --- a/changelog.d/5-internal/WPB-8890-subsystems +++ /dev/null @@ -1 +0,0 @@ -Introduce authentication subsystem with password reset. diff --git a/changelog.d/5-internal/WPB-8943 b/changelog.d/5-internal/WPB-8943 deleted file mode 100644 index ca30b58b2ae..00000000000 --- a/changelog.d/5-internal/WPB-8943 +++ /dev/null @@ -1 +0,0 @@ -update nixpkgs and hence GHC version as well as some other tooling. diff --git a/changelog.d/5-internal/WPB-9495 b/changelog.d/5-internal/WPB-9495 deleted file mode 100644 index 4be0c6f6de5..00000000000 --- a/changelog.d/5-internal/WPB-9495 +++ /dev/null @@ -1 +0,0 @@ -nginz: Added `allowlisted_fqdn_origins` to `nginx_conf` value diff --git a/changelog.d/5-internal/WPB-9667-weeder b/changelog.d/5-internal/WPB-9667-weeder deleted file mode 100644 index 2be9a9adfd5..00000000000 --- a/changelog.d/5-internal/WPB-9667-weeder +++ /dev/null @@ -1 +0,0 @@ -Add weeder for dead code elimination. \ No newline at end of file diff --git a/changelog.d/5-internal/WPB-9831-email-subsystem b/changelog.d/5-internal/WPB-9831-email-subsystem deleted file mode 100644 index eb14a50e4ac..00000000000 --- a/changelog.d/5-internal/WPB-9831-email-subsystem +++ /dev/null @@ -1 +0,0 @@ -Introduce email subsystem diff --git a/changelog.d/5-internal/cabal-project-local-improvements b/changelog.d/5-internal/cabal-project-local-improvements deleted file mode 100644 index 9a0c5621c18..00000000000 --- a/changelog.d/5-internal/cabal-project-local-improvements +++ /dev/null @@ -1 +0,0 @@ -replace cabal.project.local template and update cabal.project diff --git a/changelog.d/5-internal/elasticsearch b/changelog.d/5-internal/elasticsearch deleted file mode 100644 index 84fb1f08dca..00000000000 --- a/changelog.d/5-internal/elasticsearch +++ /dev/null @@ -1 +0,0 @@ -Add HTTP proxy in the local setup for elasticsearch in federation-v0. This makes it possible to use a single elasticsearch instance for both the main backends and federation-v0. diff --git a/changelog.d/5-internal/federator-metrics b/changelog.d/5-internal/federator-metrics deleted file mode 100644 index d2453989684..00000000000 --- a/changelog.d/5-internal/federator-metrics +++ /dev/null @@ -1 +0,0 @@ -federator: Add metrics for garbage collections and unexpected errors that were caught \ No newline at end of file diff --git a/changelog.d/5-internal/federator-simplification b/changelog.d/5-internal/federator-simplification deleted file mode 100644 index 9a170ab3f41..00000000000 --- a/changelog.d/5-internal/federator-simplification +++ /dev/null @@ -1,3 +0,0 @@ -federator: Simplify polysemy setup to make it similar to other services so the -interpreter is only used for hoisting the servant application and not explicitly -inside handler of an endpoint \ No newline at end of file diff --git a/changelog.d/5-internal/k8ssandra-test-cluster-chart-variables b/changelog.d/5-internal/k8ssandra-test-cluster-chart-variables deleted file mode 100644 index 6799efaf807..00000000000 --- a/changelog.d/5-internal/k8ssandra-test-cluster-chart-variables +++ /dev/null @@ -1 +0,0 @@ -Added prometheus enable and datacenter size variables for k8ssandra-test-cluster helm chart. diff --git a/changelog.d/5-internal/make-handle-abstract b/changelog.d/5-internal/make-handle-abstract deleted file mode 100644 index 5816db8a58b..00000000000 --- a/changelog.d/5-internal/make-handle-abstract +++ /dev/null @@ -1 +0,0 @@ -Make `Handle` type abstract to guarantee it always contains *valid* Handles. \ No newline at end of file diff --git a/changelog.d/5-internal/metrics-core b/changelog.d/5-internal/metrics-core deleted file mode 100644 index f9b39a5a634..00000000000 --- a/changelog.d/5-internal/metrics-core +++ /dev/null @@ -1 +0,0 @@ -metrics-core: Delete `Data.Metrics` in favour of defining metrics closer to where they are being emitted \ No newline at end of file diff --git a/changelog.d/5-internal/more-metadata-in-meta b/changelog.d/5-internal/more-metadata-in-meta deleted file mode 100644 index b6085a69987..00000000000 --- a/changelog.d/5-internal/more-metadata-in-meta +++ /dev/null @@ -1 +0,0 @@ -add more metadata into the meta attribute of all nix derivations produced locally diff --git a/changelog.d/5-internal/reduce-thread-killed-log-noise b/changelog.d/5-internal/reduce-thread-killed-log-noise deleted file mode 100644 index 177ca9f4d37..00000000000 --- a/changelog.d/5-internal/reduce-thread-killed-log-noise +++ /dev/null @@ -1 +0,0 @@ -Do not log anything when warp kills a worker thread. \ No newline at end of file diff --git a/changelog.d/5-internal/verification-code-subsystem b/changelog.d/5-internal/verification-code-subsystem deleted file mode 100644 index 530645f29a6..00000000000 --- a/changelog.d/5-internal/verification-code-subsystem +++ /dev/null @@ -1 +0,0 @@ -Introduce VerificationCodSubsystem \ No newline at end of file diff --git a/changelog.d/5-internal/wpb-6350 b/changelog.d/5-internal/wpb-6350 deleted file mode 100644 index 0414493148d..00000000000 --- a/changelog.d/5-internal/wpb-6350 +++ /dev/null @@ -1 +0,0 @@ -add tests for bots that use self-signed certs and add documentation on why we cannot test the bots to work with PKI From 3b3be5f6d13e8523521d4556e4ae4efe77dd3110 Mon Sep 17 00:00:00 2001 From: Igor Ranieri <54423+elland@users.noreply.github.com> Date: Mon, 8 Jul 2024 16:31:05 +0200 Subject: [PATCH 64/64] [fix] charts/gundeck: reference correct value for tlsCa (#4127) (#4128) related to WPB-9960 Co-authored-by: Leonhardt Wille --- charts/gundeck/templates/redis-ca-secret.yaml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/charts/gundeck/templates/redis-ca-secret.yaml b/charts/gundeck/templates/redis-ca-secret.yaml index 84c6aa59128..de1f752e55a 100644 --- a/charts/gundeck/templates/redis-ca-secret.yaml +++ b/charts/gundeck/templates/redis-ca-secret.yaml @@ -11,7 +11,7 @@ metadata: heritage: "{{ .Release.Service }}" type: Opaque data: - ca.pem: {{ .Values.redis.tlsCa | b64enc | quote }} + ca.pem: {{ .Values.config.redis.tlsCa | b64enc | quote }} {{- end }} --- {{- if not (empty .Values.config.redis.additionalTlsCa) }} @@ -26,5 +26,5 @@ metadata: heritage: "{{ .Release.Service }}" type: Opaque data: - ca.pem: {{ .Values.redis.additionalTlsCa | b64enc | quote }} + ca.pem: {{ .Values.config.redis.additionalTlsCa | b64enc | quote }} {{- end }}