From de6b6545ce89b4b6b739b5a3d92842f76926d6fa Mon Sep 17 00:00:00 2001 From: Paolo Capriotti Date: Thu, 3 Nov 2022 16:22:09 +0100 Subject: [PATCH 01/76] Fix client check when removing clients from MLS conversations (#2817) * Fix bug in MLS user removal from conversation The list of removed clients has to be compared with those in the conversation, not the list of *all* clients of that user. * Rename getMLSClients to getClientInfo * Skip client check for deleted clients The code skipping this check was incorrectly deleted in 49782f5. This restores it (in a different form) and adds some comments explaining the logic. --- changelog.d/3-bug-fixes/removal-client-check | 1 + services/galley/src/Galley/API/MLS/Message.hs | 62 +++++++++++-------- services/galley/test/integration/API/MLS.hs | 1 + 3 files changed, 38 insertions(+), 26 deletions(-) create mode 100644 changelog.d/3-bug-fixes/removal-client-check diff --git a/changelog.d/3-bug-fixes/removal-client-check b/changelog.d/3-bug-fixes/removal-client-check new file mode 100644 index 00000000000..6e62ac234b7 --- /dev/null +++ b/changelog.d/3-bug-fixes/removal-client-check @@ -0,0 +1 @@ +Fix bug in MLS user removal from conversation: the list of removed clients has to be compared with those in the conversation, not the list of *all* clients of that user diff --git a/services/galley/src/Galley/API/MLS/Message.hs b/services/galley/src/Galley/API/MLS/Message.hs index f8d2c085760..f5bd3d7a5c9 100644 --- a/services/galley/src/Galley/API/MLS/Message.hs +++ b/services/galley/src/Galley/API/MLS/Message.hs @@ -27,6 +27,7 @@ module Galley.API.MLS.Message where import Control.Comonad +import Control.Error.Util (hush) import Control.Lens (preview, to) import Data.Id import Data.Json.Util @@ -1027,7 +1028,25 @@ executeProposalAction qusr con lconv cm action = do cs <- preview (to convProtocol . _ProtocolMLS . to cnvmlsCipherSuite) (tUnqualified lconv) & noteS @'ConvNotFound let ss = csSignatureScheme cs newUserClients = Map.assocs (paAdd action) - removeUserClients = Map.assocs (paRemove action) + + -- Note [client removal] + -- We support two types of removals: + -- 1. when a user is removed from a group, all their clients have to be removed + -- 2. when a client is deleted, that particular client (but not necessarily + -- other clients of the same user), has to be removed. + -- + -- Type 2 requires no special processing on the backend, so here we filter + -- out all removals of that type, so that further checks and processing can + -- be applied only to type 1 removals. + removedUsers <- mapMaybe hush <$$> for (Map.assocs (paRemove action)) $ + \(qtarget, Set.map fst -> clients) -> runError @() $ do + -- fetch clients from brig + clientInfo <- Set.map ciId <$> getClientInfo lconv qtarget ss + -- if the clients being removed don't exist, consider this as a removal of + -- type 2, and skip it + when (Set.null (clientInfo `Set.intersection` clients)) $ + throw () + pure (qtarget, clients) -- FUTUREWORK: remove this check after remote admins are implemented in federation https://wearezeta.atlassian.net/browse/FS-216 foldQualified lconv (\_ -> pure ()) (\_ -> throwS @'MLSUnsupportedProposal) qusr @@ -1041,7 +1060,7 @@ executeProposalAction qusr con lconv cm action = do -- final set of clients in the conversation let clients = Set.map fst (newclients <> Map.findWithDefault mempty qtarget cm) -- get list of mls clients from brig - clientInfo <- getMLSClients lconv qtarget ss + clientInfo <- getClientInfo lconv qtarget ss let allClients = Set.map ciId clientInfo let allMLSClients = Set.map ciId (Set.filter ciMLS clientInfo) -- We check the following condition: @@ -1062,7 +1081,7 @@ executeProposalAction qusr con lconv cm action = do -- FUTUREWORK: turn this error into a proper response throwS @'MLSClientMismatch - membersToRemove <- catMaybes <$> for removeUserClients (uncurry (checkRemoval lconv ss)) + membersToRemove <- catMaybes <$> for removedUsers (uncurry checkRemoval) -- add users to the conversation and send events addEvents <- foldMap addMembers . nonEmpty . map fst $ newUserClients @@ -1074,34 +1093,25 @@ executeProposalAction qusr con lconv cm action = do -- remove users from the conversation and send events removeEvents <- foldMap removeMembers (nonEmpty membersToRemove) - -- remove clients in the conversation state - for_ removeUserClients $ \(qtarget, clients) -> do + -- Remove clients from the conversation state. This includes client removals + -- of all types (see Note [client removal]). + for_ (Map.assocs (paRemove action)) $ \(qtarget, clients) -> do removeMLSClients (fmap convId lconv) qtarget (Set.map fst clients) pure (addEvents <> removeEvents) where - -- This also filters out client removals for clients that don't exist anymore - -- For these clients there is nothing left to do checkRemoval :: - Local x -> - SignatureSchemeTag -> Qualified UserId -> - Set (ClientId, KeyPackageRef) -> + Set ClientId -> Sem r (Maybe (Qualified UserId)) - checkRemoval loc ss qtarget (Set.map fst -> clients) = do - allClients <- Set.map ciId <$> getMLSClients loc qtarget ss - let allClientsDontExist = Set.null (clients `Set.intersection` allClients) - if allClientsDontExist - then pure Nothing - else do - -- We only support removal of client for user. This is likely to change in the future. - -- See discussions here https://wearezeta.atlassian.net/wiki/spaces/CL/pages/612106259/Relax+constraint+between+users+and+clients+in+MLS+groups - when (clients /= allClients) $ do - -- FUTUREWORK: turn this error into a proper response - throwS @'MLSClientMismatch - when (qusr == qtarget) $ - throwS @'MLSSelfRemovalNotAllowed - pure (Just qtarget) + checkRemoval qtarget clients = do + let clientsInConv = Set.map fst (Map.findWithDefault mempty qtarget cm) + when (clients /= clientsInConv) $ do + -- FUTUREWORK: turn this error into a proper response + throwS @'MLSClientMismatch + when (qusr == qtarget) $ + throwS @'MLSSelfRemovalNotAllowed + pure (Just qtarget) existingLocalMembers :: Set (Qualified UserId) existingLocalMembers = @@ -1144,13 +1154,13 @@ executeProposalAction qusr con lconv cm action = do handleNoChanges :: Monoid a => Sem (Error NoChanges ': r) a -> Sem r a handleNoChanges = fmap fold . runError -getMLSClients :: +getClientInfo :: Members '[BrigAccess, FederatorAccess] r => Local x -> Qualified UserId -> SignatureSchemeTag -> Sem r (Set ClientInfo) -getMLSClients loc = foldQualified loc getLocalMLSClients getRemoteMLSClients +getClientInfo loc = foldQualified loc getLocalMLSClients getRemoteMLSClients getRemoteMLSClients :: Member FederatorAccess r => diff --git a/services/galley/test/integration/API/MLS.hs b/services/galley/test/integration/API/MLS.hs index 94a9dbd5485..87549c0f0d7 100644 --- a/services/galley/test/integration/API/MLS.hs +++ b/services/galley/test/integration/API/MLS.hs @@ -768,6 +768,7 @@ testAdminRemovesUserFromConv = do [alice, bob] <- createAndConnectUsers [Nothing, Nothing] (qcnv, events) <- runMLSTest $ do [alice1, bob1, bob2] <- traverse createMLSClient [alice, bob, bob] + void $ createWireClient bob -- also create one extra non-MLS client traverse_ uploadNewKeyPackage [bob1, bob2] (_, qcnv) <- setupMLSGroup alice1 void $ createAddCommit alice1 [bob] >>= sendAndConsumeCommit From 60165608b45211ed68b98ac4ea2ff29c4270c373 Mon Sep 17 00:00:00 2001 From: Sven Tennie Date: Fri, 4 Nov 2022 11:46:15 +0100 Subject: [PATCH 02/76] Add test for urls in team invitations (SQPIT-1368) (#2797) Add tests for invitation urls in team invitation responses. These depend on the settings of galley. --- .../5-internal/add-invitation-url-tests | 1 + services/brig/brig.cabal | 1 + services/brig/default.nix | 2 +- services/brig/test/integration/API/Team.hs | 101 +++++++++++++++++- 4 files changed, 103 insertions(+), 2 deletions(-) create mode 100644 changelog.d/5-internal/add-invitation-url-tests diff --git a/changelog.d/5-internal/add-invitation-url-tests b/changelog.d/5-internal/add-invitation-url-tests new file mode 100644 index 00000000000..1c00b996068 --- /dev/null +++ b/changelog.d/5-internal/add-invitation-url-tests @@ -0,0 +1 @@ +Add tests for invitation urls in team invitation responses. These depend on the settings of galley. diff --git a/services/brig/brig.cabal b/services/brig/brig.cabal index 1c8cbf0ab8b..0fd8a015356 100644 --- a/services/brig/brig.cabal +++ b/services/brig/brig.cabal @@ -534,6 +534,7 @@ executable brig-integration , data-timeout , email-validate , exceptions + , extra , federator , filepath >=1.4 , galley-types diff --git a/services/brig/default.nix b/services/brig/default.nix index e4ffbf14029..c8ea67ba1dd 100644 --- a/services/brig/default.nix +++ b/services/brig/default.nix @@ -72,7 +72,7 @@ mkDerivation { aeson async attoparsec base base16-bytestring base64-bytestring bilge bloodhound brig-types bytestring bytestring-conversion cargohold-types case-insensitive cassandra-util containers cookie - data-default data-timeout email-validate exceptions extended + data-default data-timeout email-validate exceptions extended extra federator filepath galley-types gundeck-types hscim HsOpenSSL http-api-data http-client http-client-tls http-media http-reverse-proxy http-types imports lens lens-aeson metrics-wai diff --git a/services/brig/test/integration/API/Team.hs b/services/brig/test/integration/API/Team.hs index 7c44cc73be1..68f72811597 100644 --- a/services/brig/test/integration/API/Team.hs +++ b/services/brig/test/integration/API/Team.hs @@ -36,21 +36,29 @@ import Control.Lens hiding ((.=)) import Control.Monad.Catch (MonadCatch, MonadThrow) import Data.Aeson import Data.ByteString.Conversion +import Data.ByteString.Lazy (toStrict) +import Data.Either.Extra (eitherToMaybe) import Data.Id hiding (client) import Data.Json.Util (UTCTimeMillis, toUTCTimeMillis) +import Data.LegalHold (UserLegalHoldStatus (UserLegalHoldDisabled)) +import qualified Data.Text as Text import qualified Data.Text.Ascii as Ascii +import Data.Text.Encoding (encodeUtf8) import Data.Time (addUTCTime, getCurrentTime) import qualified Data.UUID as UUID (fromString) import qualified Data.UUID.V4 as UUID import qualified Galley.Types.Teams as Team import qualified Galley.Types.Teams.Intra as Team import Imports +import qualified Network.HTTP.Types as HTTP +import qualified Network.Wai as Wai import qualified Network.Wai.Test as WaiTest import qualified Network.Wai.Utilities.Error as Error import Numeric.Natural (Natural) import Test.Tasty hiding (Timeout) import qualified Test.Tasty.Cannon as WS import Test.Tasty.HUnit +import URI.ByteString import UnliftIO.Async (mapConcurrently_, pooledForConcurrentlyN_, replicateConcurrently) import Util import Util.AWS as Util @@ -58,6 +66,7 @@ import Web.Cookie (parseSetCookie, setCookieName) import Wire.API.Asset import Wire.API.Connection import Wire.API.Team hiding (newTeam) +import Wire.API.Team.Feature import qualified Wire.API.Team.Feature as Public import Wire.API.Team.Invitation import Wire.API.Team.Member hiding (invitation, userId) @@ -80,6 +89,8 @@ tests conf m n b c g aws = do "team" [ testGroup "invitation" $ [ test m "post /teams/:tid/invitations - 201" $ testInvitationEmail b, + test m "post /teams/:tid/invitations - invitation url" $ testInvitationUrl conf b, + test m "post /teams/:tid/invitations - no invitation url" $ testNoInvitationUrl conf b, test m "post /teams/:tid/invitations - email lookup" $ testInvitationEmailLookup b, test m "post /teams/:tid/invitations - email lookup nginz" $ testInvitationEmailLookupNginz b n, test m "post /teams/:tid/invitations - email lookup register" $ testInvitationEmailLookupRegister b, @@ -177,7 +188,95 @@ testInvitationEmail :: Brig -> Http () testInvitationEmail brig = do (inviter, tid) <- createUserWithTeam brig invite <- stdInvitationRequest <$> randomEmail - void $ postInvitation brig tid inviter invite + res <- + postInvitation brig tid inviter invite Invitation -> Assertion +assertInvitationResponseInvariants invReq inv = do + irInviteeName invReq @=? inInviteeName inv + irInviteePhone invReq @=? inInviteePhone inv + irInviteeEmail invReq @=? inInviteeEmail inv + +-- FUTUREWORK: This test should be rewritten to be free of mocks once Galley is +-- inlined into Brig. +testInvitationUrl :: Opt.Opts -> Brig -> Http () +testInvitationUrl opts brig = do + (inviter, tid) <- createUserWithTeam brig + invite <- stdInvitationRequest <$> randomEmail + + void . withMockedGalley opts (invitationUrlGalleyMock FeatureStatusEnabled tid inviter) $ do + resp <- + postInvitation brig tid inviter invite + (toStrict . toByteString)) + getQueryParam "team" resp @=? (pure . encodeUtf8 . idToText) tid + +getQueryParam :: ByteString -> ResponseLBS -> Maybe ByteString +getQueryParam name r = do + inv <- (eitherToMaybe . responseJsonEither) r + url <- inInviteeUrl inv + (lookup name . queryPairs . uriQuery) url + +-- | Mock the feature API because exposeInvitationURLsToTeamAdmin depends on +-- static configuration that cannot be changed at runtime. +invitationUrlGalleyMock :: + FeatureStatus -> + TeamId -> + UserId -> + ReceivedRequest -> + MockT IO Wai.Response +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 $ + encode + ( withStatus + featureStatus + LockStatusUnlocked + ExposeInvitationURLsToTeamAdminConfig + FeatureTTLUnlimited + ) + | mth == "GET" + && 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" + +-- FUTUREWORK: This test should be rewritten to be free of mocks once Galley is +-- inlined into Brig. +testNoInvitationUrl :: Opt.Opts -> Brig -> Http () +testNoInvitationUrl opts brig = do + (inviter, tid) <- createUserWithTeam brig + invite <- stdInvitationRequest <$> randomEmail + + void . withMockedGalley opts (invitationUrlGalleyMock FeatureStatusDisabled tid inviter) $ do + resp <- + postInvitation brig tid inviter invite + Http () testInvitationEmailLookup brig = do From 23e61c49764ee6c581fbb384bf9609bacf72e871 Mon Sep 17 00:00:00 2001 From: Leif Battermann Date: Fri, 4 Nov 2022 14:16:24 +0100 Subject: [PATCH 03/76] [SQSERVICES-1618] Flaky test for TTL feature flag (#2823) --- changelog.d/5-internal/pr-2823 | 1 + .../test/integration/API/Teams/Feature.hs | 40 ++++++++++++++----- 2 files changed, 30 insertions(+), 11 deletions(-) create mode 100644 changelog.d/5-internal/pr-2823 diff --git a/changelog.d/5-internal/pr-2823 b/changelog.d/5-internal/pr-2823 new file mode 100644 index 00000000000..49626890f6a --- /dev/null +++ b/changelog.d/5-internal/pr-2823 @@ -0,0 +1 @@ +Fixed flaky feature TTL integration test diff --git a/services/galley/test/integration/API/Teams/Feature.hs b/services/galley/test/integration/API/Teams/Feature.hs index 4246598847f..c19f0161120 100644 --- a/services/galley/test/integration/API/Teams/Feature.hs +++ b/services/galley/test/integration/API/Teams/Feature.hs @@ -49,7 +49,7 @@ import Test.Hspec (expectationFailure) import Test.QuickCheck (Gen, generate, suchThat) import Test.Tasty import qualified Test.Tasty.Cannon as WS -import Test.Tasty.HUnit (assertFailure, (@?=)) +import Test.Tasty.HUnit (assertBool, assertFailure, (@?=)) import TestHelpers (eventually, test) import TestSetup import Wire.API.Conversation.Protocol (ProtocolTag (ProtocolMLSTag, ProtocolProteusTag)) @@ -503,7 +503,7 @@ testSimpleFlagTTLOverride defaultValue ttl ttlAfter = do getFeatureConfig expectedStatus expectedTtl = eventually $ do actual <- Util.getFeatureConfig @cfg member liftIO $ Public.wsStatus actual @?= expectedStatus - liftIO $ Public.wsTTL actual @?= expectedTtl + liftIO $ checkTtl (Public.wsTTL actual) expectedTtl getFlagInternal :: HasCallStack => Public.FeatureStatus -> TestM () getFlagInternal expected = eventually $ do @@ -536,6 +536,16 @@ testSimpleFlagTTLOverride defaultValue ttl ttlAfter = do Just (FeatureTTLSeconds i) -> i <= upper unless check $ error ("expected ttl <= " <> show upper <> ", got " <> show storedTTL) + checkTtl :: FeatureTTL -> FeatureTTL -> IO () + checkTtl (FeatureTTLSeconds actualTtl) (FeatureTTLSeconds expectedTtl) = + 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 FeatureTTLUnlimited FeatureTTLUnlimited = pure () + checkTtl FeatureTTLUnlimited _ = assertFailure "expected the actual TTL to be unlimited, but it was limited" + checkTtl _ FeatureTTLUnlimited = assertFailure "expected the actual TTL to be limited, but it was unlimited" + + toMicros :: Word -> Int toMicros secs = fromIntegral secs * 1000000 assertFlagForbidden $ getTeamFeatureFlag @cfg nonMember tid @@ -552,7 +562,7 @@ testSimpleFlagTTLOverride defaultValue ttl ttlAfter = do -- Setting should work setFlagInternal otherValue ttl getFlag otherValue - getFeatureConfig otherValue ttl + getFeatureConfig otherValue ttl -- XXXXX getFlagInternal otherValue case (ttl, ttlAfter) of @@ -745,17 +755,20 @@ testSimpleFlagWithLockStatus defaultStatus defaultLockStatus = do setFlagWithGalley :: Public.FeatureStatus -> TestM () setFlagWithGalley statusValue = putTeamFeatureFlagWithGalley @cfg galley owner tid (Public.WithStatusNoLock statusValue (Public.trivialConfig @cfg) Public.FeatureTTLUnlimited) - !!! statusCode === const 200 + !!! statusCode + === const 200 assertSetStatusForbidden :: Public.FeatureStatus -> TestM () assertSetStatusForbidden statusValue = putTeamFeatureFlagWithGalley @cfg galley owner tid (Public.WithStatusNoLock statusValue (Public.trivialConfig @cfg) Public.FeatureTTLUnlimited) - !!! statusCode === const 409 + !!! statusCode + === const 409 setLockStatus :: Public.LockStatus -> TestM () setLockStatus lockStatus = Util.setLockStatusInternal @cfg galley tid lockStatus - !!! statusCode === const 200 + !!! statusCode + === const 200 assertFlagForbidden $ getTeamFeatureFlag @cfg nonMember tid @@ -838,7 +851,8 @@ testSelfDeletingMessages = do galley tid (settingWithoutLockStatus stat tout) - !!! statusCode === const expectedStatusCode + !!! statusCode + === const expectedStatusCode -- internal, public (/team/:tid/features), and team-agnostic (/feature-configs). checkGet :: HasCallStack => FeatureStatus -> Int32 -> Public.LockStatus -> TestM () @@ -856,7 +870,8 @@ testSelfDeletingMessages = do checkSetLockStatus status = do Util.setLockStatusInternal @Public.SelfDeletingMessagesConfig galley tid status - !!! statusCode === const 200 + !!! 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 @@ -971,7 +986,8 @@ testAllFeatures = do galley <- viewGalley -- this sets the guest links config to its default value thereby creating a row for the team in galley.team_features putTeamFeatureFlagInternal @Public.GuestLinksConfig galley tid (Public.WithStatusNoLock FeatureStatusEnabled Public.GuestLinksConfig Public.FeatureTTLUnlimited) - !!! statusCode === const 200 + !!! statusCode + === const 200 getAllTeamFeatures member tid !!! do statusCode === const 200 responseJsonMaybe === const (Just (expected FeatureStatusEnabled defLockStatus {- determined by default in galley -})) @@ -1060,7 +1076,8 @@ testFeatureNoConfigMultiSearchVisibilityInbound = do r <- getFeatureStatusMulti @Public.SearchVisibilityInboundConfig (Multi.TeamFeatureNoConfigMultiRequest [team1, team2]) - Public.WithStatusNoLock MLSConfig -> TestM () setForTeam wsnl = putTeamFeatureFlagWithGalley @MLSConfig galley owner tid wsnl - !!! statusCode === const 200 + !!! statusCode + === const 200 setForTeamInternal :: HasCallStack => Public.WithStatusNoLock MLSConfig -> TestM () setForTeamInternal wsnl = From 8360726f22b82ab49e0ce35dcb1b6b2dcc3b3335 Mon Sep 17 00:00:00 2001 From: Stefan Matting Date: Mon, 7 Nov 2022 09:43:34 +0100 Subject: [PATCH 04/76] [FS-925] Add endpoint to create MLS self-conversation (#2730) MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * Add mlsSelfConvId function * Implement endpoint * Fix a typo in a test function name * Integration test: happy case * Integration test: other user attempting to join * Integration test: leaving a self-conversation * Add a changelog Co-authored-by: Marko Dimjašević --- .../1-api-changes/mls-self-conversation | 1 + libs/wire-api/src/Wire/API/Conversation.hs | 15 +++++ .../src/Wire/API/Routes/Public/Galley.hs | 17 +++++- services/galley/src/Galley/API/Create.hs | 53 ++++++++++++---- .../galley/src/Galley/API/Public/Servant.hs | 3 +- services/galley/src/Galley/API/Query.hs | 3 +- services/galley/src/Galley/API/Util.hs | 11 ++++ services/galley/test/integration/API/MLS.hs | 58 +++++++++++++++++- .../galley/test/integration/API/MLS/Util.hs | 60 +++++++++++++++---- services/galley/test/integration/API/Util.hs | 3 + 10 files changed, 193 insertions(+), 31 deletions(-) create mode 100644 changelog.d/1-api-changes/mls-self-conversation diff --git a/changelog.d/1-api-changes/mls-self-conversation b/changelog.d/1-api-changes/mls-self-conversation new file mode 100644 index 00000000000..d7f820765be --- /dev/null +++ b/changelog.d/1-api-changes/mls-self-conversation @@ -0,0 +1 @@ +Support MLS self-conversations via a new endpoint `PUT /conversations/mls-self` diff --git a/libs/wire-api/src/Wire/API/Conversation.hs b/libs/wire-api/src/Wire/API/Conversation.hs index 8bcafda6edb..f25b4f3ae07 100644 --- a/libs/wire-api/src/Wire/API/Conversation.hs +++ b/libs/wire-api/src/Wire/API/Conversation.hs @@ -44,6 +44,7 @@ module Wire.API.Conversation pattern ConversationPagingState, ConversationsResponse (..), GroupId (..), + mlsSelfConvId, -- * Conversation properties Access (..), @@ -97,6 +98,7 @@ import Control.Applicative import Control.Lens (at, (?~)) import Data.Aeson (FromJSON (..), ToJSON (..)) import qualified Data.Aeson as A +import qualified Data.ByteString.Lazy as LBS import Data.Id import Data.List.Extra (disjointOrd) import Data.List.NonEmpty (NonEmpty) @@ -110,6 +112,8 @@ import qualified Data.Set as Set import Data.String.Conversions (cs) import qualified Data.Swagger as S import qualified Data.Swagger.Build.Api as Doc +import qualified Data.UUID as UUID +import qualified Data.UUID.V5 as UUIDV5 import Imports import System.Random (randomRIO) import Wire.API.Conversation.Member @@ -934,3 +938,14 @@ instance ToSchema ConversationMemberUpdate where $ ConversationMemberUpdate <$> cmuTarget .= field "target" schema <*> cmuUpdate .= field "update" schema + +-- | The id of the MLS self conversation for a given user +mlsSelfConvId :: UserId -> ConvId +mlsSelfConvId uid = + let inputBytes = LBS.unpack . UUID.toByteString . toUUID $ uid + in Id (UUIDV5.generateNamed namespaceMLSSelfConv inputBytes) + +namespaceMLSSelfConv :: UUID.UUID +namespaceMLSSelfConv = + -- a V5 uuid created with the nil namespace + fromJust . UUID.fromString $ "3eac2a2c-3850-510b-bd08-8a98e80dd4d9" diff --git a/libs/wire-api/src/Wire/API/Routes/Public/Galley.hs b/libs/wire-api/src/Wire/API/Routes/Public/Galley.hs index ac000d4dfff..4a8791a9026 100644 --- a/libs/wire-api/src/Wire/API/Routes/Public/Galley.hs +++ b/libs/wire-api/src/Wire/API/Routes/Public/Galley.hs @@ -75,9 +75,9 @@ type ConversationResponse = ResponseForExistedCreated Conversation type ConversationHeaders = '[DescHeader "Location" "Conversation ID" ConvId] -type ConversationVerb = +type ConversationVerbWithMethod (m :: StdMethod) = MultiVerb - 'POST + m '[JSON] '[ WithHeaders ConversationHeaders @@ -90,6 +90,10 @@ type ConversationVerb = ] ConversationResponse +type ConversationVerb = ConversationVerbWithMethod 'POST + +type ConversationPutVerb = ConversationVerbWithMethod 'PUT + type CreateConversationCodeVerb = MultiVerb 'POST @@ -366,6 +370,15 @@ type ConversationAPI = :> "self" :> ConversationVerb ) + :<|> Named + "create-mls-self-conversation" + ( Summary "Create the user's MLS self-conversation" + :> ZLocalUser + :> "conversations" + :> "mls-self" + :> ZClient + :> ConversationPutVerb + ) -- This endpoint can lead to the following events being sent: -- - ConvCreate event to members -- TODO: add note: "On 201, the conversation ID is the `Location` header" diff --git a/services/galley/src/Galley/API/Create.hs b/services/galley/src/Galley/API/Create.hs index f13e89c12fe..edaee398a78 100644 --- a/services/galley/src/Galley/API/Create.hs +++ b/services/galley/src/Galley/API/Create.hs @@ -24,7 +24,8 @@ -- with this program. If not, see . module Galley.API.Create ( createGroupConversation, - createSelfConversation, + createProteusSelfConversation, + createMLSSelfConversation, createOne2OneConversation, createConnectConversation, ) @@ -117,8 +118,7 @@ createGroupConversation lusr conn newConv = do case newConvProtocol newConv of ProtocolMLSTag -> do - haveKey <- isJust <$> getMLSRemovalKey - unless haveKey $ + unlessM (isJust <$> getMLSRemovalKey) $ -- We fail here to notify users early about this misconfiguration throw (InternalErrorWithDescription "No backend removal key is configured (See 'mlsPrivateKeyPaths' in galley's config). Refusing to create MLS conversation.") ProtocolProteusTag -> pure () @@ -193,12 +193,12 @@ checkCreateConvPermissions lusr newConv (Just tinfo) allUsers = do ---------------------------------------------------------------------------- -- Other kinds of conversations -createSelfConversation :: +createProteusSelfConversation :: forall r. Members '[ConversationStore, Error InternalError, P.TinyLog] r => Local UserId -> Sem r ConversationResponse -createSelfConversation lusr = do +createProteusSelfConversation lusr = do let lcnv = fmap Data.selfConv lusr c <- E.getConversation (tUnqualified lcnv) maybe (create lcnv) (conversationExisted lusr) c @@ -214,6 +214,42 @@ createSelfConversation lusr = do c <- E.createConversation lcnv nc conversationCreated lusr c +createMLSSelfConversation :: + forall r. + Members + '[ ConversationStore, + Error InternalError, + MemberStore, + P.TinyLog, + Input Env + ] + r => + Local UserId -> + ClientId -> + Sem r ConversationResponse +createMLSSelfConversation lusr clientId = do + let selfConvId = mlsSelfConvId <$> lusr + mconv <- E.getConversation (tUnqualified selfConvId) + maybe (create selfConvId) (conversationExisted lusr) mconv + where + create :: Local ConvId -> Sem r ConversationResponse + create lcnv = do + unlessM (isJust <$> getMLSRemovalKey) $ + throw (InternalErrorWithDescription "No backend removal key is configured (See 'mlsPrivateKeyPaths' in galley's config). Refusing to create MLS conversation.") + let nc = + NewConversation + { ncMetadata = + (defConversationMetadata (tUnqualified lusr)) + { cnvmType = SelfConv + }, + ncUsers = ulFromLocals [toUserRole (tUnqualified lusr)], + ncProtocol = ProtocolMLSTag + } + conv <- E.createConversation lcnv nc + -- FUTUREWORK: remove this. we are planning to remove the need for a nullKeyPackageRef + E.addMLSClients lcnv (qUntagged lusr) (Set.singleton (clientId, nullKeyPackageRef)) + conversationCreated lusr conv + createOne2OneConversation :: forall r. Members @@ -535,13 +571,6 @@ conversationCreated :: Sem r ConversationResponse conversationCreated lusr cnv = Created <$> conversationView lusr cnv -conversationExisted :: - Members '[Error InternalError, P.TinyLog] r => - Local UserId -> - Data.Conversation -> - Sem r ConversationResponse -conversationExisted lusr cnv = Existed <$> conversationView lusr cnv - notifyCreatedConversation :: Members '[Error InternalError, FederatorAccess, GundeckAccess, Input UTCTime, P.TinyLog] r => Maybe UTCTime -> diff --git a/services/galley/src/Galley/API/Public/Servant.hs b/services/galley/src/Galley/API/Public/Servant.hs index 9e32a4aa939..ef8640cbcce 100644 --- a/services/galley/src/Galley/API/Public/Servant.hs +++ b/services/galley/src/Galley/API/Public/Servant.hs @@ -59,7 +59,8 @@ servantSitemap = <@> mkNamedAPI @"list-conversations" listConversations <@> mkNamedAPI @"get-conversation-by-reusable-code" (getConversationByReusableCode @Cassandra) <@> mkNamedAPI @"create-group-conversation" createGroupConversation - <@> mkNamedAPI @"create-self-conversation" createSelfConversation + <@> mkNamedAPI @"create-self-conversation" createProteusSelfConversation + <@> mkNamedAPI @"create-mls-self-conversation" createMLSSelfConversation <@> mkNamedAPI @"create-one-to-one-conversation" createOne2OneConversation <@> mkNamedAPI @"add-members-to-conversation-unqualified" addMembersUnqualified <@> mkNamedAPI @"add-members-to-conversation-unqualified2" addMembersUnqualifiedV2 diff --git a/services/galley/src/Galley/API/Query.hs b/services/galley/src/Galley/API/Query.hs index 852ae13115d..0e13e6d4c64 100644 --- a/services/galley/src/Galley/API/Query.hs +++ b/services/galley/src/Galley/API/Query.hs @@ -90,10 +90,9 @@ import Polysemy.Error import Polysemy.Input import qualified Polysemy.TinyLog as P import qualified System.Logger.Class as Logger -import Wire.API.Conversation (Access (CodeAccess), Conversation, ConversationCoverView (..), ConversationList (ConversationList), ConversationMetadata, convHasMore, convList) +import Wire.API.Conversation hiding (Member) import qualified Wire.API.Conversation as Public import Wire.API.Conversation.Code -import Wire.API.Conversation.Member hiding (Member) import Wire.API.Conversation.Role import qualified Wire.API.Conversation.Role as Public import Wire.API.Error diff --git a/services/galley/src/Galley/API/Util.hs b/services/galley/src/Galley/API/Util.hs index 24891e22c65..c35b4f8a481 100644 --- a/services/galley/src/Galley/API/Util.hs +++ b/services/galley/src/Galley/API/Util.hs @@ -36,6 +36,7 @@ import Data.Singletons import qualified Data.Text as T import Data.Time import Galley.API.Error +import Galley.API.Mapping import qualified Galley.Data.Conversation as Data import Galley.Data.Services (BotMember, newBotMember) import qualified Galley.Data.Types as DataTypes @@ -63,6 +64,7 @@ import qualified Network.Wai.Utilities as Wai import Polysemy import Polysemy.Error import Polysemy.Input +import qualified Polysemy.TinyLog as P import Wire.API.Connection import Wire.API.Conversation hiding (Member) import qualified Wire.API.Conversation as Public @@ -74,6 +76,8 @@ import Wire.API.Event.Conversation import Wire.API.Federation.API import Wire.API.Federation.API.Galley import Wire.API.Federation.Error +import Wire.API.Routes.Public.Galley +import Wire.API.Routes.Public.Util import Wire.API.Team.Member import Wire.API.Team.Role import Wire.API.User (VerificationAction) @@ -838,6 +842,13 @@ ensureMemberLimit old new = do when (length old + length new > maxSize) $ throwS @'TooManyMembers +conversationExisted :: + Members '[Error InternalError, P.TinyLog] r => + Local UserId -> + Data.Conversation -> + Sem r ConversationResponse +conversationExisted lusr cnv = Existed <$> conversationView lusr cnv + -------------------------------------------------------------------------------- -- Handling remote errors diff --git a/services/galley/test/integration/API/MLS.hs b/services/galley/test/integration/API/MLS.hs index 87549c0f0d7..ed32094d7f3 100644 --- a/services/galley/test/integration/API/MLS.hs +++ b/services/galley/test/integration/API/MLS.hs @@ -182,8 +182,14 @@ tests s = testGroup "CommitBundle" [ test s "add user with a commit bundle" testAddUserWithBundle, - test s "add user with a commit bundle to a remote conversation" testAddUserToRemoveConvWithBundle, + test s "add user with a commit bundle to a remote conversation" testAddUserToRemoteConvWithBundle, test s "remote user posts commit bundle" testRemoteUserPostsCommitBundle + ], + testGroup + "Self conversation" + [ test s "create a self conversation" testSelfConversation, + test s "attempt to add another user to a conversation fails" testSelfConversationOtherUser, + test s "attempt to leave fails" testSelfConversationLeave ] ] @@ -1993,8 +1999,8 @@ testDeleteMLSConv = do deleteTeamConv tid (qUnqualified qcnv) aliceUnq !!! statusCode === const 200 -testAddUserToRemoveConvWithBundle :: TestM () -testAddUserToRemoveConvWithBundle = do +testAddUserToRemoteConvWithBundle :: TestM () +testAddUserToRemoteConvWithBundle = do let aliceDomain = Domain "faraway.example.com" [alice, bob, charlie] <- createAndConnectUsers [Just (domainText aliceDomain), Nothing, Nothing] @@ -2076,3 +2082,49 @@ testRemoteUserPostsCommitBundle = do MLSMessageResponseError MLSUnsupportedProposal <- runFedClient @"send-mls-commit-bundle" fedGalleyClient (Domain bobDomain) msr pure () + +testSelfConversation :: TestM () +testSelfConversation = do + alice <- randomQualifiedUser + runMLSTest $ do + creator : others <- traverse createMLSClient (replicate 3 alice) + traverse_ uploadNewKeyPackage others + void $ setupMLSSelfGroup creator + commit <- createAddCommit creator [alice] + welcome <- assertJust (mpWelcome commit) + mlsBracket others $ \wss -> do + void $ sendAndConsumeCommit commit + WS.assertMatchN_ (5 # Second) wss $ + wsAssertMLSWelcome alice welcome + WS.assertNoEvent (1 # WS.Second) wss + +testSelfConversationOtherUser :: TestM () +testSelfConversationOtherUser = do + users@[_alice, bob] <- createAndConnectUsers [Nothing, Nothing] + runMLSTest $ do + [alice1, bob1] <- traverse createMLSClient users + void $ uploadNewKeyPackage bob1 + void $ setupMLSSelfGroup alice1 + commit <- createAddCommit alice1 [bob] + mlsBracket [alice1, bob1] $ \wss -> do + postMessage (ciUser (mpSender commit)) (mpMessage commit) + !!! do + const 403 === statusCode + const (Just "invalid-op") === fmap Wai.label . responseJsonError + WS.assertNoEvent (1 # WS.Second) wss + +testSelfConversationLeave :: TestM () +testSelfConversationLeave = do + alice <- randomQualifiedUser + runMLSTest $ do + clients@(creator : others) <- traverse createMLSClient (replicate 3 alice) + traverse_ uploadNewKeyPackage others + (_, qcnv) <- setupMLSSelfGroup creator + void $ createAddCommit creator [alice] >>= sendAndConsumeCommit + mlsBracket clients $ \wss -> do + liftTest $ + deleteMemberQualified (qUnqualified alice) alice qcnv + !!! do + const 403 === statusCode + const (Just "invalid-op") === fmap Wai.label . responseJsonError + WS.assertNoEvent (1 # WS.Second) wss diff --git a/services/galley/test/integration/API/MLS/Util.hs b/services/galley/test/integration/API/MLS/Util.hs index 438bbd698d1..81543f9d3f0 100644 --- a/services/galley/test/integration/API/MLS/Util.hs +++ b/services/galley/test/integration/API/MLS/Util.hs @@ -392,19 +392,17 @@ setGroupState cid state = do fp <- nextGroupFile cid liftIO $ BS.writeFile fp state --- | Create conversation and corresponding group. -setupMLSGroup :: HasCallStack => ClientIdentity -> MLSTest (GroupId, Qualified ConvId) -setupMLSGroup creator = do +-- | Create a conversation from a provided action and then create a +-- corresponding group. +setupMLSGroupWithConv :: + HasCallStack => + MLSTest Conversation -> + ClientIdentity -> + MLSTest (GroupId, Qualified ConvId) +setupMLSGroupWithConv convAction creator = do ownDomain <- liftTest viewFederationDomain liftIO $ assertEqual "creator is not local" (ciDomain creator) ownDomain - conv <- - responseJsonError - =<< liftTest - ( postConvQualified - (ciUser creator) - (defNewMLSConv (ciClient creator)) - ) - ClientIdentity -> MLSTest (GroupId, Qualified ConvId) +setupMLSGroup creator = setupMLSGroupWithConv action creator + where + action = + responseJsonError + =<< liftTest + ( postConvQualified + (ciUser creator) + (defNewMLSConv (ciClient creator)) + ) + ClientIdentity -> MLSTest (GroupId, Qualified ConvId) +setupMLSSelfGroup creator = setupMLSGroupWithConv action creator + where + action = + responseJsonError + =<< liftTest + ( putSelfConv + (ciUser creator) + (ciClient creator) + ) + GroupId -> MLSTest () createGroup cid gid = do State.gets mlsGroupId >>= \case @@ -999,3 +1023,17 @@ getGroupInfo sender qcnv = do . zUser sender . zConn "conn" ) + +putSelfConv :: + UserId -> + ClientId -> + TestM ResponseLBS +putSelfConv u c = do + g <- viewGalley + put $ + g + . paths ["/conversations", "mls-self"] + . zUser u + . zClient c + . zConn "conn" + . zType "access" diff --git a/services/galley/test/integration/API/Util.hs b/services/galley/test/integration/API/Util.hs index c51bbc90252..c0ec1953585 100644 --- a/services/galley/test/integration/API/Util.hs +++ b/services/galley/test/integration/API/Util.hs @@ -1833,6 +1833,9 @@ zUser = header "Z-User" . toByteString' zBot :: UserId -> Request -> Request zBot = header "Z-Bot" . toByteString' +zClient :: ClientId -> Request -> Request +zClient = header "Z-Client" . toByteString' + zConn :: ByteString -> Request -> Request zConn = header "Z-Connection" From 50a198db13eeec69b24ce26f7cf1b90ba6811d9e Mon Sep 17 00:00:00 2001 From: Leif Battermann Date: Mon, 7 Nov 2022 11:09:06 +0100 Subject: [PATCH 05/76] [SQSERVICES-1644] Servantify brig calling API (#2815) --- changelog.d/5-internal/pr-2815 | 1 + libs/types-common/src/Data/Misc.hs | 45 ++-- libs/wire-api/src/Wire/API/Call/Config.hs | 229 +++++++++--------- .../src/Wire/API/Routes/Public/Brig.hs | 73 ++++-- libs/wire-api/src/Wire/API/Swagger.hs | 5 +- services/brig/src/Brig/API/Public.hs | 9 +- services/brig/src/Brig/Calling/API.hs | 51 +--- 7 files changed, 214 insertions(+), 199 deletions(-) create mode 100644 changelog.d/5-internal/pr-2815 diff --git a/changelog.d/5-internal/pr-2815 b/changelog.d/5-internal/pr-2815 new file mode 100644 index 00000000000..4462cf30cae --- /dev/null +++ b/changelog.d/5-internal/pr-2815 @@ -0,0 +1 @@ +Brig calling API is now migrated to servant diff --git a/libs/types-common/src/Data/Misc.hs b/libs/types-common/src/Data/Misc.hs index c049381e78d..30d31965968 100644 --- a/libs/types-common/src/Data/Misc.hs +++ b/libs/types-common/src/Data/Misc.hs @@ -74,6 +74,7 @@ import Data.ByteString.Lazy (toStrict) import Data.IP (IP (IPv4, IPv6), toIPv4, toIPv6b) import Data.Range import Data.Schema +import Data.String.Conversions (cs) import qualified Data.Swagger as S import qualified Data.Swagger.Build.Api as Doc import qualified Data.Text as Text @@ -83,7 +84,7 @@ import Servant (FromHttpApiData (..)) import Test.QuickCheck (Arbitrary (arbitrary), chooseInteger) import qualified Test.QuickCheck as QC import Text.Read (Read (..)) -import URI.ByteString hiding (Port) +import URI.ByteString hiding (Port, portNumber) import qualified URI.ByteString.QQ as URI.QQ -------------------------------------------------------------------------------- @@ -91,6 +92,7 @@ import qualified URI.ByteString.QQ as URI.QQ newtype IpAddr = IpAddr {ipAddr :: IP} deriving stock (Eq, Ord, Show, Generic) + deriving (A.ToJSON, A.FromJSON, S.ToSchema) via (Schema IpAddr) instance S.ToParamSchema IpAddr where toParamSchema _ = mempty & S.type_ ?~ S.SwaggerString @@ -125,24 +127,22 @@ newtype Port = Port {portNumber :: Word16} deriving stock (Eq, Ord, Show, Generic) deriving newtype (Real, Enum, Num, Integral, NFData, Arbitrary) + deriving (A.ToJSON, A.FromJSON, S.ToSchema) via (Schema Port) instance Read Port where readsPrec n = map (first Port) . readsPrec n -instance ToJSON IpAddr where - toJSON (IpAddr ip) = A.String (Text.pack $ show ip) - -instance FromJSON IpAddr where - parseJSON = A.withText "IpAddr" $ \txt -> - case readMaybe (Text.unpack txt) of - Nothing -> fail "Failed parsing IP address." - Just ip -> pure (IpAddr ip) +instance ToSchema IpAddr where + schema = toText .= parsedText "IpAddr" fromText + where + toText :: IpAddr -> Text + toText = cs . toByteString -instance ToJSON Port where - toJSON (Port p) = toJSON p + fromText :: Text -> Either String IpAddr + fromText = maybe (Left "Failed parsing IP address.") Right . fromByteString . cs -instance FromJSON Port where - parseJSON = fmap Port . parseJSON +instance ToSchema Port where + schema = Port <$> portNumber .= schema -------------------------------------------------------------------------------- -- Location @@ -158,8 +158,10 @@ instance ToSchema Location where schema = object "Location" $ Location - <$> _latitude .= field "lat" genericToSchema - <*> _longitude .= field "lon" genericToSchema + <$> _latitude + .= field "lat" genericToSchema + <*> _longitude + .= field "lon" genericToSchema instance Show Location where show p = @@ -273,7 +275,10 @@ instance ToSchema HttpsUrl where schema = (decodeUtf8 . toByteString') .= parsedText "HttpsUrl" (runParser parser . encodeUtf8) - & doc' . S.schema . S.example ?~ toJSON ("https://example.com" :: Text) + & doc' + . S.schema + . S.example + ?~ toJSON ("https://example.com" :: Text) instance Cql HttpsUrl where ctype = Tagged BlobColumn @@ -319,7 +324,10 @@ instance ToSchema (Fingerprint Rsa) where schema = (decodeUtf8 . B64.encode . fingerprintBytes) .= parsedText "Fingerprint" (runParser p . encodeUtf8) - & doc' . S.schema . S.example ?~ toJSON ("ioy3GeIjgQRsobf2EKGO3O8mq/FofFxHRqy0T4ERIZ8=" :: Text) + & doc' + . S.schema + . S.example + ?~ toJSON ("ioy3GeIjgQRsobf2EKGO3O8mq/FofFxHRqy0T4ERIZ8=" :: Text) where p :: Chars.Parser (Fingerprint Rsa) p = do @@ -353,7 +361,8 @@ instance Show PlainTextPassword where instance ToSchema PlainTextPassword where schema = PlainTextPassword - <$> fromPlainTextPassword .= untypedRangedSchema 6 1024 schema + <$> fromPlainTextPassword + .= untypedRangedSchema 6 1024 schema instance Arbitrary PlainTextPassword where -- TODO: why 6..1024? For tests we might want invalid passwords as well, e.g. 3 chars diff --git a/libs/wire-api/src/Wire/API/Call/Config.hs b/libs/wire-api/src/Wire/API/Call/Config.hs index 4c45d67875a..f01c1274ffa 100644 --- a/libs/wire-api/src/Wire/API/Call/Config.hs +++ b/libs/wire-api/src/Wire/API/Call/Config.hs @@ -66,23 +66,24 @@ module Wire.API.Call.Config isTcp, isTls, limitServers, - - -- * Swagger - modelRtcConfiguration, - modelRtcIceServer, ) where import Control.Applicative (optional) -import Control.Lens hiding ((.=)) -import Data.Aeson hiding (()) -import Data.Attoparsec.Text hiding (parse) +import Control.Lens hiding (element, enum, (.=)) +import qualified Data.Aeson as A hiding (()) +import qualified Data.Aeson.Types as A +import Data.Attoparsec.Text hiding (Parser, parse) +import qualified Data.Attoparsec.Text as Text import Data.ByteString.Builder +import Data.ByteString.Conversion (toByteString) import qualified Data.ByteString.Conversion as BC import qualified Data.IP as IP import Data.List.NonEmpty (NonEmpty) import Data.Misc (HttpsUrl (..), IpAddr (IpAddr), Port (..)) -import qualified Data.Swagger.Build.Api as Doc +import Data.Schema +import Data.String.Conversions (cs) +import qualified Data.Swagger as S import qualified Data.Text as Text import Data.Text.Ascii import qualified Data.Text.Encoding as TE @@ -110,6 +111,7 @@ data RTCConfiguration = RTCConfiguration } deriving stock (Eq, Show, Generic) deriving (Arbitrary) via (GenericUniform RTCConfiguration) + deriving (A.ToJSON, A.FromJSON, S.ToSchema) via (Schema RTCConfiguration) rtcConfiguration :: NonEmpty RTCIceServer -> @@ -119,35 +121,18 @@ rtcConfiguration :: RTCConfiguration rtcConfiguration = RTCConfiguration -modelRtcConfiguration :: Doc.Model -modelRtcConfiguration = Doc.defineModel "RTCConfiguration" $ do - Doc.description "A subset of the WebRTC 'RTCConfiguration' dictionary" - Doc.property "ice_servers" (Doc.array (Doc.ref modelRtcIceServer)) $ - Doc.description "Array of 'RTCIceServer' objects" - Doc.property "sft_servers" (Doc.array (Doc.ref modelRtcSftServer)) $ - Doc.description "Array of 'SFTServer' objects (optional)" - Doc.property "ttl" Doc.int32' $ - Doc.description "Number of seconds after which the configuration should be refreshed (advisory)" - Doc.property "sft_servers_all" (Doc.array (Doc.ref modelRtcSftServerUrl)) $ - Doc.description "Array of all SFT servers" - -instance ToJSON RTCConfiguration where - toJSON (RTCConfiguration srvs sfts ttl all_servers) = - object - ( [ "ice_servers" .= srvs, - "ttl" .= ttl - ] - <> ["sft_servers" .= sfts | isJust sfts] - <> ["sft_servers_all" .= all_servers | isJust all_servers] - ) - -instance FromJSON RTCConfiguration where - parseJSON = withObject "RTCConfiguration" $ \o -> - RTCConfiguration - <$> o .: "ice_servers" - <*> o .:? "sft_servers" - <*> o .: "ttl" - <*> o .:? "sft_servers_all" +instance ToSchema RTCConfiguration where + schema = + objectWithDocModifier "RTCConfiguration" (description ?~ "A subset of the WebRTC 'RTCConfiguration' dictionary") $ + RTCConfiguration + <$> _rtcConfIceServers + .= fieldWithDocModifier "ice_servers" (description ?~ "Array of 'RTCIceServer' objects") (nonEmptyArray schema) + <*> _rtcConfSftServers + .= maybe_ (optFieldWithDocModifier "sft_servers" (description ?~ "Array of 'SFTServer' objects (optional)") (nonEmptyArray schema)) + <*> _rtcConfTTL + .= fieldWithDocModifier "ttl" (description ?~ "Number of seconds after which the configuration should be refreshed (advisory)") schema + <*> _rtcConfSftServersAll + .= maybe_ (optFieldWithDocModifier "sft_servers_all" (description ?~ "Array of all SFT servers") (array schema)) -------------------------------------------------------------------------------- -- SFTServer @@ -157,34 +142,22 @@ newtype SFTServer = SFTServer } deriving stock (Eq, Show, Ord, Generic) deriving (Arbitrary) via (GenericUniform SFTServer) - -instance ToJSON SFTServer where - toJSON (SFTServer url) = - object - [ "urls" .= [url] - ] - -instance FromJSON SFTServer where - parseJSON = withObject "SFTServer" $ \o -> - o .: "urls" >>= \case - [url] -> pure $ SFTServer url - xs -> fail $ "SFTServer can only have exactly one URL, found " <> show (length xs) + deriving (A.ToJSON, A.FromJSON, S.ToSchema) via (Schema SFTServer) + +instance ToSchema SFTServer where + schema = + objectWithDocModifier "SftServer" (description ?~ "Inspired by WebRTC 'RTCIceServer' object, contains details of SFT servers") $ + SFTServer + <$> (pure . _sftURL) + .= fieldWithDocModifier "urls" (description ?~ "Array containing exactly one SFT server address of the form 'https://:'") (withParser (array schema) p) + where + p :: [HttpsUrl] -> A.Parser HttpsUrl + p [url] = pure url + p xs = fail $ "SFTServer can only have exactly one URL, found " <> show (length xs) sftServer :: HttpsUrl -> SFTServer sftServer = SFTServer -modelRtcSftServer :: Doc.Model -modelRtcSftServer = Doc.defineModel "RTC SFT Server" $ do - Doc.description "Inspired by WebRTC 'RTCIceServer' object, contains details of SFT servers" - Doc.property "urls" (Doc.array Doc.string') $ - Doc.description "Array containing exactly one SFT server address of the form 'https://:'" - -modelRtcSftServerUrl :: Doc.Model -modelRtcSftServerUrl = Doc.defineModel "RTC SFT Server URL" $ do - Doc.description "Inspired by WebRTC 'RTCIceServer' object, contains details of SFT servers" - Doc.property "urls" (Doc.array Doc.string') $ - Doc.description "Array containing exactly one SFT server URL" - -------------------------------------------------------------------------------- -- RTCIceServer @@ -198,31 +171,21 @@ data RTCIceServer = RTCIceServer } deriving stock (Eq, Show, Generic) deriving (Arbitrary) via (GenericUniform RTCIceServer) + deriving (A.ToJSON, A.FromJSON, S.ToSchema) via (Schema RTCIceServer) rtcIceServer :: NonEmpty TurnURI -> TurnUsername -> AsciiBase64 -> RTCIceServer rtcIceServer = RTCIceServer -modelRtcIceServer :: Doc.Model -modelRtcIceServer = Doc.defineModel "RTCIceServer" $ do - Doc.description "A subset of the WebRTC 'RTCIceServer' object" - Doc.property "urls" (Doc.array Doc.string') $ - Doc.description "Array of TURN server addresses of the form 'turn::'" - Doc.property "username" Doc.string' $ - Doc.description "Username to use for authenticating against the given TURN servers" - Doc.property "credential" Doc.string' $ - Doc.description "Password to use for authenticating against the given TURN servers" - -instance ToJSON RTCIceServer where - toJSON (RTCIceServer urls name cred) = - object - [ "urls" .= urls, - "username" .= name, - "credential" .= cred - ] - -instance FromJSON RTCIceServer where - parseJSON = withObject "RTCIceServer" $ \o -> - RTCIceServer <$> o .: "urls" <*> o .: "username" <*> o .: "credential" +instance ToSchema RTCIceServer where + schema = + objectWithDocModifier "RTCIceServer" (description ?~ "A subset of the WebRTC 'RTCIceServer' object") $ + RTCIceServer + <$> _iceURLs + .= fieldWithDocModifier "urls" (description ?~ "Array of TURN server addresses of the form 'turn::'") (nonEmptyArray schema) + <*> _iceUsername + .= fieldWithDocModifier "username" (description ?~ "Username to use for authenticating against the given TURN servers") schema + <*> _iceCredential + .= fieldWithDocModifier "credential" (description ?~ "Password to use for authenticating against the given TURN servers") schema -------------------------------------------------------------------------------- -- TurnURI @@ -244,6 +207,10 @@ data TurnURI = TurnURI _turiTransport :: Maybe Transport } deriving stock (Eq, Show, Ord, Generic) + deriving (A.ToJSON, A.FromJSON, S.ToSchema) via (Schema TurnURI) + +instance ToSchema TurnURI where + schema = (cs . toByteString) .= parsedText "TurnURI" parseTurnURI turnURI :: Scheme -> TurnHost -> Port -> Maybe Transport -> TurnURI turnURI = TurnURI @@ -277,12 +244,6 @@ parseTurnURI = parseOnly (parser <* endOfInput) Just ok -> pure ok Nothing -> fail (err ++ " failed when parsing: " ++ show x) -instance ToJSON TurnURI where - toJSON = String . TE.decodeUtf8 . BC.toByteString' - -instance FromJSON TurnURI where - parseJSON = withText "TurnURI" $ either fail pure . parseTurnURI - instance Arbitrary TurnURI where arbitrary = (getGenericUniform <$> arbitrary) `QC.suchThat` (not . isIPv6) where @@ -295,6 +256,7 @@ data Scheme | SchemeTurns deriving stock (Eq, Show, Ord, Generic) deriving (Arbitrary) via (GenericUniform Scheme) + deriving (A.ToJSON, A.FromJSON, S.ToSchema) via (Schema Scheme) instance BC.ToByteString Scheme where builder SchemeTurn = "turn" @@ -307,19 +269,63 @@ instance BC.FromByteString Scheme where "turns" -> pure SchemeTurns _ -> fail $ "Invalid turn scheme: " ++ show t -instance ToJSON Scheme where - toJSON = String . TE.decodeUtf8 . BC.toByteString' - -instance FromJSON Scheme where - parseJSON = - withText "Scheme" $ - either fail pure . BC.runParser BC.parser . TE.encodeUtf8 +instance ToSchema Scheme where + schema = + enum @Text "Scheme" $ + mconcat + [ element "turn" SchemeTurn, + element "turns" SchemeTurns + ] data TurnHost = TurnHostIp IpAddr | TurnHostName Text deriving stock (Eq, Show, Ord, Generic) - deriving anyclass (ToJSON, FromJSON) + deriving (A.ToJSON, A.FromJSON, S.ToSchema) via (Schema TurnHost) + +instance ToSchema TurnHost where + schema = turnHostSchema + +data TurnHostTag = TurnHostIpTag | TurnHostNameTag + deriving (Eq, Enum, Bounded) + +tagSchema :: ValueSchema NamedSwaggerDoc TurnHostTag +tagSchema = + enum @Text "TurnHostTag" $ + mconcat + [ element "TurnHostIp" TurnHostIpTag, + element "TurnHostName" TurnHostNameTag + ] + +turnHostSchema :: ValueSchema NamedSwaggerDoc TurnHost +turnHostSchema = + object "TurnHost" $ + fromTagged + <$> toTagged + .= bind + (fst .= field "tag" tagSchema) + (snd .= fieldOver _1 "contents" untaggedSchema) + where + toTagged :: TurnHost -> (TurnHostTag, TurnHost) + toTagged d@(TurnHostIp _) = (TurnHostIpTag, d) + toTagged d@(TurnHostName _) = (TurnHostNameTag, d) + + fromTagged :: (TurnHostTag, TurnHost) -> TurnHost + fromTagged = snd + + untaggedSchema = dispatch $ \case + TurnHostIpTag -> tag _TurnHostIp (unnamed schema) + TurnHostNameTag -> tag _TurnHostName (unnamed schema) + + _TurnHostIp :: Prism' TurnHost IpAddr + _TurnHostIp = prism' TurnHostIp $ \case + TurnHostIp a -> Just a + _ -> Nothing + + _TurnHostName :: Prism' TurnHost Text + _TurnHostName = prism' TurnHostName $ \case + TurnHostName b -> Just b + _ -> Nothing instance BC.FromByteString TurnHost where parser = BC.parser >>= maybe (fail "Invalid turn host") pure . parseTurnHost @@ -362,6 +368,7 @@ data Transport | TransportTCP deriving stock (Eq, Show, Ord, Generic) deriving (Arbitrary) via (GenericUniform Transport) + deriving (A.ToJSON, A.FromJSON, S.ToSchema) via (Schema Transport) instance BC.ToByteString Transport where builder TransportUDP = "udp" @@ -374,13 +381,13 @@ instance BC.FromByteString Transport where "tcp" -> pure TransportTCP _ -> fail $ "Invalid turn transport: " ++ show t -instance ToJSON Transport where - toJSON = String . TE.decodeUtf8 . BC.toByteString' - -instance FromJSON Transport where - parseJSON = - withText "Transport" $ - either fail pure . BC.runParser BC.parser . TE.encodeUtf8 +instance ToSchema Transport where + schema = + enum @Text "Transport" $ + mconcat + [ element "udp" TransportUDP, + element "tcp" TransportTCP + ] -------------------------------------------------------------------------------- -- TurnUsername @@ -397,6 +404,7 @@ data TurnUsername = TurnUsername _tuRandom :: Text } deriving stock (Eq, Show, Generic) + deriving (A.ToJSON, A.FromJSON, S.ToSchema) via (Schema TurnUsername) -- note that the random value is not checked for well-formedness turnUsername :: POSIXTime -> Text -> TurnUsername @@ -409,13 +417,14 @@ turnUsername expires rnd = _tuRandom = rnd } -instance ToJSON TurnUsername where - toJSON = String . view utf8 . BC.toByteString' +instance ToSchema TurnUsername where + schema = toText .= parsedText "" fromText + where + fromText :: Text -> Either String TurnUsername + fromText = parseOnly (parseTurnUsername <* endOfInput) -instance FromJSON TurnUsername where - parseJSON = - withText "TurnUsername" $ - either fail pure . parseOnly (parseTurnUsername <* endOfInput) + toText :: TurnUsername -> Text + toText = cs . toByteString instance BC.ToByteString TurnUsername where builder tu = @@ -430,7 +439,7 @@ instance BC.ToByteString TurnUsername where <> shortByteString ".r=" <> byteString (view (re utf8) (_tuRandom tu)) -parseTurnUsername :: Parser TurnUsername +parseTurnUsername :: Text.Parser TurnUsername parseTurnUsername = TurnUsername <$> (string "d=" *> fmap (fromIntegral :: Word64 -> POSIXTime) decimal) 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 b48d3e1cb79..ff31ab1ac85 100644 --- a/libs/wire-api/src/Wire/API/Routes/Public/Brig.hs +++ b/libs/wire-api/src/Wire/API/Routes/Public/Brig.hs @@ -41,6 +41,7 @@ import Servant (JSON) import Servant hiding (Handler, JSON, addHeader, respond) import Servant.Swagger (HasSwagger (toSwagger)) import Servant.Swagger.Internal.Orphans () +import Wire.API.Call.Config (RTCConfiguration) import Wire.API.Connection hiding (MissingLegalholdConsent) import Wire.API.Error import Wire.API.Error.Brig @@ -68,6 +69,27 @@ import Wire.API.User.RichInfo (RichInfoAssocList) import Wire.API.User.Search (Contact, RoleFilter, SearchResult, TeamContact, TeamUserSearchSortBy, TeamUserSearchSortOrder) import Wire.API.UserMap +type BrigAPI = + UserAPI + :<|> SelfAPI + :<|> AccountAPI + :<|> ClientAPI + :<|> PrekeyAPI + :<|> UserClientAPI + :<|> ConnectionAPI + :<|> PropertiesAPI + :<|> MLSAPI + :<|> UserHandleAPI + :<|> SearchAPI + :<|> AuthAPI + :<|> CallingAPI + +brigSwagger :: Swagger +brigSwagger = toSwagger (Proxy @BrigAPI) + +------------------------------------------------------------------------------- +-- User API + type MaxUsersForListClientsBulk = 500 type GetUserVerb = @@ -524,8 +546,10 @@ instance ToSchema DeprecatedMatchingResult where object "DeprecatedMatchingResult" $ DeprecatedMatchingResult - <$ const [] .= field "results" (array (null_ @SwaggerDoc)) - <* const [] .= field "auto-connects" (array (null_ @SwaggerDoc)) + <$ const [] + .= field "results" (array (null_ @SwaggerDoc)) + <* const [] + .= field "auto-connects" (array (null_ @SwaggerDoc)) data ActivationRespWithStatus = ActivationResp ActivationResponse @@ -1254,19 +1278,34 @@ type AuthAPI = :> MultiVerb1 'POST '[JSON] (RespondEmpty 200 "Cookies revoked") ) -type BrigAPI = - UserAPI - :<|> SelfAPI - :<|> AccountAPI - :<|> ClientAPI - :<|> PrekeyAPI - :<|> UserClientAPI - :<|> ConnectionAPI - :<|> PropertiesAPI - :<|> MLSAPI - :<|> UserHandleAPI - :<|> SearchAPI - :<|> AuthAPI +------------------------------------------------------------------------------- +-- Calling API -brigSwagger :: Swagger -brigSwagger = toSwagger (Proxy @BrigAPI) +type CallingAPI = + -- Deprecated endpoint, but still used by old clients. + -- See https://github.com/zinfra/backend-issues/issues/1616 for context + Named + "get-calls-config" + ( Summary + "[deprecated] Retrieve TURN server addresses and credentials for \ + \ IP addresses, scheme `turn` and transport `udp` only" + :> ZUser + :> ZConn + :> "calls" + :> "config" + :> Get '[JSON] RTCConfiguration + ) + :<|> Named + "get-calls-config-v2" + ( Summary + "Retrieve all TURN server addresses and credentials. \ + \Clients are expected to do a DNS lookup to resolve \ + \the IP addresses of the given hostnames " + :> ZUser + :> ZConn + :> "calls" + :> "config" + :> "v2" + :> QueryParam' '[Optional, Strict, Description "Limit resulting list. Allowed values [1..10]"] "limit" (Range 1 10 Int) + :> Get '[JSON] RTCConfiguration + ) diff --git a/libs/wire-api/src/Wire/API/Swagger.hs b/libs/wire-api/src/Wire/API/Swagger.hs index 9a133e98ead..575ded7007e 100644 --- a/libs/wire-api/src/Wire/API/Swagger.hs +++ b/libs/wire-api/src/Wire/API/Swagger.hs @@ -18,7 +18,6 @@ module Wire.API.Swagger where import Data.Swagger.Build.Api (Model) -import qualified Wire.API.Call.Config as Call.Config import qualified Wire.API.Connection as Connection import qualified Wire.API.Conversation as Conversation import qualified Wire.API.Conversation.Code as Conversation.Code @@ -44,9 +43,7 @@ import qualified Wire.API.User.Search as User.Search models :: [Model] models = - [ Call.Config.modelRtcConfiguration, - Call.Config.modelRtcIceServer, - Connection.modelConnectionList, + [ Connection.modelConnectionList, Connection.modelConnection, Connection.modelConnectionUpdate, Conversation.modelConversation, diff --git a/services/brig/src/Brig/API/Public.hs b/services/brig/src/Brig/API/Public.hs index 09c233e98ad..d9cd8b71d81 100644 --- a/services/brig/src/Brig/API/Public.hs +++ b/services/brig/src/Brig/API/Public.hs @@ -113,7 +113,7 @@ import Wire.API.Error import qualified Wire.API.Error.Brig as E import qualified Wire.API.Properties as Public import qualified Wire.API.Routes.MultiTablePaging as Public -import Wire.API.Routes.Named +import Wire.API.Routes.Named (Named (Named)) import Wire.API.Routes.Public.Brig import qualified Wire.API.Routes.Public.Cannon as CannonAPI import qualified Wire.API.Routes.Public.Cargohold as CargoholdAPI @@ -195,6 +195,7 @@ servantSitemap = :<|> userHandleAPI :<|> searchAPI :<|> authAPI + :<|> callingAPI where userAPI :: ServerT UserAPI (Handler r) userAPI = @@ -312,6 +313,11 @@ servantSitemap = :<|> Named @"list-cookies" listCookies :<|> Named @"remove-cookies" removeCookies + callingAPI :: ServerT CallingAPI (Handler r) + callingAPI = + Named @"get-calls-config" Calling.getCallsConfig + :<|> Named @"get-calls-config-v2" Calling.getCallsConfigV2 + -- Note [ephemeral user sideeffect] -- If the user is ephemeral and expired, it will be removed upon calling -- CheckUserExists[Un]Qualified, see 'Brig.API.User.userGC'. @@ -333,7 +339,6 @@ sitemap :: sitemap = do Provider.routesPublic Team.routesPublic - Calling.routesPublic apiDocs :: forall r. diff --git a/services/brig/src/Brig/Calling/API.hs b/services/brig/src/Brig/Calling/API.hs index c6e48162fbc..41dcb19298f 100644 --- a/services/brig/src/Brig/Calling/API.hs +++ b/services/brig/src/Brig/Calling/API.hs @@ -18,7 +18,8 @@ -- with this program. If not, see . module Brig.Calling.API - ( routesPublic, + ( getCallsConfig, + getCallsConfigV2, -- * Exposed for testing purposes newConfig, @@ -45,16 +46,10 @@ import Data.List.NonEmpty (NonEmpty (..)) import qualified Data.List.NonEmpty as NonEmpty import Data.Misc (HttpsUrl) import Data.Range -import qualified Data.Swagger.Build.Api as Doc import Data.Text.Ascii (AsciiBase64, encodeBase64) import Data.Text.Strict.Lens import Data.Time.Clock.POSIX (getPOSIXTime) import Imports hiding (head) -import Network.Wai (Response) -import Network.Wai.Predicate hiding (and, result, setStatus, (#)) -import Network.Wai.Routing hiding (toList) -import Network.Wai.Utilities hiding (code, message) -import Network.Wai.Utilities.Swagger (document) import OpenSSL.EVP.Digest (Digest, hmacBS) import Polysemy import qualified Polysemy.Error as Polysemy @@ -65,42 +60,6 @@ import qualified Wire.API.Call.Config as Public import Wire.Network.DNS.SRV (srvTarget) import Wire.Sem.Logger.TinyLog (loggerToTinyLog) -routesPublic :: Routes Doc.ApiBuilder (Handler r) () -routesPublic = do - -- Deprecated endpoint, but still used by old clients. - -- See https://github.com/zinfra/backend-issues/issues/1616 for context - get "/calls/config" (continue getCallsConfigH) $ - accept "application" "json" - .&. header "Z-User" - .&. header "Z-Connection" - document "GET" "getCallsConfig" $ do - Doc.deprecated - Doc.summary - "Retrieve TURN server addresses and credentials for \ - \ IP addresses, scheme `turn` and transport `udp` only " - Doc.returns (Doc.ref Public.modelRtcConfiguration) - Doc.response 200 "RTCConfiguration" Doc.end - - get "/calls/config/v2" (continue getCallsConfigV2H) $ - accept "application" "json" - .&. header "Z-User" - .&. header "Z-Connection" - .&. opt (query "limit") - document "GET" "getCallsConfigV2" $ do - Doc.summary - "Retrieve all TURN server addresses and credentials. \ - \Clients are expected to do a DNS lookup to resolve \ - \the IP addresses of the given hostnames " - Doc.parameter Doc.Query "limit" Doc.int32' $ do - Doc.description "Limit resulting list. Allowes values [1..10]" - Doc.optional - Doc.returns (Doc.ref Public.modelRtcConfiguration) - Doc.response 200 "RTCConfiguration" Doc.end - -getCallsConfigV2H :: JSON ::: UserId ::: ConnId ::: Maybe (Range 1 10 Int) -> (Handler r) Response -getCallsConfigV2H (_ ::: uid ::: connid ::: limit) = - json <$> getCallsConfigV2 uid connid limit - -- | ('UserId', 'ConnId' are required as args here to make sure this is an authenticated end-point.) getCallsConfigV2 :: UserId -> ConnId -> Maybe (Range 1 10 Int) -> (Handler r) Public.RTCConfiguration getCallsConfigV2 _ _ limit = do @@ -121,7 +80,7 @@ getCallsConfigV2 _ _ limit = do handleNoTurnServers eitherConfig -- | Throws '500 Internal Server Error' when no turn servers are found. This is --- done to keep backwards compatiblity, the previous code initialized an 'IORef' +-- done to keep backwards compatibility, the previous code initialized an 'IORef' -- with an 'error' so reading the 'IORef' threw a 500. -- -- FUTUREWORK: Making this a '404 Not Found' would be more idiomatic, but this @@ -132,10 +91,6 @@ handleNoTurnServers (Left NoTurnServers) = do Log.err $ Log.msg (Log.val "Call config requested before TURN URIs could be discovered.") throwE $ StdError internalServerError -getCallsConfigH :: JSON ::: UserId ::: ConnId -> (Handler r) Response -getCallsConfigH (_ ::: uid ::: connid) = - json <$> getCallsConfig uid connid - getCallsConfig :: UserId -> ConnId -> (Handler r) Public.RTCConfiguration getCallsConfig _ _ = do env <- view turnEnv From 73e82f1554de81020c04952383ddca6d8dc2253a Mon Sep 17 00:00:00 2001 From: jschaul Date: Mon, 7 Nov 2022 12:02:13 +0100 Subject: [PATCH 06/76] remove buildah references (#2822) --- Makefile | 20 -------- changelog.d/5-internal/buildah-drop-support | 1 + docs/src/developer/developer/dependencies.md | 6 --- docs/src/developer/developer/how-to.md | 13 ++--- hack/bin/buildah-clean.sh | 9 ---- hack/bin/buildah-compile.sh | 30 ------------ hack/bin/buildah-inside.sh | 16 ------ hack/bin/buildah-make-images-nginz.sh | 37 -------------- hack/bin/buildah-make-images.sh | 51 -------------------- hack/bin/buildah-purge-untagged.sh | 6 --- 10 files changed, 6 insertions(+), 183 deletions(-) create mode 100644 changelog.d/5-internal/buildah-drop-support delete mode 100755 hack/bin/buildah-clean.sh delete mode 100755 hack/bin/buildah-compile.sh delete mode 100755 hack/bin/buildah-inside.sh delete mode 100755 hack/bin/buildah-make-images-nginz.sh delete mode 100755 hack/bin/buildah-make-images.sh delete mode 100755 hack/bin/buildah-purge-untagged.sh diff --git a/Makefile b/Makefile index a607d23bfe4..21f41da7dbc 100644 --- a/Makefile +++ b/Makefile @@ -14,9 +14,7 @@ CHARTS_INTEGRATION := wire-server databases-ephemeral redis-cluster fake-aws # this list could be generated from the folder names under ./charts/ like so: # CHARTS_RELEASE := $(shell find charts/ -maxdepth 1 -type d | xargs -n 1 basename | grep -v charts) CHARTS_RELEASE := wire-server redis-ephemeral redis-cluster databases-ephemeral fake-aws fake-aws-s3 fake-aws-sqs aws-ingress fluent-bit kibana backoffice calling-test demo-smtp elasticsearch-curator elasticsearch-external elasticsearch-ephemeral minio-external cassandra-external nginx-ingress-controller nginx-ingress-services reaper sftd restund coturn inbucket -BUILDAH_PUSH ?= 0 KIND_CLUSTER_NAME := wire-server -BUILDAH_KIND_LOAD ?= 1 package ?= all EXE_SCHEMA := ./dist/$(package)-schema @@ -409,24 +407,6 @@ upload-charts: charts-release echo-release-charts: @echo ${CHARTS_RELEASE} -.PHONY: buildah-docker -buildah-docker: buildah-docker-nginz - ./hack/bin/buildah-compile.sh all - BUILDAH_PUSH=${BUILDAH_PUSH} KIND_CLUSTER_NAME=${KIND_CLUSTER_NAME} BUILDAH_KIND_LOAD=${BUILDAH_KIND_LOAD} ./hack/bin/buildah-make-images.sh - -.PHONY: buildah-docker-nginz -buildah-docker-nginz: - BUILDAH_PUSH=${BUILDAH_PUSH} KIND_CLUSTER_NAME=${KIND_CLUSTER_NAME} BUILDAH_KIND_LOAD=${BUILDAH_KIND_LOAD} ./hack/bin/buildah-make-images-nginz.sh - -.PHONY: buildah-docker-% -buildah-docker-%: - ./hack/bin/buildah-compile.sh $(*) - BUILDAH_PUSH=${BUILDAH_PUSH} EXECUTABLES=$(*) KIND_CLUSTER_NAME=${KIND_CLUSTER_NAME} BUILDAH_KIND_LOAD=${BUILDAH_KIND_LOAD} ./hack/bin/buildah-make-images.sh - -.PHONY: buildah-clean -buildah-clean: - ./hack/bin/buildah-clean.sh - .PHONY: kind-cluster kind-cluster: kind create cluster --name $(KIND_CLUSTER_NAME) diff --git a/changelog.d/5-internal/buildah-drop-support b/changelog.d/5-internal/buildah-drop-support new file mode 100644 index 00000000000..2985ad28824 --- /dev/null +++ b/changelog.d/5-internal/buildah-drop-support @@ -0,0 +1 @@ +Remove support for compiling local docker images with buildah. Nix is used to build docker images these days diff --git a/docs/src/developer/developer/dependencies.md b/docs/src/developer/developer/dependencies.md index 15896f6d75d..68db64e56d9 100644 --- a/docs/src/developer/developer/dependencies.md +++ b/docs/src/developer/developer/dependencies.md @@ -254,12 +254,6 @@ Requirements: In both cases, you need to adjust the various integration configuration files and names so that this can work. -## Buildah (optional) - -[Buildah](https://buildah.io/) is used for local docker image creation during development. See [buildah installation](https://github.com/containers/buildah/blob/master/install.md) - -See `make buildah-docker` for an entry point here. - ## Helm chart development, integration tests in kubernetes You need `kubectl`, `helm`, `helmfile`, and a valid kubernetes context. Refer to https://docs.wire.com for details. diff --git a/docs/src/developer/developer/how-to.md b/docs/src/developer/developer/how-to.md index 3c98cfa869c..0ed606399b3 100644 --- a/docs/src/developer/developer/how-to.md +++ b/docs/src/developer/developer/how-to.md @@ -108,10 +108,10 @@ FUTUREWORK: this process is in development (update this section after it's confi ##### (i) Build images -1. Ensure `buildah` is available on your system. -2. Compile the image using `make buildah-docker`. This will try to upload the - images into a `kind` cluster. If you'd prefer uploading images to quay.io, - you can run it with `make buildah-docker BUILDAH_PUSH=1 BUILDAH_KIND_LOAD=0` +(FUTUREWORK: implement a convenient shortcut to build images without actually uploading them also) +``` +make upload-images-dev +``` ##### (ii) Run tests in kind @@ -120,7 +120,6 @@ FUTUREWORK: this process is in development (update this section after it's confi 2. Run tests using `make kind-integration-test`. 3. Run end2end integration tests: `make kind-integration-e2e`. -NOTE: debug this process further as some images (e.g. nginz) are missing from the default buildah steps. * Implement re-tagging development tags as your user tag? #### 2.4 Deploy your local code to a kubernetes cluster @@ -138,9 +137,7 @@ make kube-integration-setup Then build and push the `brig` image by running ``` -export DOCKER_TAG_LOCAL_BUILD=$USER -hack/bin/buildah-compile.sh all -DOCKER_TAG=$DOCKER_TAG_LOCAL_BUILD EXECUTABLES=brig BUILDAH_PUSH=1 ./hack/bin/buildah-make-images.sh +#FUTUREWORK ``` To update the release with brig's local image run diff --git a/hack/bin/buildah-clean.sh b/hack/bin/buildah-clean.sh deleted file mode 100755 index d0f49026e31..00000000000 --- a/hack/bin/buildah-clean.sh +++ /dev/null @@ -1,9 +0,0 @@ -#!/usr/bin/env bash - -set -e -DIR="$( cd "$( dirname "${BASH_SOURCE[0]}" )" && pwd )" -TOP_LEVEL="$(cd "$DIR/../.." && pwd)" - -rm -rf "$TOP_LEVEL"/buildah -# buildah rm wire-server-dev -buildah rm output diff --git a/hack/bin/buildah-compile.sh b/hack/bin/buildah-compile.sh deleted file mode 100755 index b49871aa36d..00000000000 --- a/hack/bin/buildah-compile.sh +++ /dev/null @@ -1,30 +0,0 @@ -#!/usr/bin/env bash - -# This compiles wire-server inside an ubuntu-based container based on quay.io/wire/ubuntu20-builder. -# the tool 'buildah' is used to mount some folders in, and to -# keep the caches of /.root/.cabal and dist-newstyle (renamed to avoid conflicts) for the next compilation - -# After compilation, ./buildah-make-images.sh can be used -# to bake individual executables into their respective docker images used by kubernetes. - -set -ex - -DIR="$( cd "$( dirname "${BASH_SOURCE[0]}" )" && pwd )" -TOP_LEVEL="$(cd "$DIR/../.." && pwd)" - -# Note: keep the following names and paths in sync with the other buildah-* scripts. -mkdir -p "$TOP_LEVEL"/buildah/dot-cabal -mkdir -p "$TOP_LEVEL"/buildah/dist-newstyle -mkdir -p "$TOP_LEVEL"/buildah/dist - -CONTAINER_NAME=wire-server-dev - -# check for the existence of; or create a working container -buildah containers | awk '{print $5}' | grep "$CONTAINER_NAME" \ - || buildah from --name "$CONTAINER_NAME" -v "${TOP_LEVEL}":/src --pull quay.io/wire/ubuntu20-builder:develop - -# copy /root/.cabal out of the container -ls "$TOP_LEVEL"/buildah/dot-cabal/store 2> /dev/null \ - || buildah run "$CONTAINER_NAME" -- cp -a /root/.cabal/. /src/buildah/dot-cabal - -buildah run "$CONTAINER_NAME" -- /src/hack/bin/buildah-inside.sh "$@" diff --git a/hack/bin/buildah-inside.sh b/hack/bin/buildah-inside.sh deleted file mode 100755 index a750e21df8a..00000000000 --- a/hack/bin/buildah-inside.sh +++ /dev/null @@ -1,16 +0,0 @@ -#!/usr/bin/env bash - -# This script is meant to be run from inside a buildah container. See buildah-compile.sh for details. - -set -e -DIR="$(cd "$(dirname "${BASH_SOURCE[0]}")" && pwd)" -TOP_LEVEL="$(cd "$DIR/../.." && pwd)" - -cd "$TOP_LEVEL" - -cabal build \ - --prefix=./buildah/dot-cabal \ - --builddir=./buildah/dist-newstyle \ - "$@" - -DIST="$TOP_LEVEL"/buildah/dist PLAN_FILE="$TOP_LEVEL"/buildah/dist-newstyle/cache/plan.json ./hack/bin/cabal-install-artefacts.sh "$@" diff --git a/hack/bin/buildah-make-images-nginz.sh b/hack/bin/buildah-make-images-nginz.sh deleted file mode 100755 index dba85bf94fa..00000000000 --- a/hack/bin/buildah-make-images-nginz.sh +++ /dev/null @@ -1,37 +0,0 @@ -#!/usr/bin/env bash - -# Pulls nginz and nginz_disco images from quay.io into buildah store, and loads -# them into the kind cluster - -set -ex - -DIR="$(cd "$(dirname "${BASH_SOURCE[0]}")" && pwd)" -TOP_LEVEL="$(cd "$DIR/../.." && pwd)" - -DOCKER_DOWNLOAD_TAG=latest -DOCKER_TAG=${DOCKER_TAG:-$USER} -EXECUTABLES=${EXECUTABLES:-"nginz nginz_disco"} - -for EX in $EXECUTABLES; do - CONTAINER_NAME=$EX - buildah containers | awk '{print $5}' | grep "$CONTAINER_NAME" || - buildah from --name "$CONTAINER_NAME" -v "${TOP_LEVEL}":/src --pull "quay.io/wire/$CONTAINER_NAME:$DOCKER_DOWNLOAD_TAG" - buildah tag "quay.io/wire/$CONTAINER_NAME:$DOCKER_DOWNLOAD_TAG" "quay.io/wire/$CONTAINER_NAME:$DOCKER_TAG" - if [[ "$BUILDAH_KIND_LOAD" -eq "1" ]]; then - archiveDir=$(mktemp -d) - imgPath="$archiveDir/${EX}_${DOCKER_TAG}.tar" - imgName="quay.io/wire/$EX:$DOCKER_TAG" - buildah push "$imgName" "docker-archive:$imgPath:$imgName" - kind load image-archive --name "$KIND_CLUSTER_NAME" "$imgPath" - rm -rf "$archiveDir" - fi -done - -if [[ "$BUILDAH_PUSH" -eq "1" ]]; then - for EX in $EXECUTABLES; do - buildah push "quay.io/wire/$EX:$DOCKER_TAG" - done -fi - -# general cleanup -"$DIR/buildah-purge-untagged.sh" diff --git a/hack/bin/buildah-make-images.sh b/hack/bin/buildah-make-images.sh deleted file mode 100755 index cc06f2c102b..00000000000 --- a/hack/bin/buildah-make-images.sh +++ /dev/null @@ -1,51 +0,0 @@ -#!/usr/bin/env bash - -set -ex - -DIR="$(cd "$(dirname "${BASH_SOURCE[0]}")" && pwd)" -TOP_LEVEL="$(cd "$DIR/../.." && pwd)" - -EXECUTABLES=${EXECUTABLES:-"cannon brig cargohold galley gundeck federator brig-index brig-schema galley-schema galley-migrate-data gundeck-schema proxy spar spar-schema spar-migrate-data brig-integration galley-integration spar-integration gundeck-integration cargohold-integration federator-integration"} -CONTAINER_NAME="output" -DOCKER_TAG=${DOCKER_TAG:-$USER} - -buildah containers | awk '{print $5}' | grep "$CONTAINER_NAME" || - buildah from --name "$CONTAINER_NAME" -v "${TOP_LEVEL}":/src --pull quay.io/wire/ubuntu20-deps:develop - -# Only brig needs these templates, but for simplicity we add them to all resulting images (optimization FUTUREWORK) -buildah run "$CONTAINER_NAME" -- sh -c 'mkdir -p /usr/share/wire/ && cp -r "/src/services/brig/deb/opt/brig/templates/." "/usr/share/wire/templates"' - -for EX in $EXECUTABLES; do - # Copy the main executable into the PATH on the container - buildah run "$CONTAINER_NAME" -- cp "/src/buildah/dist/$EX" "/usr/bin/$EX" - - # Start that executable by default when launching the docker image - buildah config --entrypoint "[ \"/usr/bin/dumb-init\", \"--\", \"/usr/bin/$EX\" ]" "$CONTAINER_NAME" - buildah config --cmd null "$CONTAINER_NAME" - - # Bake an image - buildah commit "$CONTAINER_NAME" quay.io/wire/"$EX":"$DOCKER_TAG" - - # remove executable from the image in preparation for the next iteration - buildah run "$CONTAINER_NAME" -- rm "/usr/bin/$EX" -done - -if [[ "$BUILDAH_PUSH" -eq "1" ]]; then - for EX in $EXECUTABLES; do - buildah push "quay.io/wire/$EX:$DOCKER_TAG" - done -fi - -if [[ "$BUILDAH_KIND_LOAD" -eq "1" ]]; then - archiveDir=$(mktemp -d) - for EX in $EXECUTABLES; do - imgPath="$archiveDir/${EX}_${DOCKER_TAG}.tar" - imgName="quay.io/wire/$EX:$DOCKER_TAG" - buildah push "$imgName" "docker-archive:$imgPath:$imgName" - kind load image-archive --name "$KIND_CLUSTER_NAME" "$imgPath" - done - rm -rf "$archiveDir" -fi - -# general cleanup -"$DIR/buildah-purge-untagged.sh" diff --git a/hack/bin/buildah-purge-untagged.sh b/hack/bin/buildah-purge-untagged.sh deleted file mode 100755 index da74d36854f..00000000000 --- a/hack/bin/buildah-purge-untagged.sh +++ /dev/null @@ -1,6 +0,0 @@ -#!/usr/bin/env bash - -# Remove untagged images (if there are any) in the buildah store -if buildah images | grep ""; then - buildah images | grep "" | awk '{print $3}' | xargs -n 1 buildah rmi -fi From e440e02699e453643d1f4b4d4c5b2ab8f60baa5b Mon Sep 17 00:00:00 2001 From: Arthur Wolf Date: Mon, 7 Nov 2022 13:20:53 +0100 Subject: [PATCH 07/76] adding note about deeplinks --- docs/src/how-to/associate/deeplink.rst | 3 +++ 1 file changed, 3 insertions(+) diff --git a/docs/src/how-to/associate/deeplink.rst b/docs/src/how-to/associate/deeplink.rst index 8ca5fe05a49..2923b73d2b3 100644 --- a/docs/src/how-to/associate/deeplink.rst +++ b/docs/src/how-to/associate/deeplink.rst @@ -20,6 +20,9 @@ Supported client apps: - iOS - Android +.. note:: + Wire deeplinks can be used to redirect a non-web Wire app (desktop, mobile) to a specific backend URL. Deeplinks have no further ability implemented at this stage. + Connecting to a custom backend utilizing a Deep Link ---------------------------------------------------- From 853cae6d1e76482446b8084c43e32586ae429185 Mon Sep 17 00:00:00 2001 From: Arthur Wolf Date: Mon, 7 Nov 2022 13:53:01 +0100 Subject: [PATCH 08/76] fixing the type of app this applies to --- docs/src/how-to/associate/deeplink.rst | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/docs/src/how-to/associate/deeplink.rst b/docs/src/how-to/associate/deeplink.rst index 2923b73d2b3..b8a9c3f94e3 100644 --- a/docs/src/how-to/associate/deeplink.rst +++ b/docs/src/how-to/associate/deeplink.rst @@ -21,7 +21,7 @@ Supported client apps: - Android .. note:: - Wire deeplinks can be used to redirect a non-web Wire app (desktop, mobile) to a specific backend URL. Deeplinks have no further ability implemented at this stage. + Wire deeplinks can be used to redirect a mobile (Android, iOs) Wire app to a specific backend URL. Deeplinks have no further ability implemented at this stage. Connecting to a custom backend utilizing a Deep Link ---------------------------------------------------- From 7fbbdc4778f86c7e0f72f95cc2b1f0c857da41e3 Mon Sep 17 00:00:00 2001 From: Arthur Wolf Date: Mon, 7 Nov 2022 13:53:30 +0100 Subject: [PATCH 09/76] iOS not iOs --- docs/src/how-to/associate/deeplink.rst | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/docs/src/how-to/associate/deeplink.rst b/docs/src/how-to/associate/deeplink.rst index b8a9c3f94e3..930cd4ad124 100644 --- a/docs/src/how-to/associate/deeplink.rst +++ b/docs/src/how-to/associate/deeplink.rst @@ -21,7 +21,7 @@ Supported client apps: - Android .. note:: - Wire deeplinks can be used to redirect a mobile (Android, iOs) Wire app to a specific backend URL. Deeplinks have no further ability implemented at this stage. + Wire deeplinks can be used to redirect a mobile (Android, iOS) Wire app to a specific backend URL. Deeplinks have no further ability implemented at this stage. Connecting to a custom backend utilizing a Deep Link ---------------------------------------------------- From d0970619fc59e324f929564ba4d3453757d206d9 Mon Sep 17 00:00:00 2001 From: Stefan Matting Date: Mon, 7 Nov 2022 14:35:30 +0100 Subject: [PATCH 10/76] bump nginx-module-vts from v0.1.15 to v0.2.1 (#2827) --- changelog.d/5-internal/bump-nginx-module-vts | 2 +- services/nginz/third_party/nginx-module-vts | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/changelog.d/5-internal/bump-nginx-module-vts b/changelog.d/5-internal/bump-nginx-module-vts index 011cc5d3f17..a2e4ab6582d 100644 --- a/changelog.d/5-internal/bump-nginx-module-vts +++ b/changelog.d/5-internal/bump-nginx-module-vts @@ -1 +1 @@ -bump nginx-module-vts from v0.1.15 to v0.2.1 +bump nginx-module-vts from v0.1.15 to v0.2.1 (#2827) diff --git a/services/nginz/third_party/nginx-module-vts b/services/nginz/third_party/nginx-module-vts index b606b13006f..0009b3bc668 160000 --- a/services/nginz/third_party/nginx-module-vts +++ b/services/nginz/third_party/nginx-module-vts @@ -1 +1 @@ -Subproject commit b606b13006ffc3c694e8e6326a85f629c1288568 +Subproject commit 0009b3bc668a7d73751c4cd8f8c0a161cba96832 From 51445a966a10fedc8112ea9e14e094712f8bce7b Mon Sep 17 00:00:00 2001 From: jschaul Date: Mon, 7 Nov 2022 18:44:32 +0100 Subject: [PATCH 11/76] Avoid client deletion edge case condition which can lead to inconsistent data between brig and galley's clients tables. (#2830) --- changelog.d/3-bug-fixes/client-deletion-ordering | 1 + services/brig/src/Brig/API/Client.hs | 2 +- 2 files changed, 2 insertions(+), 1 deletion(-) create mode 100644 changelog.d/3-bug-fixes/client-deletion-ordering diff --git a/changelog.d/3-bug-fixes/client-deletion-ordering b/changelog.d/3-bug-fixes/client-deletion-ordering new file mode 100644 index 00000000000..404d69af2f7 --- /dev/null +++ b/changelog.d/3-bug-fixes/client-deletion-ordering @@ -0,0 +1 @@ +Avoid client deletion edge case condition which can lead to inconsistent data between brig and galley's clients tables. diff --git a/services/brig/src/Brig/API/Client.hs b/services/brig/src/Brig/API/Client.hs index 8e2d114dff3..dd1e233f77f 100644 --- a/services/brig/src/Brig/API/Client.hs +++ b/services/brig/src/Brig/API/Client.hs @@ -374,10 +374,10 @@ claimLocalMultiPrekeyBundles protectee userClients = do -- | Enqueue an orderly deletion of an existing client. execDelete :: UserId -> Maybe ConnId -> Client -> (AppT r) () execDelete u con c = do - wrapClient $ Data.rmClient u (clientId c) for_ (clientCookie c) $ \l -> wrapClient $ Auth.revokeCookies u [] [l] queue <- view internalEvents Queue.enqueue queue (Internal.DeleteClient (clientId c) u con) + wrapClient $ Data.rmClient u (clientId c) -- | Defensive measure when no prekey is found for a -- requested client: Ensure that the client does indeed From aaf5b1c576b67913fe2d06a55978778df74711a9 Mon Sep 17 00:00:00 2001 From: Akshay Mankar Date: Tue, 8 Nov 2022 11:37:27 +0100 Subject: [PATCH 12/76] Bump nixpkgs to latest unstable, unpin openssl (#2828) * Bump nixpkgs to latest unstable, stop using forked nixpkgs * Use openssl 3.0.7 for HsOpenSSL Latest nixpkgs unstable contains the fixed version of openssl. * nix/sources.json: Update description and homepage `niv update` misses this: https://github.com/nmattia/niv/issues/358 --- changelog.d/5-internal/nixpkgs-bump | 1 + nix/manual-overrides.nix | 4 +--- nix/sources.json | 14 +++++++------- nix/wire-server.nix | 1 - 4 files changed, 9 insertions(+), 11 deletions(-) create mode 100644 changelog.d/5-internal/nixpkgs-bump diff --git a/changelog.d/5-internal/nixpkgs-bump b/changelog.d/5-internal/nixpkgs-bump new file mode 100644 index 00000000000..86b659bfcb8 --- /dev/null +++ b/changelog.d/5-internal/nixpkgs-bump @@ -0,0 +1 @@ +Bump nixpkgs to latest unstable. Stop using forked nixpkgs. \ No newline at end of file diff --git a/nix/manual-overrides.nix b/nix/manual-overrides.nix index 3a38a4435a3..0cecced5165 100644 --- a/nix/manual-overrides.nix +++ b/nix/manual-overrides.nix @@ -1,4 +1,4 @@ -{ libsodium, protobuf, hlib, mls-test-cli, openssl }: +{ libsodium, protobuf, hlib, mls-test-cli }: # 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: { @@ -58,6 +58,4 @@ hself: hsuper: { # Make hoogle static to reduce size of the hoogle image hoogle = hlib.justStaticExecutables hsuper.hoogle; - - HsOpenSSL = hsuper.HsOpenSSL.override { inherit openssl; }; } diff --git a/nix/sources.json b/nix/sources.json index 5c08ee0357e..2c25068a169 100644 --- a/nix/sources.json +++ b/nix/sources.json @@ -1,14 +1,14 @@ { "nixpkgs": { - "branch": "hls-hlint-plugin-workaround", - "description": "Wire's fork of NixOS/nixpkgs. Use until HLS > 1.7.0.0 is available in NixOS/nixpkgs", - "homepage": "https://github.com/wireapp/nixpkgs", - "owner": "wireapp", + "branch": "nixpkgs-unstable", + "description": "Nix Packages collection", + "homepage": "https://github.com/NixOS/nixpkgs", + "owner": "NixOS", "repo": "nixpkgs", - "rev": "0f8a37f54f802a9e8bcf3bcfa89c5ab2017d9498", - "sha256": "1g28g6m3bs8axwkih8ihnv2h8g53s267l7kpaghwxzr65bz6hj7w", + "rev": "1f3ebb2bd1a353a42e8f833895c26d8415c7b791", + "sha256": "03y1a3lv44b4fdnykyms5nd24v2mqn8acz1xa4jkbmryc29rsgcw", "type": "tarball", - "url": "https://github.com/wireapp/nixpkgs/archive/0f8a37f54f802a9e8bcf3bcfa89c5ab2017d9498.tar.gz", + "url": "https://github.com/NixOS/nixpkgs/archive/1f3ebb2bd1a353a42e8f833895c26d8415c7b791.tar.gz", "url_template": "https://github.com///archive/.tar.gz" } } diff --git a/nix/wire-server.nix b/nix/wire-server.nix index c3270518e42..03005e5bc02 100644 --- a/nix/wire-server.nix +++ b/nix/wire-server.nix @@ -123,7 +123,6 @@ let lib = pkgs.lib; ]; manualOverrides = import ./manual-overrides.nix (with pkgs; { inherit hlib libsodium protobuf mls-test-cli; - openssl = openssl_1_1; }); executables = hself: hsuper: From 026335b11be7a61c681b2ddc130812b89e2b86c3 Mon Sep 17 00:00:00 2001 From: Paolo Capriotti Date: Tue, 8 Nov 2022 13:47:18 +0100 Subject: [PATCH 13/76] Split galley servant definition (#2820) * Split galley servant definition * Split galley API routes --- changelog.d/5-internal/galley-servant-split | 1 + .../src/Wire/API/Federation/API/Galley.hs | 2 +- .../Federation/Golden/MessageSendResponse.hs | 2 +- libs/wire-api/src/Wire/API/Conversation.hs | 10 +- .../src/Wire/API/Event/Conversation.hs | 16 + .../src/Wire/API/Routes/Public/Galley.hs | 1866 +---------------- .../src/Wire/API/Routes/Public/Galley/Bot.hs | 46 + .../API/Routes/Public/Galley/Conversation.hs | 812 +++++++ .../API/Routes/Public/Galley/CustomBackend.hs | 37 + .../Wire/API/Routes/Public/Galley/Feature.hs | 260 +++ .../API/Routes/Public/Galley/LegalHold.hs | 234 +++ .../src/Wire/API/Routes/Public/Galley/MLS.hs | 132 ++ .../API/Routes/Public/Galley/Messaging.hs | 197 ++ .../src/Wire/API/Routes/Public/Galley/Team.hs | 101 + .../Routes/Public/Galley/TeamConversation.hs | 81 + .../API/Routes/Public/Galley/TeamMember.hs | 219 ++ libs/wire-api/wire-api.cabal | 10 + services/galley/galley.cabal | 10 + services/galley/src/Galley/API/Create.hs | 2 +- services/galley/src/Galley/API/Internal.hs | 3 +- services/galley/src/Galley/API/LegalHold.hs | 2 +- services/galley/src/Galley/API/Message.hs | 2 +- services/galley/src/Galley/API/Public/Bot.hs | 26 + .../src/Galley/API/Public/Conversation.hs | 72 + .../src/Galley/API/Public/CustomBackend.hs | 26 + .../galley/src/Galley/API/Public/Feature.hs | 76 + .../galley/src/Galley/API/Public/LegalHold.hs | 35 + services/galley/src/Galley/API/Public/MLS.hs | 31 + .../galley/src/Galley/API/Public/Messaging.hs | 30 + .../galley/src/Galley/API/Public/Servant.hs | 192 +- services/galley/src/Galley/API/Public/Team.hs | 31 + .../src/Galley/API/Public/TeamConversation.hs | 30 + .../src/Galley/API/Public/TeamMember.hs | 35 + services/galley/src/Galley/API/Teams.hs | 4 +- services/galley/src/Galley/API/Update.hs | 2 +- services/galley/src/Galley/API/Util.hs | 2 +- 36 files changed, 2598 insertions(+), 2039 deletions(-) create mode 100644 changelog.d/5-internal/galley-servant-split create mode 100644 libs/wire-api/src/Wire/API/Routes/Public/Galley/Bot.hs create mode 100644 libs/wire-api/src/Wire/API/Routes/Public/Galley/Conversation.hs create mode 100644 libs/wire-api/src/Wire/API/Routes/Public/Galley/CustomBackend.hs create mode 100644 libs/wire-api/src/Wire/API/Routes/Public/Galley/Feature.hs create mode 100644 libs/wire-api/src/Wire/API/Routes/Public/Galley/LegalHold.hs create mode 100644 libs/wire-api/src/Wire/API/Routes/Public/Galley/MLS.hs create mode 100644 libs/wire-api/src/Wire/API/Routes/Public/Galley/Messaging.hs create mode 100644 libs/wire-api/src/Wire/API/Routes/Public/Galley/Team.hs create mode 100644 libs/wire-api/src/Wire/API/Routes/Public/Galley/TeamConversation.hs create mode 100644 libs/wire-api/src/Wire/API/Routes/Public/Galley/TeamMember.hs create mode 100644 services/galley/src/Galley/API/Public/Bot.hs create mode 100644 services/galley/src/Galley/API/Public/Conversation.hs create mode 100644 services/galley/src/Galley/API/Public/CustomBackend.hs create mode 100644 services/galley/src/Galley/API/Public/Feature.hs create mode 100644 services/galley/src/Galley/API/Public/LegalHold.hs create mode 100644 services/galley/src/Galley/API/Public/MLS.hs create mode 100644 services/galley/src/Galley/API/Public/Messaging.hs create mode 100644 services/galley/src/Galley/API/Public/Team.hs create mode 100644 services/galley/src/Galley/API/Public/TeamConversation.hs create mode 100644 services/galley/src/Galley/API/Public/TeamMember.hs diff --git a/changelog.d/5-internal/galley-servant-split b/changelog.d/5-internal/galley-servant-split new file mode 100644 index 00000000000..450472e718a --- /dev/null +++ b/changelog.d/5-internal/galley-servant-split @@ -0,0 +1 @@ +Split galley API routes and handler definitions into several modules diff --git a/libs/wire-api-federation/src/Wire/API/Federation/API/Galley.hs b/libs/wire-api-federation/src/Wire/API/Federation/API/Galley.hs index ee690d531d6..e7d86ab700e 100644 --- a/libs/wire-api-federation/src/Wire/API/Federation/API/Galley.hs +++ b/libs/wire-api-federation/src/Wire/API/Federation/API/Galley.hs @@ -35,7 +35,7 @@ import Wire.API.Error.Galley import Wire.API.Federation.API.Common import Wire.API.Federation.Endpoint import Wire.API.Message -import Wire.API.Routes.Public.Galley +import Wire.API.Routes.Public.Galley.Messaging import Wire.API.Util.Aeson (CustomEncoded (..)) import Wire.Arbitrary (Arbitrary, GenericUniform (..)) diff --git a/libs/wire-api-federation/test/Test/Wire/API/Federation/Golden/MessageSendResponse.hs b/libs/wire-api-federation/test/Test/Wire/API/Federation/Golden/MessageSendResponse.hs index 21ec69477cf..efbcb2d93e7 100644 --- a/libs/wire-api-federation/test/Test/Wire/API/Federation/Golden/MessageSendResponse.hs +++ b/libs/wire-api-federation/test/Test/Wire/API/Federation/Golden/MessageSendResponse.hs @@ -25,7 +25,7 @@ import GHC.Exts (IsList (fromList)) import Imports import Wire.API.Federation.API.Galley (MessageSendResponse (..)) import Wire.API.Message -import Wire.API.Routes.Public.Galley +import Wire.API.Routes.Public.Galley.Messaging import Wire.API.User.Client (QualifiedUserClients (..)) missing :: QualifiedUserClients diff --git a/libs/wire-api/src/Wire/API/Conversation.hs b/libs/wire-api/src/Wire/API/Conversation.hs index f25b4f3ae07..e55df61782f 100644 --- a/libs/wire-api/src/Wire/API/Conversation.hs +++ b/libs/wire-api/src/Wire/API/Conversation.hs @@ -104,9 +104,9 @@ import Data.List.Extra (disjointOrd) import Data.List.NonEmpty (NonEmpty) import Data.List1 import Data.Misc -import Data.Proxy (Proxy (Proxy)) import Data.Qualified (Qualified (qUnqualified), deprecatedSchema) import Data.Range (Range, fromRange, rangedSchema) +import Data.SOP import Data.Schema import qualified Data.Set as Set import Data.String.Conversions (cs) @@ -121,6 +121,7 @@ import Wire.API.Conversation.Protocol import Wire.API.Conversation.Role (RoleName, roleNameWireAdmin) import Wire.API.MLS.Group import Wire.API.Routes.MultiTablePaging +import Wire.API.Routes.MultiVerb import Wire.Arbitrary -------------------------------------------------------------------------------- @@ -949,3 +950,10 @@ namespaceMLSSelfConv :: UUID.UUID namespaceMLSSelfConv = -- a V5 uuid created with the nil namespace fromJust . UUID.fromString $ "3eac2a2c-3850-510b-bd08-8a98e80dd4d9" + +-------------------------------------------------------------------------------- +-- MultiVerb instances + +instance AsHeaders '[ConvId] Conversation Conversation where + toHeaders c = (I (qUnqualified (cnvQualifiedId c)) :* Nil, c) + fromHeaders = snd diff --git a/libs/wire-api/src/Wire/API/Event/Conversation.hs b/libs/wire-api/src/Wire/API/Event/Conversation.hs index f05018432db..58b50fce8e4 100644 --- a/libs/wire-api/src/Wire/API/Event/Conversation.hs +++ b/libs/wire-api/src/Wire/API/Event/Conversation.hs @@ -73,6 +73,7 @@ import qualified Data.Aeson.KeyMap as KeyMap import Data.Id import Data.Json.Util import Data.Qualified +import Data.SOP import Data.Schema import qualified Data.Swagger as S import Data.Time @@ -83,6 +84,7 @@ import Wire.API.Conversation import Wire.API.Conversation.Code (ConversationCode (..)) import Wire.API.Conversation.Role import Wire.API.Conversation.Typing (TypingData (..)) +import Wire.API.Routes.MultiVerb import Wire.API.User (QualifiedUserIdList (..)) import Wire.Arbitrary (Arbitrary (arbitrary), GenericUniform (..)) @@ -413,3 +415,17 @@ instance ToJSON Event where instance S.ToSchema Event where declareNamedSchema = schemaToSwagger + +-------------------------------------------------------------------------------- +-- MultiVerb instances + +instance + (ResponseType r1 ~ ConversationCode, ResponseType r2 ~ Event) => + AsUnion '[r1, r2] AddCodeResult + where + toUnion (CodeAlreadyExisted c) = Z (I c) + toUnion (CodeAdded e) = S (Z (I e)) + + fromUnion (Z (I c)) = CodeAlreadyExisted c + fromUnion (S (Z (I e))) = CodeAdded e + fromUnion (S (S x)) = case x of {} diff --git a/libs/wire-api/src/Wire/API/Routes/Public/Galley.hs b/libs/wire-api/src/Wire/API/Routes/Public/Galley.hs index 4a8791a9026..a1d786c15aa 100644 --- a/libs/wire-api/src/Wire/API/Routes/Public/Galley.hs +++ b/libs/wire-api/src/Wire/API/Routes/Public/Galley.hs @@ -20,153 +20,21 @@ module Wire.API.Routes.Public.Galley where -import qualified Data.Code as Code -import Data.CommaSeparatedList -import Data.Domain (Domain) -import Data.Id (ConvId, TeamId, UserId) -import Data.Qualified (Qualified (..)) -import Data.Range import Data.SOP import qualified Data.Swagger as Swagger -import GHC.TypeLits (AppendSymbol) -import qualified Generics.SOP as GSOP -import Imports hiding (head) import Servant hiding (WithStatus) import Servant.Swagger.Internal import Servant.Swagger.Internal.Orphans () -import Wire.API.Conversation -import Wire.API.Conversation.Role -import Wire.API.CustomBackend (CustomBackend) -import Wire.API.Error -import qualified Wire.API.Error.Brig as BrigError -import Wire.API.Error.Galley -import Wire.API.Event.Conversation -import Wire.API.MLS.CommitBundle -import Wire.API.MLS.Keys -import Wire.API.MLS.Message -import Wire.API.MLS.PublicGroupState -import Wire.API.MLS.Serialisation -import Wire.API.MLS.Servant -import Wire.API.MLS.Welcome -import Wire.API.Message -import Wire.API.Routes.CSV -import Wire.API.Routes.LowLevelStream -import Wire.API.Routes.MultiVerb -import Wire.API.Routes.Named -import Wire.API.Routes.Public -import Wire.API.Routes.Public.Util -import Wire.API.Routes.QualifiedCapture -import Wire.API.Routes.Version -import Wire.API.ServantProto (Proto, RawProto) -import Wire.API.Team -import Wire.API.Team.Conversation -import Wire.API.Team.Feature -import Wire.API.Team.LegalHold -import Wire.API.Team.Member -import Wire.API.Team.Permission (Perm (..)) -import Wire.API.Team.SearchVisibility (TeamSearchVisibilityView) -import qualified Wire.API.User as User - -instance AsHeaders '[ConvId] Conversation Conversation where - toHeaders c = (I (qUnqualified (cnvQualifiedId c)) :* Nil, c) - fromHeaders = snd - -type ConversationResponse = ResponseForExistedCreated Conversation - -type ConversationHeaders = '[DescHeader "Location" "Conversation ID" ConvId] - -type ConversationVerbWithMethod (m :: StdMethod) = - MultiVerb - m - '[JSON] - '[ WithHeaders - ConversationHeaders - Conversation - (Respond 200 "Conversation existed" Conversation), - WithHeaders - ConversationHeaders - Conversation - (Respond 201 "Conversation created" Conversation) - ] - ConversationResponse - -type ConversationVerb = ConversationVerbWithMethod 'POST - -type ConversationPutVerb = ConversationVerbWithMethod 'PUT - -type CreateConversationCodeVerb = - MultiVerb - 'POST - '[JSON] - '[ Respond 200 "Conversation code already exists." ConversationCode, - Respond 201 "Conversation code created." Event - ] - AddCodeResult - -instance - (ResponseType r1 ~ ConversationCode, ResponseType r2 ~ Event) => - AsUnion '[r1, r2] AddCodeResult - where - toUnion (CodeAlreadyExisted c) = Z (I c) - toUnion (CodeAdded e) = S (Z (I e)) - - fromUnion (Z (I c)) = CodeAlreadyExisted c - fromUnion (S (Z (I e))) = CodeAdded e - fromUnion (S (S x)) = case x of {} - -type ConvUpdateResponses = UpdateResponses "Conversation unchanged" "Conversation updated" Event - -type ConvJoinResponses = UpdateResponses "Conversation unchanged" "Conversation joined" Event - -data MessageNotSent a - = MessageNotSentConversationNotFound - | MessageNotSentUnknownClient - | MessageNotSentLegalhold - | MessageNotSentClientMissing a - deriving stock (Eq, Show, Generic, Functor) - deriving - (AsUnion (MessageNotSentResponses a)) - via (GenericAsUnion (MessageNotSentResponses a) (MessageNotSent a)) - -instance GSOP.Generic (MessageNotSent a) - -type RemoveFromConversationVerb = - MultiVerb - 'DELETE - '[JSON] - '[ RespondEmpty 204 "No change", - Respond 200 "Member removed" Event - ] - (Maybe Event) - -type MessageNotSentResponses a = - '[ ErrorResponse 'ConvNotFound, - ErrorResponse 'BrigError.UnknownClient, - ErrorResponse 'BrigError.MissingLegalholdConsent, - Respond 412 "Missing clients" a - ] - -type PostOtrResponses a = - MessageNotSentResponses a - .++ '[Respond 201 "Message sent" a] - -type PostOtrResponse a = Either (MessageNotSent a) a - -instance - ( rs ~ (MessageNotSentResponses a .++ '[r]), - a ~ ResponseType r - ) => - AsUnion rs (PostOtrResponse a) - where - toUnion = - eitherToUnion - (toUnion @(MessageNotSentResponses a)) - (Z . I) - - fromUnion = - eitherFromUnion - (fromUnion @(MessageNotSentResponses a)) - (unI . unZ) +import Wire.API.Routes.Public.Galley.Bot +import Wire.API.Routes.Public.Galley.Conversation +import Wire.API.Routes.Public.Galley.CustomBackend +import Wire.API.Routes.Public.Galley.Feature +import Wire.API.Routes.Public.Galley.LegalHold +import Wire.API.Routes.Public.Galley.MLS +import Wire.API.Routes.Public.Galley.Messaging +import Wire.API.Routes.Public.Galley.Team +import Wire.API.Routes.Public.Galley.TeamConversation +import Wire.API.Routes.Public.Galley.TeamMember type ServantAPI = ConversationAPI @@ -180,1719 +48,5 @@ type ServantAPI = :<|> LegalHoldAPI :<|> TeamMemberAPI -type ConversationAPI = - Named - "get-unqualified-conversation" - ( Summary "Get a conversation by ID" - :> CanThrow 'ConvNotFound - :> CanThrow 'ConvAccessDenied - :> ZLocalUser - :> "conversations" - :> Capture "cnv" ConvId - :> Get '[Servant.JSON] Conversation - ) - :<|> Named - "get-unqualified-conversation-legalhold-alias" - -- This alias exists, so that it can be uniquely selected in zauth.acl - ( Summary "Get a conversation by ID (Legalhold alias)" - :> Until 'V2 - :> CanThrow 'ConvNotFound - :> CanThrow 'ConvAccessDenied - :> ZLocalUser - :> "legalhold" - :> "conversations" - :> Capture "cnv" ConvId - :> Get '[Servant.JSON] Conversation - ) - :<|> Named - "get-conversation" - ( Summary "Get a conversation by ID" - :> CanThrow 'ConvNotFound - :> CanThrow 'ConvAccessDenied - :> ZLocalUser - :> "conversations" - :> QualifiedCapture "cnv" ConvId - :> Get '[Servant.JSON] Conversation - ) - :<|> Named - "get-conversation-roles" - ( Summary "Get existing roles available for the given conversation" - :> CanThrow 'ConvNotFound - :> CanThrow 'ConvAccessDenied - :> ZLocalUser - :> "conversations" - :> Capture "cnv" ConvId - :> "roles" - :> Get '[Servant.JSON] ConversationRolesList - ) - :<|> Named - "get-group-info" - ( Summary "Get MLS group information" - :> CanThrow 'ConvNotFound - :> CanThrow 'MLSMissingGroupInfo - :> ZLocalUser - :> "conversations" - :> QualifiedCapture "cnv" ConvId - :> "groupinfo" - :> MultiVerb1 - 'GET - '[MLS] - ( Respond - 200 - "The group information" - OpaquePublicGroupState - ) - ) - :<|> Named - "list-conversation-ids-unqualified" - ( Summary "[deprecated] Get all local conversation IDs." - -- FUTUREWORK: add bounds to swagger schema for Range - :> ZLocalUser - :> "conversations" - :> "ids" - :> QueryParam' - [ Optional, - Strict, - Description "Conversation ID to start from (exclusive)" - ] - "start" - ConvId - :> QueryParam' - [ Optional, - Strict, - Description "Maximum number of IDs to return" - ] - "size" - (Range 1 1000 Int32) - :> Get '[Servant.JSON] (ConversationList ConvId) - ) - :<|> Named - "list-conversation-ids" - ( Summary "Get all conversation IDs." - :> Description PaginationDocs - :> ZLocalUser - :> "conversations" - :> "list-ids" - :> ReqBody '[Servant.JSON] GetPaginatedConversationIds - :> Post '[Servant.JSON] ConvIdsPage - ) - :<|> Named - "get-conversations" - ( Summary "Get all *local* conversations." - :> Description - "Will not return remote conversations.\n\n\ - \Use `POST /conversations/list-ids` followed by \ - \`POST /conversations/list` instead." - :> ZLocalUser - :> "conversations" - :> QueryParam' - [ Optional, - Strict, - Description "Mutually exclusive with 'start' (at most 32 IDs per request)" - ] - "ids" - (Range 1 32 (CommaSeparatedList ConvId)) - :> QueryParam' - [ Optional, - Strict, - Description "Conversation ID to start from (exclusive)" - ] - "start" - ConvId - :> QueryParam' - [ Optional, - Strict, - Description "Maximum number of conversations to return" - ] - "size" - (Range 1 500 Int32) - :> Get '[Servant.JSON] (ConversationList Conversation) - ) - :<|> Named - "list-conversations-v1" - ( Summary "Get conversation metadata for a list of conversation ids" - :> Until 'V2 - :> ZLocalUser - :> "conversations" - :> "list" - :> "v2" - :> ReqBody '[Servant.JSON] ListConversations - :> Post '[Servant.JSON] ConversationsResponse - ) - :<|> Named - "list-conversations" - ( Summary "Get conversation metadata for a list of conversation ids" - :> From 'V2 - :> ZLocalUser - :> "conversations" - :> "list" - :> ReqBody '[Servant.JSON] ListConversations - :> Post '[Servant.JSON] ConversationsResponse - ) - -- This endpoint can lead to the following events being sent: - -- - ConvCreate event to members - :<|> Named - "get-conversation-by-reusable-code" - ( Summary "Get limited conversation information by key/code pair" - :> CanThrow 'CodeNotFound - :> CanThrow 'ConvNotFound - :> CanThrow 'ConvAccessDenied - :> CanThrow 'GuestLinksDisabled - :> CanThrow 'NotATeamMember - :> ZLocalUser - :> "conversations" - :> "join" - :> QueryParam' [Required, Strict] "key" Code.Key - :> QueryParam' [Required, Strict] "code" Code.Value - :> Get '[Servant.JSON] ConversationCoverView - ) - :<|> Named - "create-group-conversation" - ( Summary "Create a new conversation" - :> CanThrow 'ConvAccessDenied - :> CanThrow 'MLSNonEmptyMemberList - :> CanThrow 'NotConnected - :> CanThrow 'NotATeamMember - :> CanThrow OperationDenied - :> CanThrow 'MissingLegalholdConsent - :> Description "This returns 201 when a new conversation is created, and 200 when the conversation already existed" - :> ZLocalUser - :> ZConn - :> "conversations" - :> ReqBody '[Servant.JSON] NewConv - :> ConversationVerb - ) - :<|> Named - "create-self-conversation" - ( Summary "Create a self-conversation" - :> ZLocalUser - :> "conversations" - :> "self" - :> ConversationVerb - ) - :<|> Named - "create-mls-self-conversation" - ( Summary "Create the user's MLS self-conversation" - :> ZLocalUser - :> "conversations" - :> "mls-self" - :> ZClient - :> ConversationPutVerb - ) - -- This endpoint can lead to the following events being sent: - -- - ConvCreate event to members - -- TODO: add note: "On 201, the conversation ID is the `Location` header" - :<|> Named - "create-one-to-one-conversation" - ( Summary "Create a 1:1 conversation" - :> CanThrow 'ConvAccessDenied - :> CanThrow 'InvalidOperation - :> CanThrow 'NoBindingTeamMembers - :> CanThrow 'NonBindingTeam - :> CanThrow 'NotATeamMember - :> CanThrow 'NotConnected - :> CanThrow OperationDenied - :> CanThrow 'TeamNotFound - :> CanThrow 'MissingLegalholdConsent - :> ZLocalUser - :> ZConn - :> "conversations" - :> "one2one" - :> ReqBody '[Servant.JSON] NewConv - :> ConversationVerb - ) - -- This endpoint can lead to the following events being sent: - -- - MemberJoin event to members - :<|> Named - "add-members-to-conversation-unqualified" - ( Summary "Add members to an existing conversation (deprecated)" - :> Until 'V2 - :> CanThrow ('ActionDenied 'AddConversationMember) - :> CanThrow ('ActionDenied 'LeaveConversation) - :> CanThrow 'ConvNotFound - :> CanThrow 'InvalidOperation - :> CanThrow 'TooManyMembers - :> CanThrow 'ConvAccessDenied - :> CanThrow 'NotATeamMember - :> CanThrow 'NotConnected - :> CanThrow 'MissingLegalholdConsent - :> ZLocalUser - :> ZConn - :> "conversations" - :> Capture "cnv" ConvId - :> "members" - :> ReqBody '[JSON] Invite - :> MultiVerb 'POST '[JSON] ConvUpdateResponses (UpdateResult Event) - ) - :<|> Named - "add-members-to-conversation-unqualified2" - ( Summary "Add qualified members to an existing conversation." - :> Until 'V2 - :> CanThrow ('ActionDenied 'AddConversationMember) - :> CanThrow ('ActionDenied 'LeaveConversation) - :> CanThrow 'ConvNotFound - :> CanThrow 'InvalidOperation - :> CanThrow 'TooManyMembers - :> CanThrow 'ConvAccessDenied - :> CanThrow 'NotATeamMember - :> CanThrow 'NotConnected - :> CanThrow 'MissingLegalholdConsent - :> ZLocalUser - :> ZConn - :> "conversations" - :> Capture "cnv" ConvId - :> "members" - :> "v2" - :> ReqBody '[Servant.JSON] InviteQualified - :> MultiVerb 'POST '[Servant.JSON] ConvUpdateResponses (UpdateResult Event) - ) - :<|> Named - "add-members-to-conversation" - ( Summary "Add qualified members to an existing conversation." - :> From 'V2 - :> CanThrow ('ActionDenied 'AddConversationMember) - :> CanThrow ('ActionDenied 'LeaveConversation) - :> CanThrow 'ConvNotFound - :> CanThrow 'InvalidOperation - :> CanThrow 'TooManyMembers - :> CanThrow 'ConvAccessDenied - :> CanThrow 'NotATeamMember - :> CanThrow 'NotConnected - :> CanThrow 'MissingLegalholdConsent - :> ZLocalUser - :> ZConn - :> "conversations" - :> QualifiedCapture "cnv" ConvId - :> "members" - :> ReqBody '[Servant.JSON] InviteQualified - :> MultiVerb 'POST '[Servant.JSON] ConvUpdateResponses (UpdateResult Event) - ) - -- This endpoint can lead to the following events being sent: - -- - MemberJoin event to members - :<|> Named - "join-conversation-by-id-unqualified" - ( Summary "Join a conversation by its ID (if link access enabled)" - :> CanThrow 'ConvAccessDenied - :> CanThrow 'ConvNotFound - :> CanThrow 'InvalidOperation - :> CanThrow 'NotATeamMember - :> CanThrow 'TooManyMembers - :> ZLocalUser - :> ZConn - :> "conversations" - :> Capture' '[Description "Conversation ID"] "cnv" ConvId - :> "join" - :> MultiVerb 'POST '[Servant.JSON] ConvJoinResponses (UpdateResult Event) - ) - -- This endpoint can lead to the following events being sent: - -- - MemberJoin event to members - :<|> Named - "join-conversation-by-code-unqualified" - ( Summary - "Join a conversation using a reusable code.\ - \If the guest links team feature is disabled, this will fail with 409 GuestLinksDisabled.\ - \Note that this is currently inconsistent (for backwards compatibility reasons) with `POST /conversations/code-check` which responds with 404 CodeNotFound if guest links are disabled." - :> CanThrow 'CodeNotFound - :> CanThrow 'ConvAccessDenied - :> CanThrow 'ConvNotFound - :> CanThrow 'GuestLinksDisabled - :> CanThrow 'InvalidOperation - :> CanThrow 'NotATeamMember - :> CanThrow 'TooManyMembers - :> ZLocalUser - :> ZConn - :> "conversations" - :> "join" - :> ReqBody '[Servant.JSON] ConversationCode - :> MultiVerb 'POST '[Servant.JSON] ConvJoinResponses (UpdateResult Event) - ) - :<|> Named - "code-check" - ( Summary - "Check validity of a conversation code.\ - \If the guest links team feature is disabled, this will fail with 404 CodeNotFound.\ - \Note that this is currently inconsistent (for backwards compatibility reasons) with `POST /conversations/join` which responds with 409 GuestLinksDisabled if guest links are disabled." - :> CanThrow 'CodeNotFound - :> CanThrow 'ConvNotFound - :> "conversations" - :> "code-check" - :> ReqBody '[Servant.JSON] ConversationCode - :> MultiVerb - 'POST - '[JSON] - '[RespondEmpty 200 "Valid"] - () - ) - -- this endpoint can lead to the following events being sent: - -- - ConvCodeUpdate event to members, if code didn't exist before - :<|> Named - "create-conversation-code-unqualified" - ( Summary "Create or recreate a conversation code" - :> CanThrow 'ConvAccessDenied - :> CanThrow 'ConvNotFound - :> CanThrow 'GuestLinksDisabled - :> ZUser - :> ZConn - :> "conversations" - :> Capture' '[Description "Conversation ID"] "cnv" ConvId - :> "code" - :> CreateConversationCodeVerb - ) - :<|> Named - "get-conversation-guest-links-status" - ( Summary "Get the status of the guest links feature for a conversation that potentially has been created by someone from another team." - :> CanThrow 'ConvAccessDenied - :> CanThrow 'ConvNotFound - :> ZUser - :> "conversations" - :> Capture' '[Description "Conversation ID"] "cnv" ConvId - :> "features" - :> FeatureSymbol GuestLinksConfig - :> Get '[Servant.JSON] (WithStatus GuestLinksConfig) - ) - -- This endpoint can lead to the following events being sent: - -- - ConvCodeDelete event to members - :<|> Named - "remove-code-unqualified" - ( Summary "Delete conversation code" - :> CanThrow 'ConvAccessDenied - :> CanThrow 'ConvNotFound - :> ZLocalUser - :> ZConn - :> "conversations" - :> Capture' '[Description "Conversation ID"] "cnv" ConvId - :> "code" - :> MultiVerb - 'DELETE - '[JSON] - '[Respond 200 "Conversation code deleted." Event] - Event - ) - :<|> Named - "get-code" - ( Summary "Get existing conversation code" - :> CanThrow 'CodeNotFound - :> CanThrow 'ConvAccessDenied - :> CanThrow 'ConvNotFound - :> CanThrow 'GuestLinksDisabled - :> ZLocalUser - :> "conversations" - :> Capture' '[Description "Conversation ID"] "cnv" ConvId - :> "code" - :> MultiVerb - 'GET - '[JSON] - '[Respond 200 "Conversation Code" ConversationCode] - ConversationCode - ) - -- This endpoint can lead to the following events being sent: - -- - Typing event to members - :<|> Named - "member-typing-unqualified" - ( Summary "Sending typing notifications" - :> CanThrow 'ConvNotFound - :> ZLocalUser - :> ZConn - :> "conversations" - :> Capture' '[Description "Conversation ID"] "cnv" ConvId - :> "typing" - :> ReqBody '[JSON] TypingData - :> MultiVerb 'POST '[JSON] '[RespondEmpty 200 "Notification sent"] () - ) - -- This endpoint can lead to the following events being sent: - -- - MemberLeave event to members - :<|> Named - "remove-member-unqualified" - ( Summary "Remove a member from a conversation (deprecated)" - :> Until 'V2 - :> ZLocalUser - :> ZConn - :> CanThrow ('ActionDenied 'RemoveConversationMember) - :> CanThrow 'ConvNotFound - :> CanThrow 'InvalidOperation - :> "conversations" - :> Capture' '[Description "Conversation ID"] "cnv" ConvId - :> "members" - :> Capture' '[Description "Target User ID"] "usr" UserId - :> RemoveFromConversationVerb - ) - -- This endpoint can lead to the following events being sent: - -- - MemberLeave event to members - :<|> Named - "remove-member" - ( Summary "Remove a member from a conversation" - :> ZLocalUser - :> ZConn - :> CanThrow ('ActionDenied 'RemoveConversationMember) - :> CanThrow 'ConvNotFound - :> CanThrow 'InvalidOperation - :> "conversations" - :> QualifiedCapture' '[Description "Conversation ID"] "cnv" ConvId - :> "members" - :> QualifiedCapture' '[Description "Target User ID"] "usr" UserId - :> RemoveFromConversationVerb - ) - -- This endpoint can lead to the following events being sent: - -- - MemberStateUpdate event to members - :<|> Named - "update-other-member-unqualified" - ( Summary "Update membership of the specified user (deprecated)" - :> Description "Use `PUT /conversations/:cnv_domain/:cnv/members/:usr_domain/:usr` instead" - :> ZLocalUser - :> ZConn - :> CanThrow 'ConvNotFound - :> CanThrow 'ConvMemberNotFound - :> CanThrow ('ActionDenied 'ModifyOtherConversationMember) - :> CanThrow 'InvalidTarget - :> CanThrow 'InvalidOperation - :> "conversations" - :> Capture' '[Description "Conversation ID"] "cnv" ConvId - :> "members" - :> Capture' '[Description "Target User ID"] "usr" UserId - :> ReqBody '[JSON] OtherMemberUpdate - :> MultiVerb - 'PUT - '[JSON] - '[RespondEmpty 200 "Membership updated"] - () - ) - :<|> Named - "update-other-member" - ( Summary "Update membership of the specified user" - :> Description "**Note**: at least one field has to be provided." - :> ZLocalUser - :> ZConn - :> CanThrow 'ConvNotFound - :> CanThrow 'ConvMemberNotFound - :> CanThrow ('ActionDenied 'ModifyOtherConversationMember) - :> CanThrow 'InvalidTarget - :> CanThrow 'InvalidOperation - :> "conversations" - :> QualifiedCapture' '[Description "Conversation ID"] "cnv" ConvId - :> "members" - :> QualifiedCapture' '[Description "Target User ID"] "usr" UserId - :> ReqBody '[JSON] OtherMemberUpdate - :> MultiVerb - 'PUT - '[JSON] - '[RespondEmpty 200 "Membership updated"] - () - ) - -- This endpoint can lead to the following events being sent: - -- - ConvRename event to members - :<|> Named - "update-conversation-name-deprecated" - ( Summary "Update conversation name (deprecated)" - :> Description "Use `/conversations/:domain/:conv/name` instead." - :> CanThrow ('ActionDenied 'ModifyConversationName) - :> CanThrow 'ConvNotFound - :> CanThrow 'InvalidOperation - :> ZLocalUser - :> ZConn - :> "conversations" - :> Capture' '[Description "Conversation ID"] "cnv" ConvId - :> ReqBody '[JSON] ConversationRename - :> MultiVerb - 'PUT - '[JSON] - (UpdateResponses "Name unchanged" "Name updated" Event) - (UpdateResult Event) - ) - :<|> Named - "update-conversation-name-unqualified" - ( Summary "Update conversation name (deprecated)" - :> Description "Use `/conversations/:domain/:conv/name` instead." - :> CanThrow ('ActionDenied 'ModifyConversationName) - :> CanThrow 'ConvNotFound - :> CanThrow 'InvalidOperation - :> ZLocalUser - :> ZConn - :> "conversations" - :> Capture' '[Description "Conversation ID"] "cnv" ConvId - :> "name" - :> ReqBody '[JSON] ConversationRename - :> MultiVerb - 'PUT - '[JSON] - (UpdateResponses "Name unchanged" "Name updated" Event) - (UpdateResult Event) - ) - :<|> Named - "update-conversation-name" - ( Summary "Update conversation name" - :> CanThrow ('ActionDenied 'ModifyConversationName) - :> CanThrow 'ConvNotFound - :> CanThrow 'InvalidOperation - :> ZLocalUser - :> ZConn - :> "conversations" - :> QualifiedCapture' '[Description "Conversation ID"] "cnv" ConvId - :> "name" - :> ReqBody '[JSON] ConversationRename - :> MultiVerb - 'PUT - '[JSON] - (UpdateResponses "Name updated" "Name unchanged" Event) - (UpdateResult Event) - ) - -- This endpoint can lead to the following events being sent: - -- - ConvMessageTimerUpdate event to members - :<|> Named - "update-conversation-message-timer-unqualified" - ( Summary "Update the message timer for a conversation (deprecated)" - :> Description "Use `/conversations/:domain/:cnv/message-timer` instead." - :> ZLocalUser - :> ZConn - :> CanThrow ('ActionDenied 'ModifyConversationMessageTimer) - :> CanThrow 'ConvAccessDenied - :> CanThrow 'ConvNotFound - :> CanThrow 'InvalidOperation - :> "conversations" - :> Capture' '[Description "Conversation ID"] "cnv" ConvId - :> "message-timer" - :> ReqBody '[JSON] ConversationMessageTimerUpdate - :> MultiVerb - 'PUT - '[JSON] - (UpdateResponses "Message timer unchanged" "Message timer updated" Event) - (UpdateResult Event) - ) - :<|> Named - "update-conversation-message-timer" - ( Summary "Update the message timer for a conversation" - :> ZLocalUser - :> ZConn - :> CanThrow ('ActionDenied 'ModifyConversationMessageTimer) - :> CanThrow 'ConvAccessDenied - :> CanThrow 'ConvNotFound - :> CanThrow 'InvalidOperation - :> "conversations" - :> QualifiedCapture' '[Description "Conversation ID"] "cnv" ConvId - :> "message-timer" - :> ReqBody '[JSON] ConversationMessageTimerUpdate - :> MultiVerb - 'PUT - '[JSON] - (UpdateResponses "Message timer unchanged" "Message timer updated" Event) - (UpdateResult Event) - ) - -- This endpoint can lead to the following events being sent: - -- - ConvReceiptModeUpdate event to members - :<|> Named - "update-conversation-receipt-mode-unqualified" - ( Summary "Update receipt mode for a conversation (deprecated)" - :> Description "Use `PUT /conversations/:domain/:cnv/receipt-mode` instead." - :> ZLocalUser - :> ZConn - :> CanThrow ('ActionDenied 'ModifyConversationReceiptMode) - :> CanThrow 'ConvAccessDenied - :> CanThrow 'ConvNotFound - :> CanThrow 'InvalidOperation - :> "conversations" - :> Capture' '[Description "Conversation ID"] "cnv" ConvId - :> "receipt-mode" - :> ReqBody '[JSON] ConversationReceiptModeUpdate - :> MultiVerb - 'PUT - '[JSON] - (UpdateResponses "Receipt mode unchanged" "Receipt mode updated" Event) - (UpdateResult Event) - ) - :<|> Named - "update-conversation-receipt-mode" - ( Summary "Update receipt mode for a conversation" - :> ZLocalUser - :> ZConn - :> CanThrow ('ActionDenied 'ModifyConversationReceiptMode) - :> CanThrow 'ConvAccessDenied - :> CanThrow 'ConvNotFound - :> CanThrow 'InvalidOperation - :> "conversations" - :> QualifiedCapture' '[Description "Conversation ID"] "cnv" ConvId - :> "receipt-mode" - :> ReqBody '[JSON] ConversationReceiptModeUpdate - :> MultiVerb - 'PUT - '[JSON] - (UpdateResponses "Receipt mode unchanged" "Receipt mode updated" Event) - (UpdateResult Event) - ) - -- This endpoint can lead to the following events being sent: - -- - MemberLeave event to members, if members get removed - -- - ConvAccessUpdate event to members - :<|> Named - "update-conversation-access-unqualified" - ( Summary "Update access modes for a conversation (deprecated)" - :> Description "Use PUT `/conversations/:domain/:cnv/access` instead." - :> ZLocalUser - :> ZConn - :> CanThrow ('ActionDenied 'ModifyConversationAccess) - :> CanThrow ('ActionDenied 'RemoveConversationMember) - :> CanThrow 'ConvAccessDenied - :> CanThrow 'ConvNotFound - :> CanThrow 'InvalidOperation - :> CanThrow 'InvalidTargetAccess - :> "conversations" - :> Capture' '[Description "Conversation ID"] "cnv" ConvId - :> "access" - :> ReqBody '[JSON] ConversationAccessData - :> MultiVerb - 'PUT - '[JSON] - (UpdateResponses "Access unchanged" "Access updated" Event) - (UpdateResult Event) - ) - :<|> Named - "update-conversation-access" - ( Summary "Update access modes for a conversation" - :> ZLocalUser - :> ZConn - :> CanThrow ('ActionDenied 'ModifyConversationAccess) - :> CanThrow ('ActionDenied 'RemoveConversationMember) - :> CanThrow 'ConvAccessDenied - :> CanThrow 'ConvNotFound - :> CanThrow 'InvalidOperation - :> CanThrow 'InvalidTargetAccess - :> "conversations" - :> QualifiedCapture' '[Description "Conversation ID"] "cnv" ConvId - :> "access" - :> ReqBody '[JSON] ConversationAccessData - :> MultiVerb - 'PUT - '[JSON] - (UpdateResponses "Access unchanged" "Access updated" Event) - (UpdateResult Event) - ) - :<|> Named - "get-conversation-self-unqualified" - ( Summary "Get self membership properties (deprecated)" - :> ZLocalUser - :> "conversations" - :> Capture' '[Description "Conversation ID"] "cnv" ConvId - :> "self" - :> Get '[JSON] (Maybe Member) - ) - :<|> Named - "update-conversation-self-unqualified" - ( Summary "Update self membership properties (deprecated)" - :> Description "Use `/conversations/:domain/:conv/self` instead." - :> CanThrow 'ConvNotFound - :> ZLocalUser - :> ZConn - :> "conversations" - :> Capture' '[Description "Conversation ID"] "cnv" ConvId - :> "self" - :> ReqBody '[JSON] MemberUpdate - :> MultiVerb - 'PUT - '[JSON] - '[RespondEmpty 200 "Update successful"] - () - ) - :<|> Named - "update-conversation-self" - ( Summary "Update self membership properties" - :> Description "**Note**: at least one field has to be provided." - :> CanThrow 'ConvNotFound - :> ZLocalUser - :> ZConn - :> "conversations" - :> QualifiedCapture' '[Description "Conversation ID"] "cnv" ConvId - :> "self" - :> ReqBody '[JSON] MemberUpdate - :> MultiVerb - 'PUT - '[JSON] - '[RespondEmpty 200 "Update successful"] - () - ) - -type TeamConversationAPI = - Named - "get-team-conversation-roles" - ( Summary "Get existing roles available for the given team" - :> CanThrow 'NotATeamMember - :> ZUser - :> "teams" - :> Capture "tid" TeamId - :> "conversations" - :> "roles" - :> Get '[Servant.JSON] ConversationRolesList - ) - :<|> Named - "get-team-conversations" - ( Summary "Get team conversations" - :> CanThrow OperationDenied - :> CanThrow 'NotATeamMember - :> ZUser - :> "teams" - :> Capture "tid" TeamId - :> "conversations" - :> Get '[Servant.JSON] TeamConversationList - ) - :<|> Named - "get-team-conversation" - ( Summary "Get one team conversation" - :> CanThrow 'ConvNotFound - :> CanThrow OperationDenied - :> CanThrow 'NotATeamMember - :> ZUser - :> "teams" - :> Capture "tid" TeamId - :> "conversations" - :> Capture "cid" ConvId - :> Get '[Servant.JSON] TeamConversation - ) - :<|> Named - "delete-team-conversation" - ( Summary "Remove a team conversation" - :> CanThrow ('ActionDenied 'DeleteConversation) - :> CanThrow 'ConvNotFound - :> CanThrow 'InvalidOperation - :> CanThrow 'NotATeamMember - :> ZLocalUser - :> ZConn - :> "teams" - :> Capture "tid" TeamId - :> "conversations" - :> Capture "cid" ConvId - :> MultiVerb 'DELETE '[JSON] '[RespondEmpty 200 "Conversation deleted"] () - ) - -type TeamAPI = - Named - "create-non-binding-team" - ( Summary "Create a new non binding team" - -- FUTUREWORK: deprecated in https://github.com/wireapp/wire-server/pull/2607 - :> ZUser - :> ZConn - :> CanThrow 'NotConnected - :> CanThrow 'UserBindingExists - :> "teams" - :> ReqBody '[Servant.JSON] NonBindingNewTeam - :> MultiVerb - 'POST - '[JSON] - '[ WithHeaders - '[DescHeader "Location" "Team ID" TeamId] - TeamId - (RespondEmpty 201 "Team ID as `Location` header value") - ] - TeamId - ) - :<|> Named - "update-team" - ( Summary "Update team properties" - :> ZUser - :> ZConn - :> CanThrow 'NotATeamMember - :> CanThrow ('MissingPermission ('Just 'SetTeamData)) - :> "teams" - :> Capture "tid" TeamId - :> ReqBody '[JSON] TeamUpdateData - :> MultiVerb - 'PUT - '[JSON] - '[RespondEmpty 200 "Team updated"] - () - ) - :<|> Named - "get-teams" - ( Summary "Get teams (deprecated); use `GET /teams/:tid`" - -- FUTUREWORK: deprecated in https://github.com/wireapp/wire-server/pull/2607 - :> ZUser - :> "teams" - :> Get '[JSON] TeamList - ) - :<|> Named - "get-team" - ( Summary "Get a team by ID" - :> ZUser - :> CanThrow 'TeamNotFound - :> "teams" - :> Capture "tid" TeamId - :> Get '[JSON] Team - ) - :<|> Named - "delete-team" - ( Summary "Delete a team" - :> ZUser - :> ZConn - :> CanThrow 'TeamNotFound - :> CanThrow ('MissingPermission ('Just 'DeleteTeam)) - :> CanThrow 'NotATeamMember - :> CanThrow OperationDenied - :> CanThrow 'DeleteQueueFull - :> CanThrow AuthenticationError - :> "teams" - :> Capture "tid" TeamId - :> ReqBody '[Servant.JSON] TeamDeleteData - :> MultiVerb 'DELETE '[JSON] '[RespondEmpty 202 "Team is scheduled for removal"] () - ) - -type MessagingAPI = - Named - "post-otr-message-unqualified" - ( Summary "Post an encrypted message to a conversation (accepts JSON or Protobuf)" - :> Description PostOtrDescriptionUnqualified - :> ZLocalUser - :> ZConn - :> "conversations" - :> Capture "cnv" ConvId - :> "otr" - :> "messages" - :> QueryParam "ignore_missing" IgnoreMissing - :> QueryParam "report_missing" ReportMissing - :> ReqBody '[JSON, Proto] NewOtrMessage - :> MultiVerb - 'POST - '[Servant.JSON] - (PostOtrResponses ClientMismatch) - (PostOtrResponse ClientMismatch) - ) - :<|> Named - "post-otr-broadcast-unqualified" - ( Summary "Broadcast an encrypted message to all team members and all contacts (accepts JSON or Protobuf)" - :> Description PostOtrDescriptionUnqualified - :> ZLocalUser - :> ZConn - :> CanThrow 'TeamNotFound - :> CanThrow 'BroadcastLimitExceeded - :> CanThrow 'NonBindingTeam - :> "broadcast" - :> "otr" - :> "messages" - :> QueryParam "ignore_missing" IgnoreMissing - :> QueryParam "report_missing" ReportMissing - :> ReqBody '[JSON, Proto] NewOtrMessage - :> MultiVerb - 'POST - '[JSON] - (PostOtrResponses ClientMismatch) - (PostOtrResponse ClientMismatch) - ) - :<|> Named - "post-proteus-message" - ( Summary "Post an encrypted message to a conversation (accepts only Protobuf)" - :> Description PostOtrDescription - :> ZLocalUser - :> ZConn - :> "conversations" - :> QualifiedCapture "cnv" ConvId - :> "proteus" - :> "messages" - :> ReqBody '[Proto] (RawProto QualifiedNewOtrMessage) - :> MultiVerb - 'POST - '[Servant.JSON] - (PostOtrResponses MessageSendingStatus) - (Either (MessageNotSent MessageSendingStatus) MessageSendingStatus) - ) - :<|> Named - "post-proteus-broadcast" - ( Summary "Post an encrypted message to all team members and all contacts (accepts only Protobuf)" - :> Description PostOtrDescription - :> ZLocalUser - :> ZConn - :> CanThrow 'TeamNotFound - :> CanThrow 'BroadcastLimitExceeded - :> CanThrow 'NonBindingTeam - :> "broadcast" - :> "proteus" - :> "messages" - :> ReqBody '[Proto] QualifiedNewOtrMessage - :> MultiVerb - 'POST - '[JSON] - (PostOtrResponses MessageSendingStatus) - (Either (MessageNotSent MessageSendingStatus) MessageSendingStatus) - ) - -type BotAPI = - Named - "post-bot-message-unqualified" - ( ZBot - :> ZConversation - :> CanThrow 'ConvNotFound - :> "bot" - :> "messages" - :> QueryParam "ignore_missing" IgnoreMissing - :> QueryParam "report_missing" ReportMissing - :> ReqBody '[JSON] NewOtrMessage - :> MultiVerb - 'POST - '[Servant.JSON] - (PostOtrResponses ClientMismatch) - (PostOtrResponse ClientMismatch) - ) - -type FeatureAPI = - FeatureStatusGet SSOConfig - :<|> FeatureStatusGet LegalholdConfig - :<|> FeatureStatusPut - '( 'ActionDenied 'RemoveConversationMember, - '( AuthenticationError, - '( 'CannotEnableLegalHoldServiceLargeTeam, - '( 'LegalHoldNotEnabled, - '( 'LegalHoldDisableUnimplemented, - '( 'LegalHoldServiceNotRegistered, - '( 'UserLegalHoldIllegalOperation, - '( 'LegalHoldCouldNotBlockConnections, '()) - ) - ) - ) - ) - ) - ) - ) - LegalholdConfig - :<|> FeatureStatusGet SearchVisibilityAvailableConfig - :<|> FeatureStatusPut '() SearchVisibilityAvailableConfig - :<|> FeatureStatusDeprecatedGet "This endpoint is potentially used by the old Android client. It is not used by iOS, team management, or webapp as of June 2022" SearchVisibilityAvailableConfig - :<|> FeatureStatusDeprecatedPut "This endpoint is potentially used by the old Android client. It is not used by iOS, team management, or webapp as of June 2022" SearchVisibilityAvailableConfig - :<|> SearchVisibilityGet - :<|> SearchVisibilitySet - :<|> FeatureStatusGet ValidateSAMLEmailsConfig - :<|> FeatureStatusDeprecatedGet "This endpoint is potentially used by the old Android client. It is not used by iOS, team management, or webapp as of June 2022" ValidateSAMLEmailsConfig - :<|> FeatureStatusGet DigitalSignaturesConfig - :<|> FeatureStatusDeprecatedGet "The usage of this endpoint was removed in iOS in version 3.101. It is potentially used by the old Android client. It is not used by team management, or webapp as of June 2022" DigitalSignaturesConfig - :<|> FeatureStatusGet AppLockConfig - :<|> FeatureStatusPut '() AppLockConfig - :<|> FeatureStatusGet FileSharingConfig - :<|> FeatureStatusPut '() FileSharingConfig - :<|> FeatureStatusGet ClassifiedDomainsConfig - :<|> FeatureStatusGet ConferenceCallingConfig - :<|> FeatureStatusGet SelfDeletingMessagesConfig - :<|> FeatureStatusPut '() SelfDeletingMessagesConfig - :<|> FeatureStatusGet GuestLinksConfig - :<|> FeatureStatusPut '() GuestLinksConfig - :<|> FeatureStatusGet SndFactorPasswordChallengeConfig - :<|> FeatureStatusPut '() SndFactorPasswordChallengeConfig - :<|> FeatureStatusGet MLSConfig - :<|> FeatureStatusPut '() MLSConfig - :<|> FeatureStatusGet ExposeInvitationURLsToTeamAdminConfig - :<|> FeatureStatusPut '() ExposeInvitationURLsToTeamAdminConfig - :<|> FeatureStatusGet SearchVisibilityInboundConfig - :<|> FeatureStatusPut '() SearchVisibilityInboundConfig - :<|> AllFeatureConfigsUserGet - :<|> AllFeatureConfigsTeamGet - :<|> FeatureConfigDeprecatedGet "The usage of this endpoint was removed in iOS in version 3.101. It is not used by team management, or webapp, and is potentially used by the old Android client as of June 2022" LegalholdConfig - :<|> FeatureConfigDeprecatedGet "The usage of this endpoint was removed in iOS in version 3.101. It is used by team management, webapp, and potentially the old Android client as of June 2022" SSOConfig - :<|> FeatureConfigDeprecatedGet "The usage of this endpoint was removed in iOS in version 3.101. It is not used by team management, or webapp, and is potentially used by the old Android client as of June 2022" SearchVisibilityAvailableConfig - :<|> FeatureConfigDeprecatedGet "The usage of this endpoint was removed in iOS in version 3.101. It is not used by team management, or webapp, and is potentially used by the old Android client as of June 2022" ValidateSAMLEmailsConfig - :<|> FeatureConfigDeprecatedGet "The usage of this endpoint was removed in iOS in version 3.101. It is used by team management, webapp, and potentially the old Android client as of June 2022" DigitalSignaturesConfig - :<|> FeatureConfigDeprecatedGet "The usage of this endpoint was removed in iOS in version 3.101. It is used by team management, webapp, and potentially the old Android client as of June 2022" AppLockConfig - :<|> FeatureConfigDeprecatedGet "The usage of this endpoint was removed in iOS in version 3.101. It is used by team management, webapp, and potentially the old Android client as of June 2022" FileSharingConfig - :<|> FeatureConfigDeprecatedGet "The usage of this endpoint was removed in iOS in version 3.101. It is not used by team management, or webapp, and is potentially used by the old Android client as of June 2022" ClassifiedDomainsConfig - :<|> FeatureConfigDeprecatedGet "The usage of this endpoint was removed in iOS in version 3.101. It is not used by team management, or webapp, and is potentially used by the old Android client as of June 2022" ConferenceCallingConfig - :<|> FeatureConfigDeprecatedGet "The usage of this endpoint was removed in iOS in version 3.101. It is not used by team management, or webapp, and is potentially used by the old Android client as of June 2022" SelfDeletingMessagesConfig - :<|> FeatureConfigDeprecatedGet "The usage of this endpoint was removed in iOS in version 3.101. It is used by team management, webapp, and potentially the old Android client as of June 2022" GuestLinksConfig - :<|> FeatureConfigDeprecatedGet "The usage of this endpoint was removed in iOS in version 3.101. It is used by team management, webapp, and potentially the old Android client as of June 2022" SndFactorPasswordChallengeConfig - :<|> FeatureConfigDeprecatedGet "The usage of this endpoint was removed in iOS in version 3.101. It is used by team management, webapp, and potentially the old Android client as of June 2022" MLSConfig - -type FeatureStatusGet f = - Named - '("get", f) - (ZUser :> FeatureStatusBaseGet f) - -type FeatureStatusPut errs f = - Named - '("put", f) - (ZUser :> FeatureStatusBasePutPublic errs f) - -type FeatureStatusDeprecatedGet d f = - Named - '("get-deprecated", f) - (ZUser :> FeatureStatusBaseDeprecatedGet d f) - -type FeatureStatusDeprecatedPut d f = - Named - '("put-deprecated", f) - (ZUser :> FeatureStatusBaseDeprecatedPut d f) - -type FeatureStatusBaseGet featureConfig = - Summary (AppendSymbol "Get config for " (FeatureSymbol featureConfig)) - :> CanThrow OperationDenied - :> CanThrow 'NotATeamMember - :> CanThrow 'TeamNotFound - :> "teams" - :> Capture "tid" TeamId - :> "features" - :> FeatureSymbol featureConfig - :> Get '[Servant.JSON] (WithStatus featureConfig) - -type FeatureStatusBasePutPublic errs featureConfig = - Summary (AppendSymbol "Put config for " (FeatureSymbol featureConfig)) - :> CanThrow OperationDenied - :> CanThrow 'NotATeamMember - :> CanThrow 'TeamNotFound - :> CanThrow TeamFeatureError - :> CanThrowMany errs - :> "teams" - :> Capture "tid" TeamId - :> "features" - :> FeatureSymbol featureConfig - :> ReqBody '[Servant.JSON] (WithStatusNoLock featureConfig) - :> Put '[Servant.JSON] (WithStatus featureConfig) - --- | A type for a GET endpoint for a feature with a deprecated path -type FeatureStatusBaseDeprecatedGet desc featureConfig = - ( Summary - (AppendSymbol "[deprecated] Get config for " (FeatureSymbol featureConfig)) - :> Until 'V2 - :> Description - ( "Deprecated. Please use `GET /teams/:tid/features/" - `AppendSymbol` FeatureSymbol featureConfig - `AppendSymbol` "` instead.\n" - `AppendSymbol` desc - ) - :> CanThrow 'NotATeamMember - :> CanThrow OperationDenied - :> CanThrow 'TeamNotFound - :> "teams" - :> Capture "tid" TeamId - :> "features" - :> DeprecatedFeatureName featureConfig - :> Get '[Servant.JSON] (WithStatus featureConfig) - ) - --- | A type for a PUT endpoint for a feature with a deprecated path -type FeatureStatusBaseDeprecatedPut desc featureConfig = - Summary - (AppendSymbol "[deprecated] Get config for " (FeatureSymbol featureConfig)) - :> Until 'V2 - :> Description - ( "Deprecated. Please use `PUT /teams/:tid/features/" - `AppendSymbol` FeatureSymbol featureConfig - `AppendSymbol` "` instead.\n" - `AppendSymbol` desc - ) - :> CanThrow 'NotATeamMember - :> CanThrow OperationDenied - :> CanThrow 'TeamNotFound - :> CanThrow TeamFeatureError - :> "teams" - :> Capture "tid" TeamId - :> "features" - :> DeprecatedFeatureName featureConfig - :> ReqBody '[Servant.JSON] (WithStatusNoLock featureConfig) - :> Put '[Servant.JSON] (WithStatus featureConfig) - -type FeatureConfigDeprecatedGet desc featureConfig = - Named - '("get-config", featureConfig) - ( Summary (AppendSymbol "[deprecated] Get feature config for feature " (FeatureSymbol featureConfig)) - :> Until 'V2 - :> Description ("Deprecated. Please use `GET /feature-configs` instead.\n" `AppendSymbol` desc) - :> ZUser - :> CanThrow 'NotATeamMember - :> CanThrow OperationDenied - :> CanThrow 'TeamNotFound - :> "feature-configs" - :> FeatureSymbol featureConfig - :> Get '[Servant.JSON] (WithStatus featureConfig) - ) - -type AllFeatureConfigsUserGet = - Named - "get-all-feature-configs-for-user" - ( Summary - "Gets feature configs for a user" - :> Description - "Gets feature configs for a user. If the user is a member of a team and has the required permissions, this will return the team's feature configs.\ - \If the user is not a member of a team, this will return the personal feature configs (the server defaults)." - :> ZUser - :> CanThrow 'NotATeamMember - :> CanThrow OperationDenied - :> CanThrow 'TeamNotFound - :> "feature-configs" - :> Get '[Servant.JSON] AllFeatureConfigs - ) - -type AllFeatureConfigsTeamGet = - Named - "get-all-feature-configs-for-team" - ( Summary "Gets feature configs for a team" - :> Description "Gets feature configs for a team. User must be a member of the team and have permission to view team features." - :> CanThrow 'NotATeamMember - :> CanThrow OperationDenied - :> CanThrow 'TeamNotFound - :> ZLocalUser - :> "teams" - :> Capture "tid" TeamId - :> "features" - :> Get '[JSON] AllFeatureConfigs - ) - -type SearchVisibilityGet = - Named - "get-search-visibility" - ( Summary "Shows the value for search visibility" - :> CanThrow 'NotATeamMember - :> CanThrow OperationDenied - :> ZLocalUser - :> "teams" - :> Capture "tid" TeamId - :> "search-visibility" - :> Get '[JSON] TeamSearchVisibilityView - ) - -type SearchVisibilitySet = - Named - "set-search-visibility" - ( Summary "Sets the search visibility for the whole team" - :> CanThrow 'NotATeamMember - :> CanThrow OperationDenied - :> CanThrow 'TeamSearchVisibilityNotEnabled - :> CanThrow 'TeamNotFound - :> CanThrow TeamFeatureError - :> ZLocalUser - :> "teams" - :> Capture "tid" TeamId - :> "search-visibility" - :> ReqBody '[JSON] TeamSearchVisibilityView - :> MultiVerb 'PUT '[JSON] '[RespondEmpty 204 "Search visibility set"] () - ) - -type MLSMessagingAPI = - Named - "mls-welcome-message" - ( Summary "Post an MLS welcome message" - :> CanThrow 'MLSKeyPackageRefNotFound - :> "welcome" - :> ZConn - :> ReqBody '[MLS] (RawMLS Welcome) - :> MultiVerb1 'POST '[JSON] (RespondEmpty 201 "Welcome message sent") - ) - :<|> Named - "mls-message-v1" - ( Summary "Post an MLS message" - :> Until 'V2 - :> CanThrow 'ConvAccessDenied - :> CanThrow 'ConvMemberNotFound - :> CanThrow 'ConvNotFound - :> CanThrow 'LegalHoldNotEnabled - :> CanThrow 'MLSClientMismatch - :> CanThrow 'MLSCommitMissingReferences - :> CanThrow 'MLSKeyPackageRefNotFound - :> CanThrow 'MLSProposalNotFound - :> CanThrow 'MLSProtocolErrorTag - :> CanThrow 'MLSSelfRemovalNotAllowed - :> CanThrow 'MLSStaleMessage - :> CanThrow 'MLSUnsupportedMessage - :> CanThrow 'MLSUnsupportedProposal - :> CanThrow 'MLSClientSenderUserMismatch - :> CanThrow 'MLSGroupConversationMismatch - :> CanThrow 'MissingLegalholdConsent - :> CanThrow MLSProposalFailure - :> "messages" - :> ZConn - :> ReqBody '[MLS] (RawMLS SomeMessage) - :> MultiVerb1 'POST '[JSON] (Respond 201 "Message sent" [Event]) - ) - :<|> Named - "mls-message" - ( Summary "Post an MLS message" - :> From 'V2 - :> CanThrow 'ConvAccessDenied - :> CanThrow 'ConvMemberNotFound - :> CanThrow 'ConvNotFound - :> CanThrow 'LegalHoldNotEnabled - :> CanThrow 'MLSClientMismatch - :> CanThrow 'MLSCommitMissingReferences - :> CanThrow 'MLSKeyPackageRefNotFound - :> CanThrow 'MLSProposalNotFound - :> CanThrow 'MLSProtocolErrorTag - :> CanThrow 'MLSSelfRemovalNotAllowed - :> CanThrow 'MLSStaleMessage - :> CanThrow 'MLSUnsupportedMessage - :> CanThrow 'MLSUnsupportedProposal - :> CanThrow 'MLSClientSenderUserMismatch - :> CanThrow 'MLSGroupConversationMismatch - :> CanThrow 'MissingLegalholdConsent - :> CanThrow MLSProposalFailure - :> "messages" - :> ZConn - :> ReqBody '[MLS] (RawMLS SomeMessage) - :> MultiVerb1 'POST '[JSON] (Respond 201 "Message sent" MLSMessageSendingStatus) - ) - :<|> Named - "mls-commit-bundle" - ( Summary "Post a MLS CommitBundle" - :> From 'V3 - :> CanThrow 'ConvAccessDenied - :> CanThrow 'ConvMemberNotFound - :> CanThrow 'ConvNotFound - :> CanThrow 'LegalHoldNotEnabled - :> CanThrow 'MLSClientMismatch - :> CanThrow 'MLSCommitMissingReferences - :> CanThrow 'MLSKeyPackageRefNotFound - :> CanThrow 'MLSProposalNotFound - :> CanThrow 'MLSProtocolErrorTag - :> CanThrow 'MLSSelfRemovalNotAllowed - :> CanThrow 'MLSStaleMessage - :> CanThrow 'MLSUnsupportedMessage - :> CanThrow 'MLSUnsupportedProposal - :> CanThrow 'MLSClientSenderUserMismatch - :> CanThrow 'MLSGroupConversationMismatch - :> CanThrow 'MLSWelcomeMismatch - :> CanThrow 'MissingLegalholdConsent - :> CanThrow MLSProposalFailure - :> "commit-bundles" - :> ZConn - :> ReqBody '[CommitBundleMimeType] CommitBundle - :> MultiVerb1 'POST '[JSON] (Respond 201 "Commit accepted and forwarded" MLSMessageSendingStatus) - ) - :<|> Named - "mls-public-keys" - ( Summary "Get public keys used by the backend to sign external proposals" - :> "public-keys" - :> MultiVerb1 'GET '[JSON] (Respond 200 "Public keys" MLSPublicKeys) - ) - -type MLSAPI = LiftNamed (ZLocalUser :> "mls" :> MLSMessagingAPI) - -type CustomBackendAPI = - Named - "get-custom-backend-by-domain" - ( Summary "Shows information about custom backends related to a given email domain" - :> CanThrow 'CustomBackendNotFound - :> "custom-backend" - :> "by-domain" - :> Capture' '[Description "URL-encoded email domain"] "domain" Domain - :> Get '[JSON] CustomBackend - ) - -type LegalHoldAPI = - Named - "create-legal-hold-settings" - ( Summary "Create legal hold service settings" - :> CanThrow 'NotATeamMember - :> CanThrow OperationDenied - :> CanThrow 'LegalHoldNotEnabled - :> CanThrow 'LegalHoldServiceInvalidKey - :> CanThrow 'LegalHoldServiceBadResponse - :> ZLocalUser - :> "teams" - :> Capture "tid" TeamId - :> "legalhold" - :> "settings" - :> ReqBody '[JSON] NewLegalHoldService - :> MultiVerb1 'POST '[JSON] (Respond 201 "Legal hold service settings created" ViewLegalHoldService) - ) - :<|> Named - "get-legal-hold-settings" - ( Summary "Get legal hold service settings" - :> CanThrow 'NotATeamMember - :> CanThrow OperationDenied - :> ZLocalUser - :> "teams" - :> Capture "tid" TeamId - :> "legalhold" - :> "settings" - :> Get '[JSON] ViewLegalHoldService - ) - :<|> Named - "delete-legal-hold-settings" - ( Summary "Delete legal hold service settings" - :> CanThrow AuthenticationError - :> CanThrow OperationDenied - :> CanThrow 'NotATeamMember - :> CanThrow ('ActionDenied 'RemoveConversationMember) - :> CanThrow 'InvalidOperation - :> CanThrow 'LegalHoldNotEnabled - :> CanThrow 'LegalHoldDisableUnimplemented - :> CanThrow 'LegalHoldServiceNotRegistered - :> CanThrow 'UserLegalHoldIllegalOperation - :> CanThrow 'LegalHoldCouldNotBlockConnections - :> Description - "This endpoint can lead to the following events being sent:\n\ - \- ClientRemoved event to members with a legalhold client (via brig)\n\ - \- UserLegalHoldDisabled event to contacts of members with a legalhold client (via brig)" - :> ZLocalUser - :> "teams" - :> Capture "tid" TeamId - :> "legalhold" - :> "settings" - :> ReqBody '[JSON] RemoveLegalHoldSettingsRequest - :> MultiVerb1 'DELETE '[JSON] (RespondEmpty 204 "Legal hold service settings deleted") - ) - :<|> Named - "get-legal-hold" - ( Summary "Get legal hold status" - :> CanThrow 'TeamMemberNotFound - :> ZLocalUser - :> "teams" - :> Capture "tid" TeamId - :> "legalhold" - :> Capture "uid" UserId - :> Get '[JSON] UserLegalHoldStatusResponse - ) - :<|> Named - "consent-to-legal-hold" - ( Summary "Consent to legal hold" - :> CanThrow ('ActionDenied 'RemoveConversationMember) - :> CanThrow 'InvalidOperation - :> CanThrow 'TeamMemberNotFound - :> CanThrow 'UserLegalHoldIllegalOperation - :> CanThrow 'LegalHoldCouldNotBlockConnections - :> ZLocalUser - :> "teams" - :> Capture "tid" TeamId - :> "legalhold" - :> "consent" - :> MultiVerb 'POST '[JSON] GrantConsentResultResponseTypes GrantConsentResult - ) - :<|> Named - "request-legal-hold-device" - ( Summary "Request legal hold device" - :> CanThrow ('ActionDenied 'RemoveConversationMember) - :> CanThrow 'NotATeamMember - :> CanThrow OperationDenied - :> CanThrow 'TeamMemberNotFound - :> CanThrow 'LegalHoldNotEnabled - :> CanThrow 'UserLegalHoldAlreadyEnabled - :> CanThrow 'NoUserLegalHoldConsent - :> CanThrow 'LegalHoldServiceBadResponse - :> CanThrow 'LegalHoldServiceNotRegistered - :> CanThrow 'LegalHoldCouldNotBlockConnections - :> CanThrow 'UserLegalHoldIllegalOperation - :> Description - "This endpoint can lead to the following events being sent:\n\ - \- LegalHoldClientRequested event to contacts of the user the device is requested for, if they didn't already have a legalhold client (via brig)" - :> ZLocalUser - :> "teams" - :> Capture "tid" TeamId - :> "legalhold" - :> Capture "uid" UserId - :> MultiVerb - 'POST - '[JSON] - RequestDeviceResultResponseType - RequestDeviceResult - ) - :<|> Named - "disable-legal-hold-for-user" - ( Summary "Disable legal hold for user" - :> CanThrow AuthenticationError - :> CanThrow ('ActionDenied 'RemoveConversationMember) - :> CanThrow 'NotATeamMember - :> CanThrow OperationDenied - :> CanThrow 'LegalHoldServiceNotRegistered - :> CanThrow 'UserLegalHoldIllegalOperation - :> CanThrow 'LegalHoldCouldNotBlockConnections - :> Description - "This endpoint can lead to the following events being sent:\n\ - \- ClientRemoved event to the user owning the client (via brig)\n\ - \- UserLegalHoldDisabled event to contacts of the user owning the client (via brig)" - :> ZLocalUser - :> "teams" - :> Capture "tid" TeamId - :> "legalhold" - :> Capture "uid" UserId - :> ReqBody '[JSON] DisableLegalHoldForUserRequest - :> MultiVerb - 'DELETE - '[JSON] - DisableLegalHoldForUserResponseType - DisableLegalHoldForUserResponse - ) - :<|> Named - "approve-legal-hold-device" - ( Summary "Approve legal hold device" - :> CanThrow AuthenticationError - :> CanThrow 'AccessDenied - :> CanThrow ('ActionDenied 'RemoveConversationMember) - :> CanThrow 'NotATeamMember - :> CanThrow 'LegalHoldNotEnabled - :> CanThrow 'UserLegalHoldNotPending - :> CanThrow 'NoLegalHoldDeviceAllocated - :> CanThrow 'LegalHoldServiceNotRegistered - :> CanThrow 'UserLegalHoldAlreadyEnabled - :> CanThrow 'UserLegalHoldIllegalOperation - :> CanThrow 'LegalHoldCouldNotBlockConnections - :> Description - "This endpoint can lead to the following events being sent:\n\ - \- ClientAdded event to the user owning the client (via brig)\n\ - \- UserLegalHoldEnabled event to contacts of the user owning the client (via brig)\n\ - \- ClientRemoved event to the user, if removing old client due to max number (via brig)" - :> ZLocalUser - :> ZConn - :> "teams" - :> Capture "tid" TeamId - :> "legalhold" - :> Capture "uid" UserId - :> "approve" - :> ReqBody '[JSON] ApproveLegalHoldForUserRequest - :> MultiVerb1 'PUT '[JSON] (RespondEmpty 200 "Legal hold approved") - ) - -type RequestDeviceResultResponseType = - '[ RespondEmpty 201 "Request device successful", - RespondEmpty 204 "Request device already pending" - ] - -data RequestDeviceResult - = RequestDeviceSuccess - | RequestDeviceAlreadyPending - deriving (Generic) - deriving (AsUnion RequestDeviceResultResponseType) via GenericAsUnion RequestDeviceResultResponseType RequestDeviceResult - -instance GSOP.Generic RequestDeviceResult - -type DisableLegalHoldForUserResponseType = - '[ RespondEmpty 200 "Disable legal hold successful", - RespondEmpty 204 "Legal hold was not enabled" - ] - -data DisableLegalHoldForUserResponse - = DisableLegalHoldSuccess - | DisableLegalHoldWasNotEnabled - deriving (Generic) - deriving (AsUnion DisableLegalHoldForUserResponseType) via GenericAsUnion DisableLegalHoldForUserResponseType DisableLegalHoldForUserResponse - -instance GSOP.Generic DisableLegalHoldForUserResponse - -type GrantConsentResultResponseTypes = - '[ RespondEmpty 201 "Grant consent successful", - RespondEmpty 204 "Consent already granted" - ] - -data GrantConsentResult - = GrantConsentSuccess - | GrantConsentAlreadyGranted - deriving (Generic) - deriving (AsUnion GrantConsentResultResponseTypes) via GenericAsUnion GrantConsentResultResponseTypes GrantConsentResult - -instance GSOP.Generic GrantConsentResult - -type TeamMemberAPI = - Named - "get-team-members" - ( Summary "Get team members" - :> CanThrow 'NotATeamMember - :> ZLocalUser - :> "teams" - :> Capture "tid" TeamId - :> "members" - :> QueryParam' - [ Optional, - Strict, - Description "Maximum results to be returned" - ] - "maxResults" - (Range 1 HardTruncationLimit Int32) - :> QueryParam' - [ Optional, - Strict, - Description - "Optional, when not specified, the first page will be returned.\ - \Every returned page contains a `pagingState`, this should be supplied to retrieve the next page." - ] - "pagingState" - TeamMembersPagingState - :> Get '[JSON] TeamMembersPage - ) - :<|> Named - "get-team-member" - ( Summary "Get single team member" - :> CanThrow 'NotATeamMember - :> CanThrow 'TeamMemberNotFound - :> ZLocalUser - :> "teams" - :> Capture "tid" TeamId - :> "members" - :> Capture "uid" UserId - :> Get '[JSON] TeamMemberOptPerms - ) - :<|> Named - "get-team-members-by-ids" - ( Summary "Get team members by user id list" - :> Description "The `has_more` field in the response body is always `false`." - :> CanThrow 'NotATeamMember - :> CanThrow 'BulkGetMemberLimitExceeded - :> ZLocalUser - :> "teams" - :> Capture "tid" TeamId - :> "get-members-by-ids-using-post" - :> QueryParam' - [ Optional, - Strict, - Description "Maximum results to be returned" - ] - "maxResults" - (Range 1 HardTruncationLimit Int32) - :> ReqBody '[JSON] User.UserIdList - :> Post '[JSON] TeamMemberListOptPerms - ) - :<|> Named - "add-team-member" - ( Summary "Add a new team member" - -- FUTUREWORK: deprecated in https://github.com/wireapp/wire-server/pull/2607 - :> CanThrow 'InvalidPermissions - :> CanThrow 'NoAddToBinding - :> CanThrow 'NotATeamMember - :> CanThrow 'NotConnected - :> CanThrow OperationDenied - :> CanThrow 'TeamNotFound - :> CanThrow 'TooManyTeamMembers - :> CanThrow 'UserBindingExists - :> CanThrow 'TooManyTeamMembersOnTeamWithLegalhold - :> ZLocalUser - :> ZConn - :> "teams" - :> Capture "tid" TeamId - :> "members" - :> ReqBody '[JSON] NewTeamMember - :> MultiVerb1 - 'POST - '[JSON] - (RespondEmpty 200 "") - ) - :<|> Named - "delete-team-member" - ( Summary "Remove an existing team member" - :> CanThrow AuthenticationError - :> CanThrow 'AccessDenied - :> CanThrow 'TeamMemberNotFound - :> CanThrow 'TeamNotFound - :> CanThrow 'NotATeamMember - :> CanThrow OperationDenied - :> ZLocalUser - :> ZConn - :> "teams" - :> Capture "tid" TeamId - :> "members" - :> Capture "uid" UserId - :> ReqBody '[JSON] TeamMemberDeleteData - :> MultiVerb - 'DELETE - '[JSON] - TeamMemberDeleteResultResponseType - TeamMemberDeleteResult - ) - :<|> Named - "delete-non-binding-team-member" - ( Summary "Remove an existing team member" - -- FUTUREWORK: deprecated in https://github.com/wireapp/wire-server/pull/2607 - :> CanThrow AuthenticationError - :> CanThrow 'AccessDenied - :> CanThrow 'TeamMemberNotFound - :> CanThrow 'TeamNotFound - :> CanThrow 'NotATeamMember - :> CanThrow OperationDenied - :> ZLocalUser - :> ZConn - :> "teams" - :> Capture "tid" TeamId - :> "members" - :> Capture "uid" UserId - :> MultiVerb - 'DELETE - '[JSON] - TeamMemberDeleteResultResponseType - TeamMemberDeleteResult - ) - :<|> Named - "update-team-member" - ( Summary "Update an existing team member" - :> CanThrow 'AccessDenied - :> CanThrow 'InvalidPermissions - :> CanThrow 'TeamNotFound - :> CanThrow 'TeamMemberNotFound - :> CanThrow 'NotATeamMember - :> CanThrow OperationDenied - :> ZLocalUser - :> ZConn - :> "teams" - :> Capture "tid" TeamId - :> "members" - :> ReqBody '[JSON] NewTeamMember - :> MultiVerb1 - 'PUT - '[JSON] - (RespondEmpty 200 "") - ) - :<|> Named - "get-team-members-csv" - ( Summary "Get all members of the team as a CSV file" - :> CanThrow 'AccessDenied - :> Description - "The endpoint returns data in chunked transfer encoding.\ - \ Internal server errors might result in a failed transfer\ - \ instead of a 500 response." - :> ZLocalUser - :> "teams" - :> Capture "tid" TeamId - :> "members" - :> "csv" - :> LowLevelStream - 'GET - 200 - '[ '( "Content-Disposition", - "attachment; filename=\"wire_team_members.csv\"" - ) - ] - "CSV of team members" - CSV - ) - -type TeamMemberDeleteResultResponseType = - '[ RespondEmpty 202 "Team member scheduled for deletion", - RespondEmpty 200 "" - ] - -data TeamMemberDeleteResult - = TeamMemberDeleteAccepted - | TeamMemberDeleteCompleted - deriving (Generic) - deriving (AsUnion TeamMemberDeleteResultResponseType) via GenericAsUnion TeamMemberDeleteResultResponseType TeamMemberDeleteResult - -instance GSOP.Generic TeamMemberDeleteResult - --- This is a work-around for the fact that we sometimes want to send larger lists of user ids --- in the filter query than fits the url length limit. For details, see --- https://github.com/zinfra/backend-issues/issues/1248 -type PostOtrDescriptionUnqualified = - "This endpoint ensures that the list of clients is correct and only sends the message if the list is correct.\n\ - \To override this, the endpoint accepts two query params:\n\ - \- `ignore_missing`: Can be 'true' 'false' or a comma separated list of user IDs.\n\ - \ - When 'true' all missing clients are ignored.\n\ - \ - When 'false' all missing clients are reported.\n\ - \ - When comma separated list of user-ids, only clients for listed users are ignored.\n\ - \- `report_missing`: Can be 'true' 'false' or a comma separated list of user IDs.\n\ - \ - When 'true' all missing clients are reported.\n\ - \ - When 'false' all missing clients are ignored.\n\ - \ - When comma separated list of user-ids, only clients for listed users are reported.\n\ - \\n\ - \Apart from these, the request body also accepts `report_missing` which can only be a list of user ids and behaves the same way as the query parameter.\n\ - \\n\ - \All three of these should be considered mutually exclusive. The server however does not error if more than one is specified, it reads them in this order of precedence:\n\ - \- `report_missing` in the request body has highest precedence.\n\ - \- `ignore_missing` in the query param is the next.\n\ - \- `report_missing` in the query param has the lowest precedence.\n\ - \\n\ - \This endpoint can lead to OtrMessageAdd event being sent to the recipients.\n\ - \\n\ - \**NOTE:** The protobuf definitions of the request body can be found at https://github.com/wireapp/generic-message-proto/blob/master/proto/otr.proto." - -type PostOtrDescription = - "This endpoint ensures that the list of clients is correct and only sends the message if the list is correct.\n\ - \To override this, the endpoint accepts `client_mismatch_strategy` in the body. It can have these values:\n\ - \- `report_all`: When set, the message is not sent if any clients are missing. The missing clients are reported in the response.\n\ - \- `ignore_all`: When set, no checks about missing clients are carried out.\n\ - \- `report_only`: Takes a list of qualified UserIDs. If any clients of the listed users are missing, the message is not sent. The missing clients are reported in the response.\n\ - \- `ignore_only`: Takes a list of qualified UserIDs. If any clients of the non-listed users are missing, the message is not sent. The missing clients are reported in the response.\n\ - \\n\ - \The sending of messages in a federated conversation could theoretically fail partially. \ - \To make this case unlikely, the backend first gets a list of clients from all the involved backends and then tries to send a message. \ - \So, if any backend is down, the message is not propagated to anyone. \ - \But the actual message fan out to multiple backends could still fail partially. This type of failure is reported as a 201, \ - \the clients for which the message sending failed are part of the response body.\n\ - \\n\ - \This endpoint can lead to OtrMessageAdd event being sent to the recipients.\n\ - \\n\ - \**NOTE:** The protobuf definitions of the request body can be found at https://github.com/wireapp/generic-message-proto/blob/master/proto/otr.proto." - swaggerDoc :: Swagger.Swagger swaggerDoc = toSwagger (Proxy @ServantAPI) diff --git a/libs/wire-api/src/Wire/API/Routes/Public/Galley/Bot.hs b/libs/wire-api/src/Wire/API/Routes/Public/Galley/Bot.hs new file mode 100644 index 00000000000..fddc356bebe --- /dev/null +++ b/libs/wire-api/src/Wire/API/Routes/Public/Galley/Bot.hs @@ -0,0 +1,46 @@ +-- 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.Routes.Public.Galley.Bot where + +import Servant hiding (WithStatus) +import Servant.Swagger.Internal.Orphans () +import Wire.API.Error +import Wire.API.Error.Galley +import Wire.API.Message +import Wire.API.Routes.MultiVerb +import Wire.API.Routes.Named +import Wire.API.Routes.Public +import Wire.API.Routes.Public.Galley.Messaging + +type BotAPI = + Named + "post-bot-message-unqualified" + ( ZBot + :> ZConversation + :> CanThrow 'ConvNotFound + :> "bot" + :> "messages" + :> QueryParam "ignore_missing" IgnoreMissing + :> QueryParam "report_missing" ReportMissing + :> ReqBody '[JSON] NewOtrMessage + :> MultiVerb + 'POST + '[Servant.JSON] + (PostOtrResponses ClientMismatch) + (PostOtrResponse ClientMismatch) + ) diff --git a/libs/wire-api/src/Wire/API/Routes/Public/Galley/Conversation.hs b/libs/wire-api/src/Wire/API/Routes/Public/Galley/Conversation.hs new file mode 100644 index 00000000000..9cb3caaf7d2 --- /dev/null +++ b/libs/wire-api/src/Wire/API/Routes/Public/Galley/Conversation.hs @@ -0,0 +1,812 @@ +-- 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.Routes.Public.Galley.Conversation where + +import qualified Data.Code as Code +import Data.CommaSeparatedList +import Data.Id +import Data.Range +import Imports hiding (head) +import Servant hiding (WithStatus) +import Servant.Swagger.Internal.Orphans () +import Wire.API.Conversation +import Wire.API.Conversation.Role +import Wire.API.Error +import Wire.API.Error.Galley +import Wire.API.Event.Conversation +import Wire.API.MLS.PublicGroupState +import Wire.API.MLS.Servant +import Wire.API.Routes.MultiVerb +import Wire.API.Routes.Named +import Wire.API.Routes.Public +import Wire.API.Routes.Public.Util +import Wire.API.Routes.QualifiedCapture +import Wire.API.Routes.Version +import Wire.API.Team.Feature + +type ConversationResponse = ResponseForExistedCreated Conversation + +type ConversationHeaders = '[DescHeader "Location" "Conversation ID" ConvId] + +type ConversationVerbWithMethod (m :: StdMethod) = + MultiVerb + m + '[JSON] + '[ WithHeaders + ConversationHeaders + Conversation + (Respond 200 "Conversation existed" Conversation), + WithHeaders + ConversationHeaders + Conversation + (Respond 201 "Conversation created" Conversation) + ] + ConversationResponse + +type ConversationVerb = ConversationVerbWithMethod 'POST + +type ConversationPutVerb = ConversationVerbWithMethod 'PUT + +type CreateConversationCodeVerb = + MultiVerb + 'POST + '[JSON] + '[ Respond 200 "Conversation code already exists." ConversationCode, + Respond 201 "Conversation code created." Event + ] + AddCodeResult + +type ConvUpdateResponses = UpdateResponses "Conversation unchanged" "Conversation updated" Event + +type ConvJoinResponses = UpdateResponses "Conversation unchanged" "Conversation joined" Event + +type RemoveFromConversationVerb = + MultiVerb + 'DELETE + '[JSON] + '[ RespondEmpty 204 "No change", + Respond 200 "Member removed" Event + ] + (Maybe Event) + +type ConversationAPI = + Named + "get-unqualified-conversation" + ( Summary "Get a conversation by ID" + :> CanThrow 'ConvNotFound + :> CanThrow 'ConvAccessDenied + :> ZLocalUser + :> "conversations" + :> Capture "cnv" ConvId + :> Get '[Servant.JSON] Conversation + ) + :<|> Named + "get-unqualified-conversation-legalhold-alias" + -- This alias exists, so that it can be uniquely selected in zauth.acl + ( Summary "Get a conversation by ID (Legalhold alias)" + :> Until 'V2 + :> CanThrow 'ConvNotFound + :> CanThrow 'ConvAccessDenied + :> ZLocalUser + :> "legalhold" + :> "conversations" + :> Capture "cnv" ConvId + :> Get '[Servant.JSON] Conversation + ) + :<|> Named + "get-conversation" + ( Summary "Get a conversation by ID" + :> CanThrow 'ConvNotFound + :> CanThrow 'ConvAccessDenied + :> ZLocalUser + :> "conversations" + :> QualifiedCapture "cnv" ConvId + :> Get '[Servant.JSON] Conversation + ) + :<|> Named + "get-conversation-roles" + ( Summary "Get existing roles available for the given conversation" + :> CanThrow 'ConvNotFound + :> CanThrow 'ConvAccessDenied + :> ZLocalUser + :> "conversations" + :> Capture "cnv" ConvId + :> "roles" + :> Get '[Servant.JSON] ConversationRolesList + ) + :<|> Named + "get-group-info" + ( Summary "Get MLS group information" + :> CanThrow 'ConvNotFound + :> CanThrow 'MLSMissingGroupInfo + :> ZLocalUser + :> "conversations" + :> QualifiedCapture "cnv" ConvId + :> "groupinfo" + :> MultiVerb1 + 'GET + '[MLS] + ( Respond + 200 + "The group information" + OpaquePublicGroupState + ) + ) + :<|> Named + "list-conversation-ids-unqualified" + ( Summary "[deprecated] Get all local conversation IDs." + -- FUTUREWORK: add bounds to swagger schema for Range + :> ZLocalUser + :> "conversations" + :> "ids" + :> QueryParam' + [ Optional, + Strict, + Description "Conversation ID to start from (exclusive)" + ] + "start" + ConvId + :> QueryParam' + [ Optional, + Strict, + Description "Maximum number of IDs to return" + ] + "size" + (Range 1 1000 Int32) + :> Get '[Servant.JSON] (ConversationList ConvId) + ) + :<|> Named + "list-conversation-ids" + ( Summary "Get all conversation IDs." + :> Description PaginationDocs + :> ZLocalUser + :> "conversations" + :> "list-ids" + :> ReqBody '[Servant.JSON] GetPaginatedConversationIds + :> Post '[Servant.JSON] ConvIdsPage + ) + :<|> Named + "get-conversations" + ( Summary "Get all *local* conversations." + :> Description + "Will not return remote conversations.\n\n\ + \Use `POST /conversations/list-ids` followed by \ + \`POST /conversations/list` instead." + :> ZLocalUser + :> "conversations" + :> QueryParam' + [ Optional, + Strict, + Description "Mutually exclusive with 'start' (at most 32 IDs per request)" + ] + "ids" + (Range 1 32 (CommaSeparatedList ConvId)) + :> QueryParam' + [ Optional, + Strict, + Description "Conversation ID to start from (exclusive)" + ] + "start" + ConvId + :> QueryParam' + [ Optional, + Strict, + Description "Maximum number of conversations to return" + ] + "size" + (Range 1 500 Int32) + :> Get '[Servant.JSON] (ConversationList Conversation) + ) + :<|> Named + "list-conversations-v1" + ( Summary "Get conversation metadata for a list of conversation ids" + :> Until 'V2 + :> ZLocalUser + :> "conversations" + :> "list" + :> "v2" + :> ReqBody '[Servant.JSON] ListConversations + :> Post '[Servant.JSON] ConversationsResponse + ) + :<|> Named + "list-conversations" + ( Summary "Get conversation metadata for a list of conversation ids" + :> From 'V2 + :> ZLocalUser + :> "conversations" + :> "list" + :> ReqBody '[Servant.JSON] ListConversations + :> Post '[Servant.JSON] ConversationsResponse + ) + -- This endpoint can lead to the following events being sent: + -- - ConvCreate event to members + :<|> Named + "get-conversation-by-reusable-code" + ( Summary "Get limited conversation information by key/code pair" + :> CanThrow 'CodeNotFound + :> CanThrow 'ConvNotFound + :> CanThrow 'ConvAccessDenied + :> CanThrow 'GuestLinksDisabled + :> CanThrow 'NotATeamMember + :> ZLocalUser + :> "conversations" + :> "join" + :> QueryParam' [Required, Strict] "key" Code.Key + :> QueryParam' [Required, Strict] "code" Code.Value + :> Get '[Servant.JSON] ConversationCoverView + ) + :<|> Named + "create-group-conversation" + ( Summary "Create a new conversation" + :> CanThrow 'ConvAccessDenied + :> CanThrow 'MLSNonEmptyMemberList + :> CanThrow 'NotConnected + :> CanThrow 'NotATeamMember + :> CanThrow OperationDenied + :> CanThrow 'MissingLegalholdConsent + :> Description "This returns 201 when a new conversation is created, and 200 when the conversation already existed" + :> ZLocalUser + :> ZConn + :> "conversations" + :> ReqBody '[Servant.JSON] NewConv + :> ConversationVerb + ) + :<|> Named + "create-self-conversation" + ( Summary "Create a self-conversation" + :> ZLocalUser + :> "conversations" + :> "self" + :> ConversationVerb + ) + :<|> Named + "create-mls-self-conversation" + ( Summary "Create the user's MLS self-conversation" + :> ZLocalUser + :> "conversations" + :> "mls-self" + :> ZClient + :> ConversationPutVerb + ) + -- This endpoint can lead to the following events being sent: + -- - ConvCreate event to members + -- TODO: add note: "On 201, the conversation ID is the `Location` header" + :<|> Named + "create-one-to-one-conversation" + ( Summary "Create a 1:1 conversation" + :> CanThrow 'ConvAccessDenied + :> CanThrow 'InvalidOperation + :> CanThrow 'NoBindingTeamMembers + :> CanThrow 'NonBindingTeam + :> CanThrow 'NotATeamMember + :> CanThrow 'NotConnected + :> CanThrow OperationDenied + :> CanThrow 'TeamNotFound + :> CanThrow 'MissingLegalholdConsent + :> ZLocalUser + :> ZConn + :> "conversations" + :> "one2one" + :> ReqBody '[Servant.JSON] NewConv + :> ConversationVerb + ) + -- This endpoint can lead to the following events being sent: + -- - MemberJoin event to members + :<|> Named + "add-members-to-conversation-unqualified" + ( Summary "Add members to an existing conversation (deprecated)" + :> Until 'V2 + :> CanThrow ('ActionDenied 'AddConversationMember) + :> CanThrow ('ActionDenied 'LeaveConversation) + :> CanThrow 'ConvNotFound + :> CanThrow 'InvalidOperation + :> CanThrow 'TooManyMembers + :> CanThrow 'ConvAccessDenied + :> CanThrow 'NotATeamMember + :> CanThrow 'NotConnected + :> CanThrow 'MissingLegalholdConsent + :> ZLocalUser + :> ZConn + :> "conversations" + :> Capture "cnv" ConvId + :> "members" + :> ReqBody '[JSON] Invite + :> MultiVerb 'POST '[JSON] ConvUpdateResponses (UpdateResult Event) + ) + :<|> Named + "add-members-to-conversation-unqualified2" + ( Summary "Add qualified members to an existing conversation." + :> Until 'V2 + :> CanThrow ('ActionDenied 'AddConversationMember) + :> CanThrow ('ActionDenied 'LeaveConversation) + :> CanThrow 'ConvNotFound + :> CanThrow 'InvalidOperation + :> CanThrow 'TooManyMembers + :> CanThrow 'ConvAccessDenied + :> CanThrow 'NotATeamMember + :> CanThrow 'NotConnected + :> CanThrow 'MissingLegalholdConsent + :> ZLocalUser + :> ZConn + :> "conversations" + :> Capture "cnv" ConvId + :> "members" + :> "v2" + :> ReqBody '[Servant.JSON] InviteQualified + :> MultiVerb 'POST '[Servant.JSON] ConvUpdateResponses (UpdateResult Event) + ) + :<|> Named + "add-members-to-conversation" + ( Summary "Add qualified members to an existing conversation." + :> From 'V2 + :> CanThrow ('ActionDenied 'AddConversationMember) + :> CanThrow ('ActionDenied 'LeaveConversation) + :> CanThrow 'ConvNotFound + :> CanThrow 'InvalidOperation + :> CanThrow 'TooManyMembers + :> CanThrow 'ConvAccessDenied + :> CanThrow 'NotATeamMember + :> CanThrow 'NotConnected + :> CanThrow 'MissingLegalholdConsent + :> ZLocalUser + :> ZConn + :> "conversations" + :> QualifiedCapture "cnv" ConvId + :> "members" + :> ReqBody '[Servant.JSON] InviteQualified + :> MultiVerb 'POST '[Servant.JSON] ConvUpdateResponses (UpdateResult Event) + ) + -- This endpoint can lead to the following events being sent: + -- - MemberJoin event to members + :<|> Named + "join-conversation-by-id-unqualified" + ( Summary "Join a conversation by its ID (if link access enabled)" + :> CanThrow 'ConvAccessDenied + :> CanThrow 'ConvNotFound + :> CanThrow 'InvalidOperation + :> CanThrow 'NotATeamMember + :> CanThrow 'TooManyMembers + :> ZLocalUser + :> ZConn + :> "conversations" + :> Capture' '[Description "Conversation ID"] "cnv" ConvId + :> "join" + :> MultiVerb 'POST '[Servant.JSON] ConvJoinResponses (UpdateResult Event) + ) + -- This endpoint can lead to the following events being sent: + -- - MemberJoin event to members + :<|> Named + "join-conversation-by-code-unqualified" + ( Summary + "Join a conversation using a reusable code.\ + \If the guest links team feature is disabled, this will fail with 409 GuestLinksDisabled.\ + \Note that this is currently inconsistent (for backwards compatibility reasons) with `POST /conversations/code-check` which responds with 404 CodeNotFound if guest links are disabled." + :> CanThrow 'CodeNotFound + :> CanThrow 'ConvAccessDenied + :> CanThrow 'ConvNotFound + :> CanThrow 'GuestLinksDisabled + :> CanThrow 'InvalidOperation + :> CanThrow 'NotATeamMember + :> CanThrow 'TooManyMembers + :> ZLocalUser + :> ZConn + :> "conversations" + :> "join" + :> ReqBody '[Servant.JSON] ConversationCode + :> MultiVerb 'POST '[Servant.JSON] ConvJoinResponses (UpdateResult Event) + ) + :<|> Named + "code-check" + ( Summary + "Check validity of a conversation code.\ + \If the guest links team feature is disabled, this will fail with 404 CodeNotFound.\ + \Note that this is currently inconsistent (for backwards compatibility reasons) with `POST /conversations/join` which responds with 409 GuestLinksDisabled if guest links are disabled." + :> CanThrow 'CodeNotFound + :> CanThrow 'ConvNotFound + :> "conversations" + :> "code-check" + :> ReqBody '[Servant.JSON] ConversationCode + :> MultiVerb + 'POST + '[JSON] + '[RespondEmpty 200 "Valid"] + () + ) + -- this endpoint can lead to the following events being sent: + -- - ConvCodeUpdate event to members, if code didn't exist before + :<|> Named + "create-conversation-code-unqualified" + ( Summary "Create or recreate a conversation code" + :> CanThrow 'ConvAccessDenied + :> CanThrow 'ConvNotFound + :> CanThrow 'GuestLinksDisabled + :> ZUser + :> ZConn + :> "conversations" + :> Capture' '[Description "Conversation ID"] "cnv" ConvId + :> "code" + :> CreateConversationCodeVerb + ) + :<|> Named + "get-conversation-guest-links-status" + ( Summary "Get the status of the guest links feature for a conversation that potentially has been created by someone from another team." + :> CanThrow 'ConvAccessDenied + :> CanThrow 'ConvNotFound + :> ZUser + :> "conversations" + :> Capture' '[Description "Conversation ID"] "cnv" ConvId + :> "features" + :> FeatureSymbol GuestLinksConfig + :> Get '[Servant.JSON] (WithStatus GuestLinksConfig) + ) + -- This endpoint can lead to the following events being sent: + -- - ConvCodeDelete event to members + :<|> Named + "remove-code-unqualified" + ( Summary "Delete conversation code" + :> CanThrow 'ConvAccessDenied + :> CanThrow 'ConvNotFound + :> ZLocalUser + :> ZConn + :> "conversations" + :> Capture' '[Description "Conversation ID"] "cnv" ConvId + :> "code" + :> MultiVerb + 'DELETE + '[JSON] + '[Respond 200 "Conversation code deleted." Event] + Event + ) + :<|> Named + "get-code" + ( Summary "Get existing conversation code" + :> CanThrow 'CodeNotFound + :> CanThrow 'ConvAccessDenied + :> CanThrow 'ConvNotFound + :> CanThrow 'GuestLinksDisabled + :> ZLocalUser + :> "conversations" + :> Capture' '[Description "Conversation ID"] "cnv" ConvId + :> "code" + :> MultiVerb + 'GET + '[JSON] + '[Respond 200 "Conversation Code" ConversationCode] + ConversationCode + ) + -- This endpoint can lead to the following events being sent: + -- - Typing event to members + :<|> Named + "member-typing-unqualified" + ( Summary "Sending typing notifications" + :> CanThrow 'ConvNotFound + :> ZLocalUser + :> ZConn + :> "conversations" + :> Capture' '[Description "Conversation ID"] "cnv" ConvId + :> "typing" + :> ReqBody '[JSON] TypingData + :> MultiVerb 'POST '[JSON] '[RespondEmpty 200 "Notification sent"] () + ) + -- This endpoint can lead to the following events being sent: + -- - MemberLeave event to members + :<|> Named + "remove-member-unqualified" + ( Summary "Remove a member from a conversation (deprecated)" + :> Until 'V2 + :> ZLocalUser + :> ZConn + :> CanThrow ('ActionDenied 'RemoveConversationMember) + :> CanThrow 'ConvNotFound + :> CanThrow 'InvalidOperation + :> "conversations" + :> Capture' '[Description "Conversation ID"] "cnv" ConvId + :> "members" + :> Capture' '[Description "Target User ID"] "usr" UserId + :> RemoveFromConversationVerb + ) + -- This endpoint can lead to the following events being sent: + -- - MemberLeave event to members + :<|> Named + "remove-member" + ( Summary "Remove a member from a conversation" + :> ZLocalUser + :> ZConn + :> CanThrow ('ActionDenied 'RemoveConversationMember) + :> CanThrow 'ConvNotFound + :> CanThrow 'InvalidOperation + :> "conversations" + :> QualifiedCapture' '[Description "Conversation ID"] "cnv" ConvId + :> "members" + :> QualifiedCapture' '[Description "Target User ID"] "usr" UserId + :> RemoveFromConversationVerb + ) + -- This endpoint can lead to the following events being sent: + -- - MemberStateUpdate event to members + :<|> Named + "update-other-member-unqualified" + ( Summary "Update membership of the specified user (deprecated)" + :> Description "Use `PUT /conversations/:cnv_domain/:cnv/members/:usr_domain/:usr` instead" + :> ZLocalUser + :> ZConn + :> CanThrow 'ConvNotFound + :> CanThrow 'ConvMemberNotFound + :> CanThrow ('ActionDenied 'ModifyOtherConversationMember) + :> CanThrow 'InvalidTarget + :> CanThrow 'InvalidOperation + :> "conversations" + :> Capture' '[Description "Conversation ID"] "cnv" ConvId + :> "members" + :> Capture' '[Description "Target User ID"] "usr" UserId + :> ReqBody '[JSON] OtherMemberUpdate + :> MultiVerb + 'PUT + '[JSON] + '[RespondEmpty 200 "Membership updated"] + () + ) + :<|> Named + "update-other-member" + ( Summary "Update membership of the specified user" + :> Description "**Note**: at least one field has to be provided." + :> ZLocalUser + :> ZConn + :> CanThrow 'ConvNotFound + :> CanThrow 'ConvMemberNotFound + :> CanThrow ('ActionDenied 'ModifyOtherConversationMember) + :> CanThrow 'InvalidTarget + :> CanThrow 'InvalidOperation + :> "conversations" + :> QualifiedCapture' '[Description "Conversation ID"] "cnv" ConvId + :> "members" + :> QualifiedCapture' '[Description "Target User ID"] "usr" UserId + :> ReqBody '[JSON] OtherMemberUpdate + :> MultiVerb + 'PUT + '[JSON] + '[RespondEmpty 200 "Membership updated"] + () + ) + -- This endpoint can lead to the following events being sent: + -- - ConvRename event to members + :<|> Named + "update-conversation-name-deprecated" + ( Summary "Update conversation name (deprecated)" + :> Description "Use `/conversations/:domain/:conv/name` instead." + :> CanThrow ('ActionDenied 'ModifyConversationName) + :> CanThrow 'ConvNotFound + :> CanThrow 'InvalidOperation + :> ZLocalUser + :> ZConn + :> "conversations" + :> Capture' '[Description "Conversation ID"] "cnv" ConvId + :> ReqBody '[JSON] ConversationRename + :> MultiVerb + 'PUT + '[JSON] + (UpdateResponses "Name unchanged" "Name updated" Event) + (UpdateResult Event) + ) + :<|> Named + "update-conversation-name-unqualified" + ( Summary "Update conversation name (deprecated)" + :> Description "Use `/conversations/:domain/:conv/name` instead." + :> CanThrow ('ActionDenied 'ModifyConversationName) + :> CanThrow 'ConvNotFound + :> CanThrow 'InvalidOperation + :> ZLocalUser + :> ZConn + :> "conversations" + :> Capture' '[Description "Conversation ID"] "cnv" ConvId + :> "name" + :> ReqBody '[JSON] ConversationRename + :> MultiVerb + 'PUT + '[JSON] + (UpdateResponses "Name unchanged" "Name updated" Event) + (UpdateResult Event) + ) + :<|> Named + "update-conversation-name" + ( Summary "Update conversation name" + :> CanThrow ('ActionDenied 'ModifyConversationName) + :> CanThrow 'ConvNotFound + :> CanThrow 'InvalidOperation + :> ZLocalUser + :> ZConn + :> "conversations" + :> QualifiedCapture' '[Description "Conversation ID"] "cnv" ConvId + :> "name" + :> ReqBody '[JSON] ConversationRename + :> MultiVerb + 'PUT + '[JSON] + (UpdateResponses "Name updated" "Name unchanged" Event) + (UpdateResult Event) + ) + -- This endpoint can lead to the following events being sent: + -- - ConvMessageTimerUpdate event to members + :<|> Named + "update-conversation-message-timer-unqualified" + ( Summary "Update the message timer for a conversation (deprecated)" + :> Description "Use `/conversations/:domain/:cnv/message-timer` instead." + :> ZLocalUser + :> ZConn + :> CanThrow ('ActionDenied 'ModifyConversationMessageTimer) + :> CanThrow 'ConvAccessDenied + :> CanThrow 'ConvNotFound + :> CanThrow 'InvalidOperation + :> "conversations" + :> Capture' '[Description "Conversation ID"] "cnv" ConvId + :> "message-timer" + :> ReqBody '[JSON] ConversationMessageTimerUpdate + :> MultiVerb + 'PUT + '[JSON] + (UpdateResponses "Message timer unchanged" "Message timer updated" Event) + (UpdateResult Event) + ) + :<|> Named + "update-conversation-message-timer" + ( Summary "Update the message timer for a conversation" + :> ZLocalUser + :> ZConn + :> CanThrow ('ActionDenied 'ModifyConversationMessageTimer) + :> CanThrow 'ConvAccessDenied + :> CanThrow 'ConvNotFound + :> CanThrow 'InvalidOperation + :> "conversations" + :> QualifiedCapture' '[Description "Conversation ID"] "cnv" ConvId + :> "message-timer" + :> ReqBody '[JSON] ConversationMessageTimerUpdate + :> MultiVerb + 'PUT + '[JSON] + (UpdateResponses "Message timer unchanged" "Message timer updated" Event) + (UpdateResult Event) + ) + -- This endpoint can lead to the following events being sent: + -- - ConvReceiptModeUpdate event to members + :<|> Named + "update-conversation-receipt-mode-unqualified" + ( Summary "Update receipt mode for a conversation (deprecated)" + :> Description "Use `PUT /conversations/:domain/:cnv/receipt-mode` instead." + :> ZLocalUser + :> ZConn + :> CanThrow ('ActionDenied 'ModifyConversationReceiptMode) + :> CanThrow 'ConvAccessDenied + :> CanThrow 'ConvNotFound + :> CanThrow 'InvalidOperation + :> "conversations" + :> Capture' '[Description "Conversation ID"] "cnv" ConvId + :> "receipt-mode" + :> ReqBody '[JSON] ConversationReceiptModeUpdate + :> MultiVerb + 'PUT + '[JSON] + (UpdateResponses "Receipt mode unchanged" "Receipt mode updated" Event) + (UpdateResult Event) + ) + :<|> Named + "update-conversation-receipt-mode" + ( Summary "Update receipt mode for a conversation" + :> ZLocalUser + :> ZConn + :> CanThrow ('ActionDenied 'ModifyConversationReceiptMode) + :> CanThrow 'ConvAccessDenied + :> CanThrow 'ConvNotFound + :> CanThrow 'InvalidOperation + :> "conversations" + :> QualifiedCapture' '[Description "Conversation ID"] "cnv" ConvId + :> "receipt-mode" + :> ReqBody '[JSON] ConversationReceiptModeUpdate + :> MultiVerb + 'PUT + '[JSON] + (UpdateResponses "Receipt mode unchanged" "Receipt mode updated" Event) + (UpdateResult Event) + ) + -- This endpoint can lead to the following events being sent: + -- - MemberLeave event to members, if members get removed + -- - ConvAccessUpdate event to members + :<|> Named + "update-conversation-access-unqualified" + ( Summary "Update access modes for a conversation (deprecated)" + :> Description "Use PUT `/conversations/:domain/:cnv/access` instead." + :> ZLocalUser + :> ZConn + :> CanThrow ('ActionDenied 'ModifyConversationAccess) + :> CanThrow ('ActionDenied 'RemoveConversationMember) + :> CanThrow 'ConvAccessDenied + :> CanThrow 'ConvNotFound + :> CanThrow 'InvalidOperation + :> CanThrow 'InvalidTargetAccess + :> "conversations" + :> Capture' '[Description "Conversation ID"] "cnv" ConvId + :> "access" + :> ReqBody '[JSON] ConversationAccessData + :> MultiVerb + 'PUT + '[JSON] + (UpdateResponses "Access unchanged" "Access updated" Event) + (UpdateResult Event) + ) + :<|> Named + "update-conversation-access" + ( Summary "Update access modes for a conversation" + :> ZLocalUser + :> ZConn + :> CanThrow ('ActionDenied 'ModifyConversationAccess) + :> CanThrow ('ActionDenied 'RemoveConversationMember) + :> CanThrow 'ConvAccessDenied + :> CanThrow 'ConvNotFound + :> CanThrow 'InvalidOperation + :> CanThrow 'InvalidTargetAccess + :> "conversations" + :> QualifiedCapture' '[Description "Conversation ID"] "cnv" ConvId + :> "access" + :> ReqBody '[JSON] ConversationAccessData + :> MultiVerb + 'PUT + '[JSON] + (UpdateResponses "Access unchanged" "Access updated" Event) + (UpdateResult Event) + ) + :<|> Named + "get-conversation-self-unqualified" + ( Summary "Get self membership properties (deprecated)" + :> ZLocalUser + :> "conversations" + :> Capture' '[Description "Conversation ID"] "cnv" ConvId + :> "self" + :> Get '[JSON] (Maybe Member) + ) + :<|> Named + "update-conversation-self-unqualified" + ( Summary "Update self membership properties (deprecated)" + :> Description "Use `/conversations/:domain/:conv/self` instead." + :> CanThrow 'ConvNotFound + :> ZLocalUser + :> ZConn + :> "conversations" + :> Capture' '[Description "Conversation ID"] "cnv" ConvId + :> "self" + :> ReqBody '[JSON] MemberUpdate + :> MultiVerb + 'PUT + '[JSON] + '[RespondEmpty 200 "Update successful"] + () + ) + :<|> Named + "update-conversation-self" + ( Summary "Update self membership properties" + :> Description "**Note**: at least one field has to be provided." + :> CanThrow 'ConvNotFound + :> ZLocalUser + :> ZConn + :> "conversations" + :> QualifiedCapture' '[Description "Conversation ID"] "cnv" ConvId + :> "self" + :> ReqBody '[JSON] MemberUpdate + :> MultiVerb + 'PUT + '[JSON] + '[RespondEmpty 200 "Update successful"] + () + ) diff --git a/libs/wire-api/src/Wire/API/Routes/Public/Galley/CustomBackend.hs b/libs/wire-api/src/Wire/API/Routes/Public/Galley/CustomBackend.hs new file mode 100644 index 00000000000..079858baa0e --- /dev/null +++ b/libs/wire-api/src/Wire/API/Routes/Public/Galley/CustomBackend.hs @@ -0,0 +1,37 @@ +-- 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.Routes.Public.Galley.CustomBackend where + +import Data.Domain +import Servant hiding (WithStatus) +import Servant.Swagger.Internal.Orphans () +import Wire.API.CustomBackend +import Wire.API.Error +import Wire.API.Error.Galley +import Wire.API.Routes.Named + +type CustomBackendAPI = + Named + "get-custom-backend-by-domain" + ( Summary "Shows information about custom backends related to a given email domain" + :> CanThrow 'CustomBackendNotFound + :> "custom-backend" + :> "by-domain" + :> Capture' '[Description "URL-encoded email domain"] "domain" Domain + :> Get '[JSON] CustomBackend + ) 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 new file mode 100644 index 00000000000..f52fd7b183b --- /dev/null +++ b/libs/wire-api/src/Wire/API/Routes/Public/Galley/Feature.hs @@ -0,0 +1,260 @@ +-- 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.Routes.Public.Galley.Feature where + +import Data.Id +import GHC.TypeLits +import Servant hiding (WithStatus) +import Servant.Swagger.Internal.Orphans () +import Wire.API.Conversation.Role +import Wire.API.Error +import Wire.API.Error.Galley +import Wire.API.Routes.MultiVerb +import Wire.API.Routes.Named +import Wire.API.Routes.Public +import Wire.API.Routes.Version +import Wire.API.Team.Feature +import Wire.API.Team.SearchVisibility (TeamSearchVisibilityView) + +type FeatureAPI = + FeatureStatusGet SSOConfig + :<|> FeatureStatusGet LegalholdConfig + :<|> FeatureStatusPut + '( 'ActionDenied 'RemoveConversationMember, + '( AuthenticationError, + '( 'CannotEnableLegalHoldServiceLargeTeam, + '( 'LegalHoldNotEnabled, + '( 'LegalHoldDisableUnimplemented, + '( 'LegalHoldServiceNotRegistered, + '( 'UserLegalHoldIllegalOperation, + '( 'LegalHoldCouldNotBlockConnections, '()) + ) + ) + ) + ) + ) + ) + ) + LegalholdConfig + :<|> FeatureStatusGet SearchVisibilityAvailableConfig + :<|> FeatureStatusPut '() SearchVisibilityAvailableConfig + :<|> FeatureStatusDeprecatedGet "This endpoint is potentially used by the old Android client. It is not used by iOS, team management, or webapp as of June 2022" SearchVisibilityAvailableConfig + :<|> FeatureStatusDeprecatedPut "This endpoint is potentially used by the old Android client. It is not used by iOS, team management, or webapp as of June 2022" SearchVisibilityAvailableConfig + :<|> SearchVisibilityGet + :<|> SearchVisibilitySet + :<|> FeatureStatusGet ValidateSAMLEmailsConfig + :<|> FeatureStatusDeprecatedGet "This endpoint is potentially used by the old Android client. It is not used by iOS, team management, or webapp as of June 2022" ValidateSAMLEmailsConfig + :<|> FeatureStatusGet DigitalSignaturesConfig + :<|> FeatureStatusDeprecatedGet "The usage of this endpoint was removed in iOS in version 3.101. It is potentially used by the old Android client. It is not used by team management, or webapp as of June 2022" DigitalSignaturesConfig + :<|> FeatureStatusGet AppLockConfig + :<|> FeatureStatusPut '() AppLockConfig + :<|> FeatureStatusGet FileSharingConfig + :<|> FeatureStatusPut '() FileSharingConfig + :<|> FeatureStatusGet ClassifiedDomainsConfig + :<|> FeatureStatusGet ConferenceCallingConfig + :<|> FeatureStatusGet SelfDeletingMessagesConfig + :<|> FeatureStatusPut '() SelfDeletingMessagesConfig + :<|> FeatureStatusGet GuestLinksConfig + :<|> FeatureStatusPut '() GuestLinksConfig + :<|> FeatureStatusGet SndFactorPasswordChallengeConfig + :<|> FeatureStatusPut '() SndFactorPasswordChallengeConfig + :<|> FeatureStatusGet MLSConfig + :<|> FeatureStatusPut '() MLSConfig + :<|> FeatureStatusGet ExposeInvitationURLsToTeamAdminConfig + :<|> FeatureStatusPut '() ExposeInvitationURLsToTeamAdminConfig + :<|> FeatureStatusGet SearchVisibilityInboundConfig + :<|> FeatureStatusPut '() SearchVisibilityInboundConfig + :<|> AllFeatureConfigsUserGet + :<|> AllFeatureConfigsTeamGet + :<|> FeatureConfigDeprecatedGet "The usage of this endpoint was removed in iOS in version 3.101. It is not used by team management, or webapp, and is potentially used by the old Android client as of June 2022" LegalholdConfig + :<|> FeatureConfigDeprecatedGet "The usage of this endpoint was removed in iOS in version 3.101. It is used by team management, webapp, and potentially the old Android client as of June 2022" SSOConfig + :<|> FeatureConfigDeprecatedGet "The usage of this endpoint was removed in iOS in version 3.101. It is not used by team management, or webapp, and is potentially used by the old Android client as of June 2022" SearchVisibilityAvailableConfig + :<|> FeatureConfigDeprecatedGet "The usage of this endpoint was removed in iOS in version 3.101. It is not used by team management, or webapp, and is potentially used by the old Android client as of June 2022" ValidateSAMLEmailsConfig + :<|> FeatureConfigDeprecatedGet "The usage of this endpoint was removed in iOS in version 3.101. It is used by team management, webapp, and potentially the old Android client as of June 2022" DigitalSignaturesConfig + :<|> FeatureConfigDeprecatedGet "The usage of this endpoint was removed in iOS in version 3.101. It is used by team management, webapp, and potentially the old Android client as of June 2022" AppLockConfig + :<|> FeatureConfigDeprecatedGet "The usage of this endpoint was removed in iOS in version 3.101. It is used by team management, webapp, and potentially the old Android client as of June 2022" FileSharingConfig + :<|> FeatureConfigDeprecatedGet "The usage of this endpoint was removed in iOS in version 3.101. It is not used by team management, or webapp, and is potentially used by the old Android client as of June 2022" ClassifiedDomainsConfig + :<|> FeatureConfigDeprecatedGet "The usage of this endpoint was removed in iOS in version 3.101. It is not used by team management, or webapp, and is potentially used by the old Android client as of June 2022" ConferenceCallingConfig + :<|> FeatureConfigDeprecatedGet "The usage of this endpoint was removed in iOS in version 3.101. It is not used by team management, or webapp, and is potentially used by the old Android client as of June 2022" SelfDeletingMessagesConfig + :<|> FeatureConfigDeprecatedGet "The usage of this endpoint was removed in iOS in version 3.101. It is used by team management, webapp, and potentially the old Android client as of June 2022" GuestLinksConfig + :<|> FeatureConfigDeprecatedGet "The usage of this endpoint was removed in iOS in version 3.101. It is used by team management, webapp, and potentially the old Android client as of June 2022" SndFactorPasswordChallengeConfig + :<|> FeatureConfigDeprecatedGet "The usage of this endpoint was removed in iOS in version 3.101. It is used by team management, webapp, and potentially the old Android client as of June 2022" MLSConfig + +type FeatureStatusGet f = + Named + '("get", f) + (ZUser :> FeatureStatusBaseGet f) + +type FeatureStatusPut errs f = + Named + '("put", f) + (ZUser :> FeatureStatusBasePutPublic errs f) + +type FeatureStatusDeprecatedGet d f = + Named + '("get-deprecated", f) + (ZUser :> FeatureStatusBaseDeprecatedGet d f) + +type FeatureStatusDeprecatedPut d f = + Named + '("put-deprecated", f) + (ZUser :> FeatureStatusBaseDeprecatedPut d f) + +type FeatureStatusBaseGet featureConfig = + Summary (AppendSymbol "Get config for " (FeatureSymbol featureConfig)) + :> CanThrow OperationDenied + :> CanThrow 'NotATeamMember + :> CanThrow 'TeamNotFound + :> "teams" + :> Capture "tid" TeamId + :> "features" + :> FeatureSymbol featureConfig + :> Get '[Servant.JSON] (WithStatus featureConfig) + +type FeatureStatusBasePutPublic errs featureConfig = + Summary (AppendSymbol "Put config for " (FeatureSymbol featureConfig)) + :> CanThrow OperationDenied + :> CanThrow 'NotATeamMember + :> CanThrow 'TeamNotFound + :> CanThrow TeamFeatureError + :> CanThrowMany errs + :> "teams" + :> Capture "tid" TeamId + :> "features" + :> FeatureSymbol featureConfig + :> ReqBody '[Servant.JSON] (WithStatusNoLock featureConfig) + :> Put '[Servant.JSON] (WithStatus featureConfig) + +-- | A type for a GET endpoint for a feature with a deprecated path +type FeatureStatusBaseDeprecatedGet desc featureConfig = + ( Summary + (AppendSymbol "[deprecated] Get config for " (FeatureSymbol featureConfig)) + :> Until 'V2 + :> Description + ( "Deprecated. Please use `GET /teams/:tid/features/" + `AppendSymbol` FeatureSymbol featureConfig + `AppendSymbol` "` instead.\n" + `AppendSymbol` desc + ) + :> CanThrow 'NotATeamMember + :> CanThrow OperationDenied + :> CanThrow 'TeamNotFound + :> "teams" + :> Capture "tid" TeamId + :> "features" + :> DeprecatedFeatureName featureConfig + :> Get '[Servant.JSON] (WithStatus featureConfig) + ) + +-- | A type for a PUT endpoint for a feature with a deprecated path +type FeatureStatusBaseDeprecatedPut desc featureConfig = + Summary + (AppendSymbol "[deprecated] Get config for " (FeatureSymbol featureConfig)) + :> Until 'V2 + :> Description + ( "Deprecated. Please use `PUT /teams/:tid/features/" + `AppendSymbol` FeatureSymbol featureConfig + `AppendSymbol` "` instead.\n" + `AppendSymbol` desc + ) + :> CanThrow 'NotATeamMember + :> CanThrow OperationDenied + :> CanThrow 'TeamNotFound + :> CanThrow TeamFeatureError + :> "teams" + :> Capture "tid" TeamId + :> "features" + :> DeprecatedFeatureName featureConfig + :> ReqBody '[Servant.JSON] (WithStatusNoLock featureConfig) + :> Put '[Servant.JSON] (WithStatus featureConfig) + +type FeatureConfigDeprecatedGet desc featureConfig = + Named + '("get-config", featureConfig) + ( Summary (AppendSymbol "[deprecated] Get feature config for feature " (FeatureSymbol featureConfig)) + :> Until 'V2 + :> Description ("Deprecated. Please use `GET /feature-configs` instead.\n" `AppendSymbol` desc) + :> ZUser + :> CanThrow 'NotATeamMember + :> CanThrow OperationDenied + :> CanThrow 'TeamNotFound + :> "feature-configs" + :> FeatureSymbol featureConfig + :> Get '[Servant.JSON] (WithStatus featureConfig) + ) + +type AllFeatureConfigsUserGet = + Named + "get-all-feature-configs-for-user" + ( Summary + "Gets feature configs for a user" + :> Description + "Gets feature configs for a user. If the user is a member of a team and has the required permissions, this will return the team's feature configs.\ + \If the user is not a member of a team, this will return the personal feature configs (the server defaults)." + :> ZUser + :> CanThrow 'NotATeamMember + :> CanThrow OperationDenied + :> CanThrow 'TeamNotFound + :> "feature-configs" + :> Get '[Servant.JSON] AllFeatureConfigs + ) + +type AllFeatureConfigsTeamGet = + Named + "get-all-feature-configs-for-team" + ( Summary "Gets feature configs for a team" + :> Description "Gets feature configs for a team. User must be a member of the team and have permission to view team features." + :> CanThrow 'NotATeamMember + :> CanThrow OperationDenied + :> CanThrow 'TeamNotFound + :> ZLocalUser + :> "teams" + :> Capture "tid" TeamId + :> "features" + :> Get '[JSON] AllFeatureConfigs + ) + +type SearchVisibilityGet = + Named + "get-search-visibility" + ( Summary "Shows the value for search visibility" + :> CanThrow 'NotATeamMember + :> CanThrow OperationDenied + :> ZLocalUser + :> "teams" + :> Capture "tid" TeamId + :> "search-visibility" + :> Get '[JSON] TeamSearchVisibilityView + ) + +type SearchVisibilitySet = + Named + "set-search-visibility" + ( Summary "Sets the search visibility for the whole team" + :> CanThrow 'NotATeamMember + :> CanThrow OperationDenied + :> CanThrow 'TeamSearchVisibilityNotEnabled + :> CanThrow 'TeamNotFound + :> CanThrow TeamFeatureError + :> ZLocalUser + :> "teams" + :> Capture "tid" TeamId + :> "search-visibility" + :> ReqBody '[JSON] TeamSearchVisibilityView + :> MultiVerb 'PUT '[JSON] '[RespondEmpty 204 "Search visibility set"] () + ) diff --git a/libs/wire-api/src/Wire/API/Routes/Public/Galley/LegalHold.hs b/libs/wire-api/src/Wire/API/Routes/Public/Galley/LegalHold.hs new file mode 100644 index 00000000000..0c1ae5b2f13 --- /dev/null +++ b/libs/wire-api/src/Wire/API/Routes/Public/Galley/LegalHold.hs @@ -0,0 +1,234 @@ +-- 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.Routes.Public.Galley.LegalHold where + +import Data.Id +import GHC.Generics +import qualified Generics.SOP as GSOP +import Servant hiding (WithStatus) +import Servant.Swagger.Internal.Orphans () +import Wire.API.Conversation.Role +import Wire.API.Error +import Wire.API.Error.Galley +import Wire.API.Routes.MultiVerb +import Wire.API.Routes.Named +import Wire.API.Routes.Public +import Wire.API.Team.LegalHold + +type LegalHoldAPI = + Named + "create-legal-hold-settings" + ( Summary "Create legal hold service settings" + :> CanThrow 'NotATeamMember + :> CanThrow OperationDenied + :> CanThrow 'LegalHoldNotEnabled + :> CanThrow 'LegalHoldServiceInvalidKey + :> CanThrow 'LegalHoldServiceBadResponse + :> ZLocalUser + :> "teams" + :> Capture "tid" TeamId + :> "legalhold" + :> "settings" + :> ReqBody '[JSON] NewLegalHoldService + :> MultiVerb1 'POST '[JSON] (Respond 201 "Legal hold service settings created" ViewLegalHoldService) + ) + :<|> Named + "get-legal-hold-settings" + ( Summary "Get legal hold service settings" + :> CanThrow 'NotATeamMember + :> CanThrow OperationDenied + :> ZLocalUser + :> "teams" + :> Capture "tid" TeamId + :> "legalhold" + :> "settings" + :> Get '[JSON] ViewLegalHoldService + ) + :<|> Named + "delete-legal-hold-settings" + ( Summary "Delete legal hold service settings" + :> CanThrow AuthenticationError + :> CanThrow OperationDenied + :> CanThrow 'NotATeamMember + :> CanThrow ('ActionDenied 'RemoveConversationMember) + :> CanThrow 'InvalidOperation + :> CanThrow 'LegalHoldNotEnabled + :> CanThrow 'LegalHoldDisableUnimplemented + :> CanThrow 'LegalHoldServiceNotRegistered + :> CanThrow 'UserLegalHoldIllegalOperation + :> CanThrow 'LegalHoldCouldNotBlockConnections + :> Description + "This endpoint can lead to the following events being sent:\n\ + \- ClientRemoved event to members with a legalhold client (via brig)\n\ + \- UserLegalHoldDisabled event to contacts of members with a legalhold client (via brig)" + :> ZLocalUser + :> "teams" + :> Capture "tid" TeamId + :> "legalhold" + :> "settings" + :> ReqBody '[JSON] RemoveLegalHoldSettingsRequest + :> MultiVerb1 'DELETE '[JSON] (RespondEmpty 204 "Legal hold service settings deleted") + ) + :<|> Named + "get-legal-hold" + ( Summary "Get legal hold status" + :> CanThrow 'TeamMemberNotFound + :> ZLocalUser + :> "teams" + :> Capture "tid" TeamId + :> "legalhold" + :> Capture "uid" UserId + :> Get '[JSON] UserLegalHoldStatusResponse + ) + :<|> Named + "consent-to-legal-hold" + ( Summary "Consent to legal hold" + :> CanThrow ('ActionDenied 'RemoveConversationMember) + :> CanThrow 'InvalidOperation + :> CanThrow 'TeamMemberNotFound + :> CanThrow 'UserLegalHoldIllegalOperation + :> CanThrow 'LegalHoldCouldNotBlockConnections + :> ZLocalUser + :> "teams" + :> Capture "tid" TeamId + :> "legalhold" + :> "consent" + :> MultiVerb 'POST '[JSON] GrantConsentResultResponseTypes GrantConsentResult + ) + :<|> Named + "request-legal-hold-device" + ( Summary "Request legal hold device" + :> CanThrow ('ActionDenied 'RemoveConversationMember) + :> CanThrow 'NotATeamMember + :> CanThrow OperationDenied + :> CanThrow 'TeamMemberNotFound + :> CanThrow 'LegalHoldNotEnabled + :> CanThrow 'UserLegalHoldAlreadyEnabled + :> CanThrow 'NoUserLegalHoldConsent + :> CanThrow 'LegalHoldServiceBadResponse + :> CanThrow 'LegalHoldServiceNotRegistered + :> CanThrow 'LegalHoldCouldNotBlockConnections + :> CanThrow 'UserLegalHoldIllegalOperation + :> Description + "This endpoint can lead to the following events being sent:\n\ + \- LegalHoldClientRequested event to contacts of the user the device is requested for, if they didn't already have a legalhold client (via brig)" + :> ZLocalUser + :> "teams" + :> Capture "tid" TeamId + :> "legalhold" + :> Capture "uid" UserId + :> MultiVerb + 'POST + '[JSON] + RequestDeviceResultResponseType + RequestDeviceResult + ) + :<|> Named + "disable-legal-hold-for-user" + ( Summary "Disable legal hold for user" + :> CanThrow AuthenticationError + :> CanThrow ('ActionDenied 'RemoveConversationMember) + :> CanThrow 'NotATeamMember + :> CanThrow OperationDenied + :> CanThrow 'LegalHoldServiceNotRegistered + :> CanThrow 'UserLegalHoldIllegalOperation + :> CanThrow 'LegalHoldCouldNotBlockConnections + :> Description + "This endpoint can lead to the following events being sent:\n\ + \- ClientRemoved event to the user owning the client (via brig)\n\ + \- UserLegalHoldDisabled event to contacts of the user owning the client (via brig)" + :> ZLocalUser + :> "teams" + :> Capture "tid" TeamId + :> "legalhold" + :> Capture "uid" UserId + :> ReqBody '[JSON] DisableLegalHoldForUserRequest + :> MultiVerb + 'DELETE + '[JSON] + DisableLegalHoldForUserResponseType + DisableLegalHoldForUserResponse + ) + :<|> Named + "approve-legal-hold-device" + ( Summary "Approve legal hold device" + :> CanThrow AuthenticationError + :> CanThrow 'AccessDenied + :> CanThrow ('ActionDenied 'RemoveConversationMember) + :> CanThrow 'NotATeamMember + :> CanThrow 'LegalHoldNotEnabled + :> CanThrow 'UserLegalHoldNotPending + :> CanThrow 'NoLegalHoldDeviceAllocated + :> CanThrow 'LegalHoldServiceNotRegistered + :> CanThrow 'UserLegalHoldAlreadyEnabled + :> CanThrow 'UserLegalHoldIllegalOperation + :> CanThrow 'LegalHoldCouldNotBlockConnections + :> Description + "This endpoint can lead to the following events being sent:\n\ + \- ClientAdded event to the user owning the client (via brig)\n\ + \- UserLegalHoldEnabled event to contacts of the user owning the client (via brig)\n\ + \- ClientRemoved event to the user, if removing old client due to max number (via brig)" + :> ZLocalUser + :> ZConn + :> "teams" + :> Capture "tid" TeamId + :> "legalhold" + :> Capture "uid" UserId + :> "approve" + :> ReqBody '[JSON] ApproveLegalHoldForUserRequest + :> MultiVerb1 'PUT '[JSON] (RespondEmpty 200 "Legal hold approved") + ) + +type RequestDeviceResultResponseType = + '[ RespondEmpty 201 "Request device successful", + RespondEmpty 204 "Request device already pending" + ] + +data RequestDeviceResult + = RequestDeviceSuccess + | RequestDeviceAlreadyPending + deriving (Generic) + deriving (AsUnion RequestDeviceResultResponseType) via GenericAsUnion RequestDeviceResultResponseType RequestDeviceResult + +instance GSOP.Generic RequestDeviceResult + +type DisableLegalHoldForUserResponseType = + '[ RespondEmpty 200 "Disable legal hold successful", + RespondEmpty 204 "Legal hold was not enabled" + ] + +data DisableLegalHoldForUserResponse + = DisableLegalHoldSuccess + | DisableLegalHoldWasNotEnabled + deriving (Generic) + deriving (AsUnion DisableLegalHoldForUserResponseType) via GenericAsUnion DisableLegalHoldForUserResponseType DisableLegalHoldForUserResponse + +instance GSOP.Generic DisableLegalHoldForUserResponse + +type GrantConsentResultResponseTypes = + '[ RespondEmpty 201 "Grant consent successful", + RespondEmpty 204 "Consent already granted" + ] + +data GrantConsentResult + = GrantConsentSuccess + | GrantConsentAlreadyGranted + deriving (Generic) + deriving (AsUnion GrantConsentResultResponseTypes) via GenericAsUnion GrantConsentResultResponseTypes GrantConsentResult + +instance GSOP.Generic GrantConsentResult diff --git a/libs/wire-api/src/Wire/API/Routes/Public/Galley/MLS.hs b/libs/wire-api/src/Wire/API/Routes/Public/Galley/MLS.hs new file mode 100644 index 00000000000..5a2c51997ea --- /dev/null +++ b/libs/wire-api/src/Wire/API/Routes/Public/Galley/MLS.hs @@ -0,0 +1,132 @@ +-- 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.Routes.Public.Galley.MLS where + +import Servant hiding (WithStatus) +import Servant.Swagger.Internal.Orphans () +import Wire.API.Error +import Wire.API.Error.Galley +import Wire.API.Event.Conversation +import Wire.API.MLS.CommitBundle +import Wire.API.MLS.Keys +import Wire.API.MLS.Message +import Wire.API.MLS.Serialisation +import Wire.API.MLS.Servant +import Wire.API.MLS.Welcome +import Wire.API.Routes.MultiVerb +import Wire.API.Routes.Named +import Wire.API.Routes.Public +import Wire.API.Routes.Version + +type MLSMessagingAPI = + Named + "mls-welcome-message" + ( Summary "Post an MLS welcome message" + :> CanThrow 'MLSKeyPackageRefNotFound + :> "welcome" + :> ZConn + :> ReqBody '[MLS] (RawMLS Welcome) + :> MultiVerb1 'POST '[JSON] (RespondEmpty 201 "Welcome message sent") + ) + :<|> Named + "mls-message-v1" + ( Summary "Post an MLS message" + :> Until 'V2 + :> CanThrow 'ConvAccessDenied + :> CanThrow 'ConvMemberNotFound + :> CanThrow 'ConvNotFound + :> CanThrow 'LegalHoldNotEnabled + :> CanThrow 'MLSClientMismatch + :> CanThrow 'MLSCommitMissingReferences + :> CanThrow 'MLSKeyPackageRefNotFound + :> CanThrow 'MLSProposalNotFound + :> CanThrow 'MLSProtocolErrorTag + :> CanThrow 'MLSSelfRemovalNotAllowed + :> CanThrow 'MLSStaleMessage + :> CanThrow 'MLSUnsupportedMessage + :> CanThrow 'MLSUnsupportedProposal + :> CanThrow 'MLSClientSenderUserMismatch + :> CanThrow 'MLSGroupConversationMismatch + :> CanThrow 'MissingLegalholdConsent + :> CanThrow MLSProposalFailure + :> "messages" + :> ZConn + :> ReqBody '[MLS] (RawMLS SomeMessage) + :> MultiVerb1 'POST '[JSON] (Respond 201 "Message sent" [Event]) + ) + :<|> Named + "mls-message" + ( Summary "Post an MLS message" + :> From 'V2 + :> CanThrow 'ConvAccessDenied + :> CanThrow 'ConvMemberNotFound + :> CanThrow 'ConvNotFound + :> CanThrow 'LegalHoldNotEnabled + :> CanThrow 'MLSClientMismatch + :> CanThrow 'MLSCommitMissingReferences + :> CanThrow 'MLSKeyPackageRefNotFound + :> CanThrow 'MLSProposalNotFound + :> CanThrow 'MLSProtocolErrorTag + :> CanThrow 'MLSSelfRemovalNotAllowed + :> CanThrow 'MLSStaleMessage + :> CanThrow 'MLSUnsupportedMessage + :> CanThrow 'MLSUnsupportedProposal + :> CanThrow 'MLSClientSenderUserMismatch + :> CanThrow 'MLSGroupConversationMismatch + :> CanThrow 'MissingLegalholdConsent + :> CanThrow MLSProposalFailure + :> "messages" + :> ZConn + :> ReqBody '[MLS] (RawMLS SomeMessage) + :> MultiVerb1 'POST '[JSON] (Respond 201 "Message sent" MLSMessageSendingStatus) + ) + :<|> Named + "mls-commit-bundle" + ( Summary "Post a MLS CommitBundle" + :> From 'V3 + :> CanThrow 'ConvAccessDenied + :> CanThrow 'ConvMemberNotFound + :> CanThrow 'ConvNotFound + :> CanThrow 'LegalHoldNotEnabled + :> CanThrow 'MLSClientMismatch + :> CanThrow 'MLSCommitMissingReferences + :> CanThrow 'MLSKeyPackageRefNotFound + :> CanThrow 'MLSProposalNotFound + :> CanThrow 'MLSProtocolErrorTag + :> CanThrow 'MLSSelfRemovalNotAllowed + :> CanThrow 'MLSStaleMessage + :> CanThrow 'MLSUnsupportedMessage + :> CanThrow 'MLSUnsupportedProposal + :> CanThrow 'MLSClientSenderUserMismatch + :> CanThrow 'MLSGroupConversationMismatch + :> CanThrow 'MLSWelcomeMismatch + :> CanThrow 'MissingLegalholdConsent + :> CanThrow MLSProposalFailure + :> "commit-bundles" + :> ZConn + :> ReqBody '[CommitBundleMimeType] CommitBundle + :> MultiVerb1 'POST '[JSON] (Respond 201 "Commit accepted and forwarded" MLSMessageSendingStatus) + ) + :<|> Named + "mls-public-keys" + ( Summary "Get public keys used by the backend to sign external proposals" + :> "public-keys" + :> MultiVerb1 'GET '[JSON] (Respond 200 "Public keys" MLSPublicKeys) + ) + +type MLSAPI = LiftNamed (ZLocalUser :> "mls" :> MLSMessagingAPI) 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 new file mode 100644 index 00000000000..1e982f96e66 --- /dev/null +++ b/libs/wire-api/src/Wire/API/Routes/Public/Galley/Messaging.hs @@ -0,0 +1,197 @@ +-- 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.Routes.Public.Galley.Messaging where + +import Data.Id +import Data.SOP +import qualified Generics.SOP as GSOP +import Imports +import Servant hiding (WithStatus) +import Servant.Swagger.Internal.Orphans () +import Wire.API.Error +import qualified Wire.API.Error.Brig as BrigError +import Wire.API.Error.Galley +import Wire.API.Message +import Wire.API.Routes.MultiVerb +import Wire.API.Routes.Named +import Wire.API.Routes.Public +import Wire.API.Routes.QualifiedCapture +import Wire.API.ServantProto + +type MessagingAPI = + Named + "post-otr-message-unqualified" + ( Summary "Post an encrypted message to a conversation (accepts JSON or Protobuf)" + :> Description PostOtrDescriptionUnqualified + :> ZLocalUser + :> ZConn + :> "conversations" + :> Capture "cnv" ConvId + :> "otr" + :> "messages" + :> QueryParam "ignore_missing" IgnoreMissing + :> QueryParam "report_missing" ReportMissing + :> ReqBody '[JSON, Proto] NewOtrMessage + :> MultiVerb + 'POST + '[Servant.JSON] + (PostOtrResponses ClientMismatch) + (PostOtrResponse ClientMismatch) + ) + :<|> Named + "post-otr-broadcast-unqualified" + ( Summary "Broadcast an encrypted message to all team members and all contacts (accepts JSON or Protobuf)" + :> Description PostOtrDescriptionUnqualified + :> ZLocalUser + :> ZConn + :> CanThrow 'TeamNotFound + :> CanThrow 'BroadcastLimitExceeded + :> CanThrow 'NonBindingTeam + :> "broadcast" + :> "otr" + :> "messages" + :> QueryParam "ignore_missing" IgnoreMissing + :> QueryParam "report_missing" ReportMissing + :> ReqBody '[JSON, Proto] NewOtrMessage + :> MultiVerb + 'POST + '[JSON] + (PostOtrResponses ClientMismatch) + (PostOtrResponse ClientMismatch) + ) + :<|> Named + "post-proteus-message" + ( Summary "Post an encrypted message to a conversation (accepts only Protobuf)" + :> Description PostOtrDescription + :> ZLocalUser + :> ZConn + :> "conversations" + :> QualifiedCapture "cnv" ConvId + :> "proteus" + :> "messages" + :> ReqBody '[Proto] (RawProto QualifiedNewOtrMessage) + :> MultiVerb + 'POST + '[Servant.JSON] + (PostOtrResponses MessageSendingStatus) + (Either (MessageNotSent MessageSendingStatus) MessageSendingStatus) + ) + :<|> Named + "post-proteus-broadcast" + ( Summary "Post an encrypted message to all team members and all contacts (accepts only Protobuf)" + :> Description PostOtrDescription + :> ZLocalUser + :> ZConn + :> CanThrow 'TeamNotFound + :> CanThrow 'BroadcastLimitExceeded + :> CanThrow 'NonBindingTeam + :> "broadcast" + :> "proteus" + :> "messages" + :> ReqBody '[Proto] QualifiedNewOtrMessage + :> MultiVerb + 'POST + '[JSON] + (PostOtrResponses MessageSendingStatus) + (Either (MessageNotSent MessageSendingStatus) MessageSendingStatus) + ) + +data MessageNotSent a + = MessageNotSentConversationNotFound + | MessageNotSentUnknownClient + | MessageNotSentLegalhold + | MessageNotSentClientMissing a + deriving stock (Eq, Show, Generic, Functor) + deriving + (AsUnion (MessageNotSentResponses a)) + via (GenericAsUnion (MessageNotSentResponses a) (MessageNotSent a)) + +instance GSOP.Generic (MessageNotSent a) + +type MessageNotSentResponses a = + '[ ErrorResponse 'ConvNotFound, + ErrorResponse 'BrigError.UnknownClient, + ErrorResponse 'BrigError.MissingLegalholdConsent, + Respond 412 "Missing clients" a + ] + +type PostOtrResponses a = + MessageNotSentResponses a + .++ '[Respond 201 "Message sent" a] + +type PostOtrResponse a = Either (MessageNotSent a) a + +instance + ( rs ~ (MessageNotSentResponses a .++ '[r]), + a ~ ResponseType r + ) => + AsUnion rs (PostOtrResponse a) + where + toUnion = + eitherToUnion + (toUnion @(MessageNotSentResponses a)) + (Z . I) + + fromUnion = + eitherFromUnion + (fromUnion @(MessageNotSentResponses a)) + (unI . unZ) + +-- This is a work-around for the fact that we sometimes want to send larger lists of user ids +-- in the filter query than fits the url length limit. For details, see +-- https://github.com/zinfra/backend-issues/issues/1248 +type PostOtrDescriptionUnqualified = + "This endpoint ensures that the list of clients is correct and only sends the message if the list is correct.\n\ + \To override this, the endpoint accepts two query params:\n\ + \- `ignore_missing`: Can be 'true' 'false' or a comma separated list of user IDs.\n\ + \ - When 'true' all missing clients are ignored.\n\ + \ - When 'false' all missing clients are reported.\n\ + \ - When comma separated list of user-ids, only clients for listed users are ignored.\n\ + \- `report_missing`: Can be 'true' 'false' or a comma separated list of user IDs.\n\ + \ - When 'true' all missing clients are reported.\n\ + \ - When 'false' all missing clients are ignored.\n\ + \ - When comma separated list of user-ids, only clients for listed users are reported.\n\ + \\n\ + \Apart from these, the request body also accepts `report_missing` which can only be a list of user ids and behaves the same way as the query parameter.\n\ + \\n\ + \All three of these should be considered mutually exclusive. The server however does not error if more than one is specified, it reads them in this order of precedence:\n\ + \- `report_missing` in the request body has highest precedence.\n\ + \- `ignore_missing` in the query param is the next.\n\ + \- `report_missing` in the query param has the lowest precedence.\n\ + \\n\ + \This endpoint can lead to OtrMessageAdd event being sent to the recipients.\n\ + \\n\ + \**NOTE:** The protobuf definitions of the request body can be found at https://github.com/wireapp/generic-message-proto/blob/master/proto/otr.proto." + +type PostOtrDescription = + "This endpoint ensures that the list of clients is correct and only sends the message if the list is correct.\n\ + \To override this, the endpoint accepts `client_mismatch_strategy` in the body. It can have these values:\n\ + \- `report_all`: When set, the message is not sent if any clients are missing. The missing clients are reported in the response.\n\ + \- `ignore_all`: When set, no checks about missing clients are carried out.\n\ + \- `report_only`: Takes a list of qualified UserIDs. If any clients of the listed users are missing, the message is not sent. The missing clients are reported in the response.\n\ + \- `ignore_only`: Takes a list of qualified UserIDs. If any clients of the non-listed users are missing, the message is not sent. The missing clients are reported in the response.\n\ + \\n\ + \The sending of messages in a federated conversation could theoretically fail partially. \ + \To make this case unlikely, the backend first gets a list of clients from all the involved backends and then tries to send a message. \ + \So, if any backend is down, the message is not propagated to anyone. \ + \But the actual message fan out to multiple backends could still fail partially. This type of failure is reported as a 201, \ + \the clients for which the message sending failed are part of the response body.\n\ + \\n\ + \This endpoint can lead to OtrMessageAdd event being sent to the recipients.\n\ + \\n\ + \**NOTE:** The protobuf definitions of the request body can be found at https://github.com/wireapp/generic-message-proto/blob/master/proto/otr.proto." diff --git a/libs/wire-api/src/Wire/API/Routes/Public/Galley/Team.hs b/libs/wire-api/src/Wire/API/Routes/Public/Galley/Team.hs new file mode 100644 index 00000000000..0a81f55c276 --- /dev/null +++ b/libs/wire-api/src/Wire/API/Routes/Public/Galley/Team.hs @@ -0,0 +1,101 @@ +-- 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.Routes.Public.Galley.Team where + +import Data.Id +import Imports +import Servant hiding (WithStatus) +import Servant.Swagger.Internal.Orphans () +import Wire.API.Error +import Wire.API.Error.Galley +import Wire.API.Routes.MultiVerb +import Wire.API.Routes.Named +import Wire.API.Routes.Public +import Wire.API.Team +import Wire.API.Team.Permission + +type TeamAPI = + Named + "create-non-binding-team" + ( Summary "Create a new non binding team" + -- FUTUREWORK: deprecated in https://github.com/wireapp/wire-server/pull/2607 + :> ZUser + :> ZConn + :> CanThrow 'NotConnected + :> CanThrow 'UserBindingExists + :> "teams" + :> ReqBody '[Servant.JSON] NonBindingNewTeam + :> MultiVerb + 'POST + '[JSON] + '[ WithHeaders + '[DescHeader "Location" "Team ID" TeamId] + TeamId + (RespondEmpty 201 "Team ID as `Location` header value") + ] + TeamId + ) + :<|> Named + "update-team" + ( Summary "Update team properties" + :> ZUser + :> ZConn + :> CanThrow 'NotATeamMember + :> CanThrow ('MissingPermission ('Just 'SetTeamData)) + :> "teams" + :> Capture "tid" TeamId + :> ReqBody '[JSON] TeamUpdateData + :> MultiVerb + 'PUT + '[JSON] + '[RespondEmpty 200 "Team updated"] + () + ) + :<|> Named + "get-teams" + ( Summary "Get teams (deprecated); use `GET /teams/:tid`" + -- FUTUREWORK: deprecated in https://github.com/wireapp/wire-server/pull/2607 + :> ZUser + :> "teams" + :> Get '[JSON] TeamList + ) + :<|> Named + "get-team" + ( Summary "Get a team by ID" + :> ZUser + :> CanThrow 'TeamNotFound + :> "teams" + :> Capture "tid" TeamId + :> Get '[JSON] Team + ) + :<|> Named + "delete-team" + ( Summary "Delete a team" + :> ZUser + :> ZConn + :> CanThrow 'TeamNotFound + :> CanThrow ('MissingPermission ('Just 'DeleteTeam)) + :> CanThrow 'NotATeamMember + :> CanThrow OperationDenied + :> CanThrow 'DeleteQueueFull + :> CanThrow AuthenticationError + :> "teams" + :> Capture "tid" TeamId + :> ReqBody '[Servant.JSON] TeamDeleteData + :> MultiVerb 'DELETE '[JSON] '[RespondEmpty 202 "Team is scheduled for removal"] () + ) diff --git a/libs/wire-api/src/Wire/API/Routes/Public/Galley/TeamConversation.hs b/libs/wire-api/src/Wire/API/Routes/Public/Galley/TeamConversation.hs new file mode 100644 index 00000000000..ce00269f8ac --- /dev/null +++ b/libs/wire-api/src/Wire/API/Routes/Public/Galley/TeamConversation.hs @@ -0,0 +1,81 @@ +-- 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.Routes.Public.Galley.TeamConversation where + +import Data.Id +import Servant hiding (WithStatus) +import Servant.Swagger.Internal.Orphans () +import Wire.API.Conversation.Role +import Wire.API.Error +import Wire.API.Error.Galley +import Wire.API.Routes.MultiVerb +import Wire.API.Routes.Named +import Wire.API.Routes.Public +import Wire.API.Team.Conversation + +type TeamConversationAPI = + Named + "get-team-conversation-roles" + ( Summary "Get existing roles available for the given team" + :> CanThrow 'NotATeamMember + :> ZUser + :> "teams" + :> Capture "tid" TeamId + :> "conversations" + :> "roles" + :> Get '[Servant.JSON] ConversationRolesList + ) + :<|> Named + "get-team-conversations" + ( Summary "Get team conversations" + :> CanThrow OperationDenied + :> CanThrow 'NotATeamMember + :> ZUser + :> "teams" + :> Capture "tid" TeamId + :> "conversations" + :> Get '[Servant.JSON] TeamConversationList + ) + :<|> Named + "get-team-conversation" + ( Summary "Get one team conversation" + :> CanThrow 'ConvNotFound + :> CanThrow OperationDenied + :> CanThrow 'NotATeamMember + :> ZUser + :> "teams" + :> Capture "tid" TeamId + :> "conversations" + :> Capture "cid" ConvId + :> Get '[Servant.JSON] TeamConversation + ) + :<|> Named + "delete-team-conversation" + ( Summary "Remove a team conversation" + :> CanThrow ('ActionDenied 'DeleteConversation) + :> CanThrow 'ConvNotFound + :> CanThrow 'InvalidOperation + :> CanThrow 'NotATeamMember + :> ZLocalUser + :> ZConn + :> "teams" + :> Capture "tid" TeamId + :> "conversations" + :> Capture "cid" ConvId + :> MultiVerb 'DELETE '[JSON] '[RespondEmpty 200 "Conversation deleted"] () + ) diff --git a/libs/wire-api/src/Wire/API/Routes/Public/Galley/TeamMember.hs b/libs/wire-api/src/Wire/API/Routes/Public/Galley/TeamMember.hs new file mode 100644 index 00000000000..7f9e99dcaac --- /dev/null +++ b/libs/wire-api/src/Wire/API/Routes/Public/Galley/TeamMember.hs @@ -0,0 +1,219 @@ +-- 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.Routes.Public.Galley.TeamMember where + +import Data.Id +import Data.Int +import Data.Range +import GHC.Generics +import qualified Generics.SOP as GSOP +import Servant hiding (WithStatus) +import Servant.Swagger.Internal.Orphans () +import Wire.API.Error +import Wire.API.Error.Galley +import Wire.API.Routes.CSV +import Wire.API.Routes.LowLevelStream +import Wire.API.Routes.MultiVerb +import Wire.API.Routes.Named +import Wire.API.Routes.Public +import Wire.API.Team.Member +import qualified Wire.API.User as User + +type TeamMemberAPI = + Named + "get-team-members" + ( Summary "Get team members" + :> CanThrow 'NotATeamMember + :> ZLocalUser + :> "teams" + :> Capture "tid" TeamId + :> "members" + :> QueryParam' + [ Optional, + Strict, + Description "Maximum results to be returned" + ] + "maxResults" + (Range 1 HardTruncationLimit Int32) + :> QueryParam' + [ Optional, + Strict, + Description + "Optional, when not specified, the first page will be returned.\ + \Every returned page contains a `pagingState`, this should be supplied to retrieve the next page." + ] + "pagingState" + TeamMembersPagingState + :> Get '[JSON] TeamMembersPage + ) + :<|> Named + "get-team-member" + ( Summary "Get single team member" + :> CanThrow 'NotATeamMember + :> CanThrow 'TeamMemberNotFound + :> ZLocalUser + :> "teams" + :> Capture "tid" TeamId + :> "members" + :> Capture "uid" UserId + :> Get '[JSON] TeamMemberOptPerms + ) + :<|> Named + "get-team-members-by-ids" + ( Summary "Get team members by user id list" + :> Description "The `has_more` field in the response body is always `false`." + :> CanThrow 'NotATeamMember + :> CanThrow 'BulkGetMemberLimitExceeded + :> ZLocalUser + :> "teams" + :> Capture "tid" TeamId + :> "get-members-by-ids-using-post" + :> QueryParam' + [ Optional, + Strict, + Description "Maximum results to be returned" + ] + "maxResults" + (Range 1 HardTruncationLimit Int32) + :> ReqBody '[JSON] User.UserIdList + :> Post '[JSON] TeamMemberListOptPerms + ) + :<|> Named + "add-team-member" + ( Summary "Add a new team member" + -- FUTUREWORK: deprecated in https://github.com/wireapp/wire-server/pull/2607 + :> CanThrow 'InvalidPermissions + :> CanThrow 'NoAddToBinding + :> CanThrow 'NotATeamMember + :> CanThrow 'NotConnected + :> CanThrow OperationDenied + :> CanThrow 'TeamNotFound + :> CanThrow 'TooManyTeamMembers + :> CanThrow 'UserBindingExists + :> CanThrow 'TooManyTeamMembersOnTeamWithLegalhold + :> ZLocalUser + :> ZConn + :> "teams" + :> Capture "tid" TeamId + :> "members" + :> ReqBody '[JSON] NewTeamMember + :> MultiVerb1 + 'POST + '[JSON] + (RespondEmpty 200 "") + ) + :<|> Named + "delete-team-member" + ( Summary "Remove an existing team member" + :> CanThrow AuthenticationError + :> CanThrow 'AccessDenied + :> CanThrow 'TeamMemberNotFound + :> CanThrow 'TeamNotFound + :> CanThrow 'NotATeamMember + :> CanThrow OperationDenied + :> ZLocalUser + :> ZConn + :> "teams" + :> Capture "tid" TeamId + :> "members" + :> Capture "uid" UserId + :> ReqBody '[JSON] TeamMemberDeleteData + :> MultiVerb + 'DELETE + '[JSON] + TeamMemberDeleteResultResponseType + TeamMemberDeleteResult + ) + :<|> Named + "delete-non-binding-team-member" + ( Summary "Remove an existing team member" + -- FUTUREWORK: deprecated in https://github.com/wireapp/wire-server/pull/2607 + :> CanThrow AuthenticationError + :> CanThrow 'AccessDenied + :> CanThrow 'TeamMemberNotFound + :> CanThrow 'TeamNotFound + :> CanThrow 'NotATeamMember + :> CanThrow OperationDenied + :> ZLocalUser + :> ZConn + :> "teams" + :> Capture "tid" TeamId + :> "members" + :> Capture "uid" UserId + :> MultiVerb + 'DELETE + '[JSON] + TeamMemberDeleteResultResponseType + TeamMemberDeleteResult + ) + :<|> Named + "update-team-member" + ( Summary "Update an existing team member" + :> CanThrow 'AccessDenied + :> CanThrow 'InvalidPermissions + :> CanThrow 'TeamNotFound + :> CanThrow 'TeamMemberNotFound + :> CanThrow 'NotATeamMember + :> CanThrow OperationDenied + :> ZLocalUser + :> ZConn + :> "teams" + :> Capture "tid" TeamId + :> "members" + :> ReqBody '[JSON] NewTeamMember + :> MultiVerb1 + 'PUT + '[JSON] + (RespondEmpty 200 "") + ) + :<|> Named + "get-team-members-csv" + ( Summary "Get all members of the team as a CSV file" + :> CanThrow 'AccessDenied + :> Description + "The endpoint returns data in chunked transfer encoding.\ + \ Internal server errors might result in a failed transfer\ + \ instead of a 500 response." + :> ZLocalUser + :> "teams" + :> Capture "tid" TeamId + :> "members" + :> "csv" + :> LowLevelStream + 'GET + 200 + '[ '( "Content-Disposition", + "attachment; filename=\"wire_team_members.csv\"" + ) + ] + "CSV of team members" + CSV + ) + +type TeamMemberDeleteResultResponseType = + '[ RespondEmpty 202 "Team member scheduled for deletion", + RespondEmpty 200 "" + ] + +data TeamMemberDeleteResult + = TeamMemberDeleteAccepted + | TeamMemberDeleteCompleted + deriving (Generic) + deriving (AsUnion TeamMemberDeleteResultResponseType) via GenericAsUnion TeamMemberDeleteResultResponseType TeamMemberDeleteResult + +instance GSOP.Generic TeamMemberDeleteResult diff --git a/libs/wire-api/wire-api.cabal b/libs/wire-api/wire-api.cabal index 0cef6f4c10b..866f26746c7 100644 --- a/libs/wire-api/wire-api.cabal +++ b/libs/wire-api/wire-api.cabal @@ -91,6 +91,16 @@ library Wire.API.Routes.Public.Cannon Wire.API.Routes.Public.Cargohold Wire.API.Routes.Public.Galley + Wire.API.Routes.Public.Galley.Bot + Wire.API.Routes.Public.Galley.Conversation + Wire.API.Routes.Public.Galley.CustomBackend + Wire.API.Routes.Public.Galley.Feature + Wire.API.Routes.Public.Galley.LegalHold + Wire.API.Routes.Public.Galley.Messaging + Wire.API.Routes.Public.Galley.MLS + Wire.API.Routes.Public.Galley.Team + Wire.API.Routes.Public.Galley.TeamConversation + Wire.API.Routes.Public.Galley.TeamMember Wire.API.Routes.Public.Gundeck Wire.API.Routes.Public.Spar Wire.API.Routes.Public.Util diff --git a/services/galley/galley.cabal b/services/galley/galley.cabal index 6e3529e4974..448a2f9dce4 100644 --- a/services/galley/galley.cabal +++ b/services/galley/galley.cabal @@ -42,7 +42,17 @@ library Galley.API.MLS.Welcome Galley.API.One2One Galley.API.Public + Galley.API.Public.Bot + Galley.API.Public.Conversation + Galley.API.Public.CustomBackend + Galley.API.Public.Feature + Galley.API.Public.LegalHold + Galley.API.Public.Messaging + Galley.API.Public.MLS Galley.API.Public.Servant + Galley.API.Public.Team + Galley.API.Public.TeamConversation + Galley.API.Public.TeamMember Galley.API.Push Galley.API.Query Galley.API.Teams diff --git a/services/galley/src/Galley/API/Create.hs b/services/galley/src/Galley/API/Create.hs index edaee398a78..ed93dca5661 100644 --- a/services/galley/src/Galley/API/Create.hs +++ b/services/galley/src/Galley/API/Create.hs @@ -72,7 +72,7 @@ import Wire.API.Error import Wire.API.Error.Galley import Wire.API.Event.Conversation import Wire.API.Federation.Error -import Wire.API.Routes.Public.Galley (ConversationResponse) +import Wire.API.Routes.Public.Galley.Conversation import Wire.API.Routes.Public.Util import Wire.API.Team import Wire.API.Team.LegalHold (LegalholdProtectee (LegalholdPlusFederationNotImplemented)) diff --git a/services/galley/src/Galley/API/Internal.hs b/services/galley/src/Galley/API/Internal.hs index f57d698186f..b2e55a7bce2 100644 --- a/services/galley/src/Galley/API/Internal.hs +++ b/services/galley/src/Galley/API/Internal.hs @@ -103,7 +103,8 @@ import Wire.API.Routes.MultiTablePaging (mtpHasMore, mtpPagingState, mtpResults) import Wire.API.Routes.MultiVerb import Wire.API.Routes.Named import Wire.API.Routes.Public -import Wire.API.Routes.Public.Galley +import Wire.API.Routes.Public.Galley.Conversation +import Wire.API.Routes.Public.Galley.Feature import Wire.API.Team import Wire.API.Team.Feature import Wire.API.Team.Member diff --git a/services/galley/src/Galley/API/LegalHold.hs b/services/galley/src/Galley/API/LegalHold.hs index 71288e7af5c..151bc14655d 100644 --- a/services/galley/src/Galley/API/LegalHold.hs +++ b/services/galley/src/Galley/API/LegalHold.hs @@ -74,7 +74,7 @@ import Wire.API.Error import Wire.API.Error.Galley import Wire.API.Provider.Service import Wire.API.Routes.Internal.Brig.Connection -import Wire.API.Routes.Public.Galley (DisableLegalHoldForUserResponse (..), GrantConsentResult (..), RequestDeviceResult (..)) +import Wire.API.Routes.Public.Galley.LegalHold import qualified Wire.API.Team.Feature as Public import Wire.API.Team.LegalHold import qualified Wire.API.Team.LegalHold as Public diff --git a/services/galley/src/Galley/API/Message.hs b/services/galley/src/Galley/API/Message.hs index 199129610a7..a16128fa370 100644 --- a/services/galley/src/Galley/API/Message.hs +++ b/services/galley/src/Galley/API/Message.hs @@ -79,7 +79,7 @@ import Wire.API.Federation.API.Brig import Wire.API.Federation.API.Galley import Wire.API.Federation.Error import Wire.API.Message -import Wire.API.Routes.Public.Galley +import Wire.API.Routes.Public.Galley.Messaging import Wire.API.Team.LegalHold import Wire.API.Team.Member import Wire.API.User.Client diff --git a/services/galley/src/Galley/API/Public/Bot.hs b/services/galley/src/Galley/API/Public/Bot.hs new file mode 100644 index 00000000000..8c75ddbdee9 --- /dev/null +++ b/services/galley/src/Galley/API/Public/Bot.hs @@ -0,0 +1,26 @@ +-- 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 Galley.API.Public.Bot where + +import Galley.API.Update +import Galley.App +import Wire.API.Routes.API +import Wire.API.Routes.Public.Galley.Bot + +botAPI :: API BotAPI GalleyEffects +botAPI = mkNamedAPI @"post-bot-message-unqualified" postBotMessageUnqualified diff --git a/services/galley/src/Galley/API/Public/Conversation.hs b/services/galley/src/Galley/API/Public/Conversation.hs new file mode 100644 index 00000000000..6bff31d00d9 --- /dev/null +++ b/services/galley/src/Galley/API/Public/Conversation.hs @@ -0,0 +1,72 @@ +-- 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 Galley.API.Public.Conversation where + +import Galley.API.Create +import Galley.API.MLS.GroupInfo +import Galley.API.Query +import Galley.API.Update +import Galley.App +import Galley.Cassandra.TeamFeatures +import Wire.API.Routes.API +import Wire.API.Routes.Public.Galley.Conversation + +conversationAPI :: API ConversationAPI GalleyEffects +conversationAPI = + mkNamedAPI @"get-unqualified-conversation" getUnqualifiedConversation + <@> mkNamedAPI @"get-unqualified-conversation-legalhold-alias" getUnqualifiedConversation + <@> mkNamedAPI @"get-conversation" getConversation + <@> mkNamedAPI @"get-conversation-roles" getConversationRoles + <@> mkNamedAPI @"get-group-info" getGroupInfo + <@> mkNamedAPI @"list-conversation-ids-unqualified" conversationIdsPageFromUnqualified + <@> mkNamedAPI @"list-conversation-ids" conversationIdsPageFrom + <@> mkNamedAPI @"get-conversations" getConversations + <@> mkNamedAPI @"list-conversations-v1" listConversations + <@> mkNamedAPI @"list-conversations" listConversations + <@> mkNamedAPI @"get-conversation-by-reusable-code" (getConversationByReusableCode @Cassandra) + <@> mkNamedAPI @"create-group-conversation" createGroupConversation + <@> mkNamedAPI @"create-self-conversation" createProteusSelfConversation + <@> mkNamedAPI @"create-mls-self-conversation" createMLSSelfConversation + <@> mkNamedAPI @"create-one-to-one-conversation" createOne2OneConversation + <@> mkNamedAPI @"add-members-to-conversation-unqualified" addMembersUnqualified + <@> mkNamedAPI @"add-members-to-conversation-unqualified2" addMembersUnqualifiedV2 + <@> mkNamedAPI @"add-members-to-conversation" addMembers + <@> mkNamedAPI @"join-conversation-by-id-unqualified" (joinConversationById @Cassandra) + <@> mkNamedAPI @"join-conversation-by-code-unqualified" (joinConversationByReusableCode @Cassandra) + <@> mkNamedAPI @"code-check" (checkReusableCode @Cassandra) + <@> mkNamedAPI @"create-conversation-code-unqualified" (addCodeUnqualified @Cassandra) + <@> mkNamedAPI @"get-conversation-guest-links-status" (getConversationGuestLinksStatus @Cassandra) + <@> mkNamedAPI @"remove-code-unqualified" rmCodeUnqualified + <@> mkNamedAPI @"get-code" (getCode @Cassandra) + <@> mkNamedAPI @"member-typing-unqualified" isTypingUnqualified + <@> mkNamedAPI @"remove-member-unqualified" removeMemberUnqualified + <@> mkNamedAPI @"remove-member" removeMemberQualified + <@> mkNamedAPI @"update-other-member-unqualified" updateOtherMemberUnqualified + <@> mkNamedAPI @"update-other-member" updateOtherMember + <@> mkNamedAPI @"update-conversation-name-deprecated" updateUnqualifiedConversationName + <@> mkNamedAPI @"update-conversation-name-unqualified" updateUnqualifiedConversationName + <@> mkNamedAPI @"update-conversation-name" updateConversationName + <@> mkNamedAPI @"update-conversation-message-timer-unqualified" updateConversationMessageTimerUnqualified + <@> mkNamedAPI @"update-conversation-message-timer" updateConversationMessageTimer + <@> mkNamedAPI @"update-conversation-receipt-mode-unqualified" updateConversationReceiptModeUnqualified + <@> mkNamedAPI @"update-conversation-receipt-mode" updateConversationReceiptMode + <@> mkNamedAPI @"update-conversation-access-unqualified" updateConversationAccessUnqualified + <@> mkNamedAPI @"update-conversation-access" updateConversationAccess + <@> mkNamedAPI @"get-conversation-self-unqualified" getLocalSelf + <@> mkNamedAPI @"update-conversation-self-unqualified" updateUnqualifiedSelfMember + <@> mkNamedAPI @"update-conversation-self" updateSelfMember diff --git a/services/galley/src/Galley/API/Public/CustomBackend.hs b/services/galley/src/Galley/API/Public/CustomBackend.hs new file mode 100644 index 00000000000..23b79abedf9 --- /dev/null +++ b/services/galley/src/Galley/API/Public/CustomBackend.hs @@ -0,0 +1,26 @@ +-- 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 Galley.API.Public.CustomBackend where + +import Galley.API.CustomBackend +import Galley.App +import Wire.API.Routes.API +import Wire.API.Routes.Public.Galley.CustomBackend + +customBackendAPI :: API CustomBackendAPI GalleyEffects +customBackendAPI = mkNamedAPI @"get-custom-backend-by-domain" getCustomBackendByDomain diff --git a/services/galley/src/Galley/API/Public/Feature.hs b/services/galley/src/Galley/API/Public/Feature.hs new file mode 100644 index 00000000000..2d4f06ea85e --- /dev/null +++ b/services/galley/src/Galley/API/Public/Feature.hs @@ -0,0 +1,76 @@ +-- 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 Galley.API.Public.Feature where + +import Galley.API.Teams +import Galley.API.Teams.Features +import Galley.App +import Galley.Cassandra.TeamFeatures +import Imports +import Wire.API.Routes.API +import Wire.API.Routes.Public.Galley.Feature +import Wire.API.Team.Feature + +featureAPI :: API FeatureAPI GalleyEffects +featureAPI = + mkNamedAPI @'("get", SSOConfig) (getFeatureStatus @Cassandra . DoAuth) + <@> mkNamedAPI @'("get", LegalholdConfig) (getFeatureStatus @Cassandra . DoAuth) + <@> mkNamedAPI @'("put", LegalholdConfig) (setFeatureStatus @Cassandra . DoAuth) + <@> mkNamedAPI @'("get", SearchVisibilityAvailableConfig) (getFeatureStatus @Cassandra . DoAuth) + <@> mkNamedAPI @'("put", SearchVisibilityAvailableConfig) (setFeatureStatus @Cassandra . DoAuth) + <@> mkNamedAPI @'("get-deprecated", SearchVisibilityAvailableConfig) (getFeatureStatus @Cassandra . DoAuth) + <@> mkNamedAPI @'("put-deprecated", SearchVisibilityAvailableConfig) (setFeatureStatus @Cassandra . DoAuth) + <@> mkNamedAPI @"get-search-visibility" getSearchVisibility + <@> mkNamedAPI @"set-search-visibility" (setSearchVisibility @Cassandra (featureEnabledForTeam @Cassandra @SearchVisibilityAvailableConfig)) + <@> mkNamedAPI @'("get", ValidateSAMLEmailsConfig) (getFeatureStatus @Cassandra . DoAuth) + <@> mkNamedAPI @'("get-deprecated", ValidateSAMLEmailsConfig) (getFeatureStatus @Cassandra . DoAuth) + <@> mkNamedAPI @'("get", DigitalSignaturesConfig) (getFeatureStatus @Cassandra . DoAuth) + <@> mkNamedAPI @'("get-deprecated", DigitalSignaturesConfig) (getFeatureStatus @Cassandra . DoAuth) + <@> mkNamedAPI @'("get", AppLockConfig) (getFeatureStatus @Cassandra . DoAuth) + <@> mkNamedAPI @'("put", AppLockConfig) (setFeatureStatus @Cassandra . DoAuth) + <@> mkNamedAPI @'("get", FileSharingConfig) (getFeatureStatus @Cassandra . DoAuth) + <@> mkNamedAPI @'("put", FileSharingConfig) (setFeatureStatus @Cassandra . DoAuth) + <@> mkNamedAPI @'("get", ClassifiedDomainsConfig) (getFeatureStatus @Cassandra . DoAuth) + <@> mkNamedAPI @'("get", ConferenceCallingConfig) (getFeatureStatus @Cassandra . DoAuth) + <@> mkNamedAPI @'("get", SelfDeletingMessagesConfig) (getFeatureStatus @Cassandra . DoAuth) + <@> mkNamedAPI @'("put", SelfDeletingMessagesConfig) (setFeatureStatus @Cassandra . DoAuth) + <@> mkNamedAPI @'("get", GuestLinksConfig) (getFeatureStatus @Cassandra . DoAuth) + <@> mkNamedAPI @'("put", GuestLinksConfig) (setFeatureStatus @Cassandra . DoAuth) + <@> mkNamedAPI @'("get", SndFactorPasswordChallengeConfig) (getFeatureStatus @Cassandra . DoAuth) + <@> mkNamedAPI @'("put", SndFactorPasswordChallengeConfig) (setFeatureStatus @Cassandra . DoAuth) + <@> mkNamedAPI @'("get", MLSConfig) (getFeatureStatus @Cassandra . DoAuth) + <@> mkNamedAPI @'("put", MLSConfig) (setFeatureStatus @Cassandra . DoAuth) + <@> mkNamedAPI @'("get", ExposeInvitationURLsToTeamAdminConfig) (getFeatureStatus @Cassandra . DoAuth) + <@> mkNamedAPI @'("put", ExposeInvitationURLsToTeamAdminConfig) (setFeatureStatus @Cassandra . DoAuth) + <@> mkNamedAPI @'("get", SearchVisibilityInboundConfig) (getFeatureStatus @Cassandra . DoAuth) + <@> mkNamedAPI @'("put", SearchVisibilityInboundConfig) (setFeatureStatus @Cassandra . DoAuth) + <@> mkNamedAPI @"get-all-feature-configs-for-user" (getAllFeatureConfigsForUser @Cassandra) + <@> mkNamedAPI @"get-all-feature-configs-for-team" (getAllFeatureConfigsForTeam @Cassandra) + <@> mkNamedAPI @'("get-config", LegalholdConfig) (getFeatureStatusForUser @Cassandra) + <@> mkNamedAPI @'("get-config", SSOConfig) (getFeatureStatusForUser @Cassandra) + <@> mkNamedAPI @'("get-config", SearchVisibilityAvailableConfig) (getFeatureStatusForUser @Cassandra) + <@> mkNamedAPI @'("get-config", ValidateSAMLEmailsConfig) (getFeatureStatusForUser @Cassandra) + <@> mkNamedAPI @'("get-config", DigitalSignaturesConfig) (getFeatureStatusForUser @Cassandra) + <@> mkNamedAPI @'("get-config", AppLockConfig) (getFeatureStatusForUser @Cassandra) + <@> mkNamedAPI @'("get-config", FileSharingConfig) (getFeatureStatusForUser @Cassandra) + <@> mkNamedAPI @'("get-config", ClassifiedDomainsConfig) (getFeatureStatusForUser @Cassandra) + <@> mkNamedAPI @'("get-config", ConferenceCallingConfig) (getFeatureStatusForUser @Cassandra) + <@> mkNamedAPI @'("get-config", SelfDeletingMessagesConfig) (getFeatureStatusForUser @Cassandra) + <@> mkNamedAPI @'("get-config", GuestLinksConfig) (getFeatureStatusForUser @Cassandra) + <@> mkNamedAPI @'("get-config", SndFactorPasswordChallengeConfig) (getFeatureStatusForUser @Cassandra) + <@> mkNamedAPI @'("get-config", MLSConfig) (getFeatureStatusForUser @Cassandra) diff --git a/services/galley/src/Galley/API/Public/LegalHold.hs b/services/galley/src/Galley/API/Public/LegalHold.hs new file mode 100644 index 00000000000..21d658d2171 --- /dev/null +++ b/services/galley/src/Galley/API/Public/LegalHold.hs @@ -0,0 +1,35 @@ +-- 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 Galley.API.Public.LegalHold where + +import Galley.API.LegalHold +import Galley.App +import Galley.Cassandra.TeamFeatures +import Wire.API.Routes.API +import Wire.API.Routes.Public.Galley.LegalHold + +legalHoldAPI :: API LegalHoldAPI GalleyEffects +legalHoldAPI = + mkNamedAPI @"create-legal-hold-settings" (createSettings @Cassandra) + <@> mkNamedAPI @"get-legal-hold-settings" (getSettings @Cassandra) + <@> mkNamedAPI @"delete-legal-hold-settings" (removeSettingsInternalPaging @Cassandra) + <@> mkNamedAPI @"get-legal-hold" getUserStatus + <@> mkNamedAPI @"consent-to-legal-hold" grantConsent + <@> mkNamedAPI @"request-legal-hold-device" (requestDevice @Cassandra) + <@> mkNamedAPI @"disable-legal-hold-for-user" disableForUser + <@> mkNamedAPI @"approve-legal-hold-device" (approveDevice @Cassandra) diff --git a/services/galley/src/Galley/API/Public/MLS.hs b/services/galley/src/Galley/API/Public/MLS.hs new file mode 100644 index 00000000000..93bd240b77d --- /dev/null +++ b/services/galley/src/Galley/API/Public/MLS.hs @@ -0,0 +1,31 @@ +-- 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 Galley.API.Public.MLS where + +import Galley.API.MLS +import Galley.App +import Wire.API.Routes.API +import Wire.API.Routes.Public.Galley.MLS + +mlsAPI :: API MLSAPI GalleyEffects +mlsAPI = + mkNamedAPI @"mls-welcome-message" postMLSWelcomeFromLocalUser + <@> mkNamedAPI @"mls-message-v1" postMLSMessageFromLocalUserV1 + <@> mkNamedAPI @"mls-message" postMLSMessageFromLocalUser + <@> mkNamedAPI @"mls-commit-bundle" postMLSCommitBundleFromLocalUser + <@> mkNamedAPI @"mls-public-keys" getMLSPublicKeys diff --git a/services/galley/src/Galley/API/Public/Messaging.hs b/services/galley/src/Galley/API/Public/Messaging.hs new file mode 100644 index 00000000000..806484ae908 --- /dev/null +++ b/services/galley/src/Galley/API/Public/Messaging.hs @@ -0,0 +1,30 @@ +-- 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 Galley.API.Public.Messaging where + +import Galley.API.Update +import Galley.App +import Wire.API.Routes.API +import Wire.API.Routes.Public.Galley.Messaging + +messagingAPI :: API MessagingAPI GalleyEffects +messagingAPI = + mkNamedAPI @"post-otr-message-unqualified" postOtrMessageUnqualified + <@> mkNamedAPI @"post-otr-broadcast-unqualified" postOtrBroadcastUnqualified + <@> mkNamedAPI @"post-proteus-message" postProteusMessage + <@> mkNamedAPI @"post-proteus-broadcast" postProteusBroadcast diff --git a/services/galley/src/Galley/API/Public/Servant.hs b/services/galley/src/Galley/API/Public/Servant.hs index ef8640cbcce..e7eae6added 100644 --- a/services/galley/src/Galley/API/Public/Servant.hs +++ b/services/galley/src/Galley/API/Public/Servant.hs @@ -17,181 +17,29 @@ module Galley.API.Public.Servant (mkNamedAPI, servantSitemap) where -import Galley.API.Create -import Galley.API.CustomBackend -import Galley.API.LegalHold -import Galley.API.MLS -import Galley.API.MLS.GroupInfo -import Galley.API.Query -import Galley.API.Teams -import Galley.API.Teams.Features -import Galley.API.Update +import Galley.API.Public.Bot +import Galley.API.Public.Conversation +import Galley.API.Public.CustomBackend +import Galley.API.Public.Feature +import Galley.API.Public.LegalHold +import Galley.API.Public.MLS +import Galley.API.Public.Messaging +import Galley.API.Public.Team +import Galley.API.Public.TeamConversation +import Galley.API.Public.TeamMember import Galley.App -import Galley.Cassandra.TeamFeatures -import Imports import Wire.API.Routes.API import Wire.API.Routes.Public.Galley -import Wire.API.Team.Feature servantSitemap :: API ServantAPI GalleyEffects servantSitemap = - conversations - <@> teamConversations - <@> messaging - <@> bot - <@> team - <@> features - <@> mls - <@> customBackend - <@> legalHold - <@> teamMember - where - conversations = - mkNamedAPI @"get-unqualified-conversation" getUnqualifiedConversation - <@> mkNamedAPI @"get-unqualified-conversation-legalhold-alias" getUnqualifiedConversation - <@> mkNamedAPI @"get-conversation" getConversation - <@> mkNamedAPI @"get-conversation-roles" getConversationRoles - <@> mkNamedAPI @"get-group-info" getGroupInfo - <@> mkNamedAPI @"list-conversation-ids-unqualified" conversationIdsPageFromUnqualified - <@> mkNamedAPI @"list-conversation-ids" conversationIdsPageFrom - <@> mkNamedAPI @"get-conversations" getConversations - <@> mkNamedAPI @"list-conversations-v1" listConversations - <@> mkNamedAPI @"list-conversations" listConversations - <@> mkNamedAPI @"get-conversation-by-reusable-code" (getConversationByReusableCode @Cassandra) - <@> mkNamedAPI @"create-group-conversation" createGroupConversation - <@> mkNamedAPI @"create-self-conversation" createProteusSelfConversation - <@> mkNamedAPI @"create-mls-self-conversation" createMLSSelfConversation - <@> mkNamedAPI @"create-one-to-one-conversation" createOne2OneConversation - <@> mkNamedAPI @"add-members-to-conversation-unqualified" addMembersUnqualified - <@> mkNamedAPI @"add-members-to-conversation-unqualified2" addMembersUnqualifiedV2 - <@> mkNamedAPI @"add-members-to-conversation" addMembers - <@> mkNamedAPI @"join-conversation-by-id-unqualified" (joinConversationById @Cassandra) - <@> mkNamedAPI @"join-conversation-by-code-unqualified" (joinConversationByReusableCode @Cassandra) - <@> mkNamedAPI @"code-check" (checkReusableCode @Cassandra) - <@> mkNamedAPI @"create-conversation-code-unqualified" (addCodeUnqualified @Cassandra) - <@> mkNamedAPI @"get-conversation-guest-links-status" (getConversationGuestLinksStatus @Cassandra) - <@> mkNamedAPI @"remove-code-unqualified" rmCodeUnqualified - <@> mkNamedAPI @"get-code" (getCode @Cassandra) - <@> mkNamedAPI @"member-typing-unqualified" isTypingUnqualified - <@> mkNamedAPI @"remove-member-unqualified" removeMemberUnqualified - <@> mkNamedAPI @"remove-member" removeMemberQualified - <@> mkNamedAPI @"update-other-member-unqualified" updateOtherMemberUnqualified - <@> mkNamedAPI @"update-other-member" updateOtherMember - <@> mkNamedAPI @"update-conversation-name-deprecated" updateUnqualifiedConversationName - <@> mkNamedAPI @"update-conversation-name-unqualified" updateUnqualifiedConversationName - <@> mkNamedAPI @"update-conversation-name" updateConversationName - <@> mkNamedAPI @"update-conversation-message-timer-unqualified" updateConversationMessageTimerUnqualified - <@> mkNamedAPI @"update-conversation-message-timer" updateConversationMessageTimer - <@> mkNamedAPI @"update-conversation-receipt-mode-unqualified" updateConversationReceiptModeUnqualified - <@> mkNamedAPI @"update-conversation-receipt-mode" updateConversationReceiptMode - <@> mkNamedAPI @"update-conversation-access-unqualified" updateConversationAccessUnqualified - <@> mkNamedAPI @"update-conversation-access" updateConversationAccess - <@> mkNamedAPI @"get-conversation-self-unqualified" getLocalSelf - <@> mkNamedAPI @"update-conversation-self-unqualified" updateUnqualifiedSelfMember - <@> mkNamedAPI @"update-conversation-self" updateSelfMember - - teamConversations :: API TeamConversationAPI GalleyEffects - teamConversations = - mkNamedAPI @"get-team-conversation-roles" getTeamConversationRoles - <@> mkNamedAPI @"get-team-conversations" getTeamConversations - <@> mkNamedAPI @"get-team-conversation" getTeamConversation - <@> mkNamedAPI @"delete-team-conversation" deleteTeamConversation - - messaging :: API MessagingAPI GalleyEffects - messaging = - mkNamedAPI @"post-otr-message-unqualified" postOtrMessageUnqualified - <@> mkNamedAPI @"post-otr-broadcast-unqualified" postOtrBroadcastUnqualified - <@> mkNamedAPI @"post-proteus-message" postProteusMessage - <@> mkNamedAPI @"post-proteus-broadcast" postProteusBroadcast - - bot :: API BotAPI GalleyEffects - bot = mkNamedAPI @"post-bot-message-unqualified" postBotMessageUnqualified - - team = - mkNamedAPI @"create-non-binding-team" createNonBindingTeamH - <@> mkNamedAPI @"update-team" updateTeamH - <@> mkNamedAPI @"get-teams" getManyTeams - <@> mkNamedAPI @"get-team" getTeamH - <@> mkNamedAPI @"delete-team" deleteTeam - - features :: API FeatureAPI GalleyEffects - features = - mkNamedAPI @'("get", SSOConfig) (getFeatureStatus @Cassandra . DoAuth) - <@> mkNamedAPI @'("get", LegalholdConfig) (getFeatureStatus @Cassandra . DoAuth) - <@> mkNamedAPI @'("put", LegalholdConfig) (setFeatureStatus @Cassandra . DoAuth) - <@> mkNamedAPI @'("get", SearchVisibilityAvailableConfig) (getFeatureStatus @Cassandra . DoAuth) - <@> mkNamedAPI @'("put", SearchVisibilityAvailableConfig) (setFeatureStatus @Cassandra . DoAuth) - <@> mkNamedAPI @'("get-deprecated", SearchVisibilityAvailableConfig) (getFeatureStatus @Cassandra . DoAuth) - <@> mkNamedAPI @'("put-deprecated", SearchVisibilityAvailableConfig) (setFeatureStatus @Cassandra . DoAuth) - <@> mkNamedAPI @"get-search-visibility" getSearchVisibility - <@> mkNamedAPI @"set-search-visibility" (setSearchVisibility @Cassandra (featureEnabledForTeam @Cassandra @SearchVisibilityAvailableConfig)) - <@> mkNamedAPI @'("get", ValidateSAMLEmailsConfig) (getFeatureStatus @Cassandra . DoAuth) - <@> mkNamedAPI @'("get-deprecated", ValidateSAMLEmailsConfig) (getFeatureStatus @Cassandra . DoAuth) - <@> mkNamedAPI @'("get", DigitalSignaturesConfig) (getFeatureStatus @Cassandra . DoAuth) - <@> mkNamedAPI @'("get-deprecated", DigitalSignaturesConfig) (getFeatureStatus @Cassandra . DoAuth) - <@> mkNamedAPI @'("get", AppLockConfig) (getFeatureStatus @Cassandra . DoAuth) - <@> mkNamedAPI @'("put", AppLockConfig) (setFeatureStatus @Cassandra . DoAuth) - <@> mkNamedAPI @'("get", FileSharingConfig) (getFeatureStatus @Cassandra . DoAuth) - <@> mkNamedAPI @'("put", FileSharingConfig) (setFeatureStatus @Cassandra . DoAuth) - <@> mkNamedAPI @'("get", ClassifiedDomainsConfig) (getFeatureStatus @Cassandra . DoAuth) - <@> mkNamedAPI @'("get", ConferenceCallingConfig) (getFeatureStatus @Cassandra . DoAuth) - <@> mkNamedAPI @'("get", SelfDeletingMessagesConfig) (getFeatureStatus @Cassandra . DoAuth) - <@> mkNamedAPI @'("put", SelfDeletingMessagesConfig) (setFeatureStatus @Cassandra . DoAuth) - <@> mkNamedAPI @'("get", GuestLinksConfig) (getFeatureStatus @Cassandra . DoAuth) - <@> mkNamedAPI @'("put", GuestLinksConfig) (setFeatureStatus @Cassandra . DoAuth) - <@> mkNamedAPI @'("get", SndFactorPasswordChallengeConfig) (getFeatureStatus @Cassandra . DoAuth) - <@> mkNamedAPI @'("put", SndFactorPasswordChallengeConfig) (setFeatureStatus @Cassandra . DoAuth) - <@> mkNamedAPI @'("get", MLSConfig) (getFeatureStatus @Cassandra . DoAuth) - <@> mkNamedAPI @'("put", MLSConfig) (setFeatureStatus @Cassandra . DoAuth) - <@> mkNamedAPI @'("get", ExposeInvitationURLsToTeamAdminConfig) (getFeatureStatus @Cassandra . DoAuth) - <@> mkNamedAPI @'("put", ExposeInvitationURLsToTeamAdminConfig) (setFeatureStatus @Cassandra . DoAuth) - <@> mkNamedAPI @'("get", SearchVisibilityInboundConfig) (getFeatureStatus @Cassandra . DoAuth) - <@> mkNamedAPI @'("put", SearchVisibilityInboundConfig) (setFeatureStatus @Cassandra . DoAuth) - <@> mkNamedAPI @"get-all-feature-configs-for-user" (getAllFeatureConfigsForUser @Cassandra) - <@> mkNamedAPI @"get-all-feature-configs-for-team" (getAllFeatureConfigsForTeam @Cassandra) - <@> mkNamedAPI @'("get-config", LegalholdConfig) (getFeatureStatusForUser @Cassandra) - <@> mkNamedAPI @'("get-config", SSOConfig) (getFeatureStatusForUser @Cassandra) - <@> mkNamedAPI @'("get-config", SearchVisibilityAvailableConfig) (getFeatureStatusForUser @Cassandra) - <@> mkNamedAPI @'("get-config", ValidateSAMLEmailsConfig) (getFeatureStatusForUser @Cassandra) - <@> mkNamedAPI @'("get-config", DigitalSignaturesConfig) (getFeatureStatusForUser @Cassandra) - <@> mkNamedAPI @'("get-config", AppLockConfig) (getFeatureStatusForUser @Cassandra) - <@> mkNamedAPI @'("get-config", FileSharingConfig) (getFeatureStatusForUser @Cassandra) - <@> mkNamedAPI @'("get-config", ClassifiedDomainsConfig) (getFeatureStatusForUser @Cassandra) - <@> mkNamedAPI @'("get-config", ConferenceCallingConfig) (getFeatureStatusForUser @Cassandra) - <@> mkNamedAPI @'("get-config", SelfDeletingMessagesConfig) (getFeatureStatusForUser @Cassandra) - <@> mkNamedAPI @'("get-config", GuestLinksConfig) (getFeatureStatusForUser @Cassandra) - <@> mkNamedAPI @'("get-config", SndFactorPasswordChallengeConfig) (getFeatureStatusForUser @Cassandra) - <@> mkNamedAPI @'("get-config", MLSConfig) (getFeatureStatusForUser @Cassandra) - - mls :: API MLSAPI GalleyEffects - mls = - mkNamedAPI @"mls-welcome-message" postMLSWelcomeFromLocalUser - <@> mkNamedAPI @"mls-message-v1" postMLSMessageFromLocalUserV1 - <@> mkNamedAPI @"mls-message" postMLSMessageFromLocalUser - <@> mkNamedAPI @"mls-commit-bundle" postMLSCommitBundleFromLocalUser - <@> mkNamedAPI @"mls-public-keys" getMLSPublicKeys - - customBackend :: API CustomBackendAPI GalleyEffects - customBackend = mkNamedAPI @"get-custom-backend-by-domain" getCustomBackendByDomain - - legalHold :: API LegalHoldAPI GalleyEffects - legalHold = - mkNamedAPI @"create-legal-hold-settings" (createSettings @Cassandra) - <@> mkNamedAPI @"get-legal-hold-settings" (getSettings @Cassandra) - <@> mkNamedAPI @"delete-legal-hold-settings" (removeSettingsInternalPaging @Cassandra) - <@> mkNamedAPI @"get-legal-hold" getUserStatus - <@> mkNamedAPI @"consent-to-legal-hold" grantConsent - <@> mkNamedAPI @"request-legal-hold-device" (requestDevice @Cassandra) - <@> mkNamedAPI @"disable-legal-hold-for-user" disableForUser - <@> mkNamedAPI @"approve-legal-hold-device" (approveDevice @Cassandra) - - teamMember :: API TeamMemberAPI GalleyEffects - teamMember = - mkNamedAPI @"get-team-members" getTeamMembers - <@> mkNamedAPI @"get-team-member" getTeamMember - <@> mkNamedAPI @"get-team-members-by-ids" bulkGetTeamMembers - <@> mkNamedAPI @"add-team-member" (addTeamMember @Cassandra) - <@> mkNamedAPI @"delete-team-member" deleteTeamMember - <@> mkNamedAPI @"delete-non-binding-team-member" deleteNonBindingTeamMember - <@> mkNamedAPI @"update-team-member" updateTeamMember - <@> mkNamedAPI @"get-team-members-csv" getTeamMembersCSV + conversationAPI + <@> teamConversationAPI + <@> messagingAPI + <@> botAPI + <@> teamAPI + <@> featureAPI + <@> mlsAPI + <@> customBackendAPI + <@> legalHoldAPI + <@> teamMemberAPI diff --git a/services/galley/src/Galley/API/Public/Team.hs b/services/galley/src/Galley/API/Public/Team.hs new file mode 100644 index 00000000000..9cea78cea89 --- /dev/null +++ b/services/galley/src/Galley/API/Public/Team.hs @@ -0,0 +1,31 @@ +-- 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 Galley.API.Public.Team where + +import Galley.API.Teams +import Galley.App +import Wire.API.Routes.API +import Wire.API.Routes.Public.Galley.Team + +teamAPI :: API TeamAPI GalleyEffects +teamAPI = + mkNamedAPI @"create-non-binding-team" createNonBindingTeamH + <@> mkNamedAPI @"update-team" updateTeamH + <@> mkNamedAPI @"get-teams" getManyTeams + <@> mkNamedAPI @"get-team" getTeamH + <@> mkNamedAPI @"delete-team" deleteTeam diff --git a/services/galley/src/Galley/API/Public/TeamConversation.hs b/services/galley/src/Galley/API/Public/TeamConversation.hs new file mode 100644 index 00000000000..359c69f1db2 --- /dev/null +++ b/services/galley/src/Galley/API/Public/TeamConversation.hs @@ -0,0 +1,30 @@ +-- 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 Galley.API.Public.TeamConversation where + +import Galley.API.Teams +import Galley.App +import Wire.API.Routes.API +import Wire.API.Routes.Public.Galley.TeamConversation + +teamConversationAPI :: API TeamConversationAPI GalleyEffects +teamConversationAPI = + mkNamedAPI @"get-team-conversation-roles" getTeamConversationRoles + <@> mkNamedAPI @"get-team-conversations" getTeamConversations + <@> mkNamedAPI @"get-team-conversation" getTeamConversation + <@> mkNamedAPI @"delete-team-conversation" deleteTeamConversation diff --git a/services/galley/src/Galley/API/Public/TeamMember.hs b/services/galley/src/Galley/API/Public/TeamMember.hs new file mode 100644 index 00000000000..af7e761c663 --- /dev/null +++ b/services/galley/src/Galley/API/Public/TeamMember.hs @@ -0,0 +1,35 @@ +-- 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 Galley.API.Public.TeamMember where + +import Galley.API.Teams +import Galley.App +import Galley.Cassandra.TeamFeatures +import Wire.API.Routes.API +import Wire.API.Routes.Public.Galley.TeamMember + +teamMemberAPI :: API TeamMemberAPI GalleyEffects +teamMemberAPI = + mkNamedAPI @"get-team-members" getTeamMembers + <@> mkNamedAPI @"get-team-member" getTeamMember + <@> mkNamedAPI @"get-team-members-by-ids" bulkGetTeamMembers + <@> mkNamedAPI @"add-team-member" (addTeamMember @Cassandra) + <@> mkNamedAPI @"delete-team-member" deleteTeamMember + <@> mkNamedAPI @"delete-non-binding-team-member" deleteNonBindingTeamMember + <@> mkNamedAPI @"update-team-member" updateTeamMember + <@> mkNamedAPI @"get-team-members-csv" getTeamMembersCSV diff --git a/services/galley/src/Galley/API/Teams.hs b/services/galley/src/Galley/API/Teams.hs index 32caec47d13..7e79d382132 100644 --- a/services/galley/src/Galley/API/Teams.hs +++ b/services/galley/src/Galley/API/Teams.hs @@ -135,14 +135,14 @@ import Wire.API.Federation.Error import qualified Wire.API.Message as Conv import qualified Wire.API.Notification as Public import Wire.API.Routes.MultiTablePaging (MultiTablePage (MultiTablePage), MultiTablePagingState (mtpsState)) -import Wire.API.Routes.Public.Galley +import Wire.API.Routes.Public.Galley.TeamMember import Wire.API.Team import qualified Wire.API.Team as Public import Wire.API.Team.Conversation import qualified Wire.API.Team.Conversation as Public import Wire.API.Team.Export (TeamExportUser (..)) import Wire.API.Team.Feature -import Wire.API.Team.Member (HardTruncationLimit, ListType (ListComplete, ListTruncated), NewTeamMember, TeamMember, TeamMemberList, TeamMemberListOptPerms, TeamMemberOptPerms, TeamMembersPage (..), TeamMembersPagingState, hardTruncationLimit, invitation, nPermissions, nUserId, newTeamMemberList, ntmNewTeamMember, permissions, setOptionalPerms, setOptionalPermsMany, teamMemberListType, teamMemberPagingState, teamMembers, tmdAuthPassword, userId) +import Wire.API.Team.Member import qualified Wire.API.Team.Member as Public import Wire.API.Team.Permission (Perm (..), Permissions (..), SPerm (..), copy, fullPermissions, self) import Wire.API.Team.Role diff --git a/services/galley/src/Galley/API/Update.hs b/services/galley/src/Galley/API/Update.hs index 0ee2281513a..91a0c14b373 100644 --- a/services/galley/src/Galley/API/Update.hs +++ b/services/galley/src/Galley/API/Update.hs @@ -128,7 +128,7 @@ import Wire.API.Federation.API.Galley import Wire.API.Federation.Error import Wire.API.Message import Wire.API.Provider.Service (ServiceRef) -import Wire.API.Routes.Public.Galley +import Wire.API.Routes.Public.Galley.Messaging import Wire.API.Routes.Public.Util (UpdateResult (..)) import Wire.API.ServantProto (RawProto (..)) import Wire.API.Team.Feature hiding (setStatus) diff --git a/services/galley/src/Galley/API/Util.hs b/services/galley/src/Galley/API/Util.hs index c35b4f8a481..29d03b81516 100644 --- a/services/galley/src/Galley/API/Util.hs +++ b/services/galley/src/Galley/API/Util.hs @@ -76,7 +76,7 @@ import Wire.API.Event.Conversation import Wire.API.Federation.API import Wire.API.Federation.API.Galley import Wire.API.Federation.Error -import Wire.API.Routes.Public.Galley +import Wire.API.Routes.Public.Galley.Conversation import Wire.API.Routes.Public.Util import Wire.API.Team.Member import Wire.API.Team.Role From 2fd21d72c981bda4ef1c7f6a7c410a00a5838387 Mon Sep 17 00:00:00 2001 From: jschaul Date: Tue, 8 Nov 2022 14:22:58 +0100 Subject: [PATCH 14/76] docker images: Add debug utilities (#2829) * Add debugtools to wire-server images * changelog * convenience makefile target for local image building --- Makefile | 10 ++++++++++ changelog.d/5-internal/debugging-tools | 1 + nix/wire-server.nix | 18 +++++++++++++++--- 3 files changed, 26 insertions(+), 3 deletions(-) create mode 100644 changelog.d/5-internal/debugging-tools diff --git a/Makefile b/Makefile index 21f41da7dbc..140ea427053 100644 --- a/Makefile +++ b/Makefile @@ -178,6 +178,16 @@ shellcheck: ################################# ## docker targets +.PHONY: build-image-% +build-image-%: + nix-build ./nix -A wireServer.imagesNoDocs.$(*) && \ + ./result | docker load | tee /tmp/imageName-$(*) && \ + imageName=$$(grep quay.io /tmp/imageName-$(*) | awk '{print $$3}') && \ + echo 'You can run your image locally using' && \ + echo " docker run -it --entrypoint bash $$imageName" && \ + echo 'or upload it using' && \ + echo " docker push $$imageName" + .PHONY: upload-images upload-images: ./hack/bin/upload-images.sh imagesNoDocs diff --git a/changelog.d/5-internal/debugging-tools b/changelog.d/5-internal/debugging-tools new file mode 100644 index 00000000000..ffffed013ed --- /dev/null +++ b/changelog.d/5-internal/debugging-tools @@ -0,0 +1 @@ +Nix-created docker images: add some debugging tools in the containers, and add 'make build-image-' for convenience diff --git a/nix/wire-server.nix b/nix/wire-server.nix index 03005e5bc02..0f36d942b15 100644 --- a/nix/wire-server.nix +++ b/nix/wire-server.nix @@ -194,6 +194,20 @@ let lib = pkgs.lib; galley-integration= [pkgs.mls-test-cli]; }; + # useful to poke around a container during a 'kubectl exec' + debugUtils = with pkgs; [ + bashInteractive + gnugrep + coreutils + dig + curl + less + gnutar + gzip + openssl + which + ]; + images = localMods@{enableOptimization, enableDocs, enableTests}: attrsets.mapAttrs (execName: drv: pkgs.dockerTools.streamLayeredImage { @@ -202,12 +216,10 @@ let lib = pkgs.lib; contents = [ pkgs.cacert pkgs.iana-etc - pkgs.coreutils - pkgs.bashInteractive pkgs.dumb-init drv tmpDir - ] ++ pkgs.lib.optionals (builtins.hasAttr execName extraContents) (builtins.getAttr execName extraContents); + ] ++ debugUtils ++ pkgs.lib.optionals (builtins.hasAttr execName extraContents) (builtins.getAttr execName extraContents); # Any mkdir running in this step won't actually make it to the image, # hence we use the tmpDir derivation in the contents fakeRootCommands = '' From 921505e1836c9f787032f1bcb0d5b5a156bd29e6 Mon Sep 17 00:00:00 2001 From: Stefan Matting Date: Tue, 8 Nov 2022 14:32:47 +0100 Subject: [PATCH 15/76] Remove incorrect changelog entry (#2834) --- CHANGELOG.md | 2 -- 1 file changed, 2 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index f0b045c0004..c0f2c51a024 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -63,8 +63,6 @@ * Convert brig's auth endpoints to servant (#2750) -* bump nginx-module-vts from v0.1.15 to v0.2.1 (#2793) - * Remove deprecated table for storing scim external_ids. Data has been migrated away in [release 2021-03-21 (Chart Release 2.103.0)](https://github.com/wireapp/wire-server/releases/tag/v2021-03-21) (see `/services/spar/migrate-data/src/Spar/DataMigration/V1_ExternalIds.hs`); last time it has been touched in production is before upgrade to [release 2021-03-23 (Chart Release 2.104.0)](https://github.com/wireapp/wire-server/releases/tag/v2021-03-23). (#2768) From de6ebb642607371cba68d5a362baff2a1a2830ee Mon Sep 17 00:00:00 2001 From: jschaul Date: Tue, 8 Nov 2022 16:32:27 +0100 Subject: [PATCH 16/76] Build nginz and nginz_disco docker images using nix, too (#2796) MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * WIP * make inputs explicit * fixup for paths * use alpine base image * Support from flokli to fix issues * formatting * add nixified nginz-disco image * attempt to add to default.nix * nginx: [warn] could not build optimal variables_hash, you should increase either variables_hash_max_size: 1024 or variables_hash_bucket_size: 64; ignoring variables_hash_bucket_size * PR feedback: openssl 1.1 * changelog * also upload nginz and nginz-disco images * PR feedback * nix/nginz.nix: add nginz to contents cannon has a preStop lifecycle hook that currently invokes nginx -c … quit on stop. * nginz container: drop exposed ports All config is defined in the helm chart, just by building the container we don't know which ports are exposed. * services/nginz: drop Dockerfile, README and Makefile We use Nix to build this now. * Hi CI * remove no-longer-necessary openssl1.1 override Co-authored-by: Florian Klink --- changelog.d/5-internal/nginz-nix | 1 + charts/nginz/templates/conf/_nginx.conf.tpl | 2 + hack/bin/upload-image.sh | 8 +- hack/bin/upload-images.sh | 14 +- nix/default.nix | 21 +-- nix/nginz-disco.nix | 42 ++++++ nix/nginz.nix | 80 ++++++++++ nix/overlay.nix | 9 +- services/nginz/Dockerfile | 154 -------------------- services/nginz/Makefile | 133 ----------------- services/nginz/README.md | 76 ---------- 11 files changed, 155 insertions(+), 385 deletions(-) create mode 100644 changelog.d/5-internal/nginz-nix create mode 100644 nix/nginz-disco.nix create mode 100644 nix/nginz.nix delete mode 100644 services/nginz/Dockerfile delete mode 100644 services/nginz/Makefile delete mode 100644 services/nginz/README.md diff --git a/changelog.d/5-internal/nginz-nix b/changelog.d/5-internal/nginz-nix new file mode 100644 index 00000000000..4ff00f8ac4a --- /dev/null +++ b/changelog.d/5-internal/nginz-nix @@ -0,0 +1 @@ +Build nginz and nginz_disco docker images using nix diff --git a/charts/nginz/templates/conf/_nginx.conf.tpl b/charts/nginz/templates/conf/_nginx.conf.tpl index 7b28c77493c..29f8e28e8fd 100644 --- a/charts/nginz/templates/conf/_nginx.conf.tpl +++ b/charts/nginz/templates/conf/_nginx.conf.tpl @@ -37,6 +37,8 @@ http { types_hash_max_size 2048; map_hash_bucket_size 128; + variables_hash_bucket_size 256; + server_names_hash_bucket_size 64; server_name_in_redirect off; diff --git a/hack/bin/upload-image.sh b/hack/bin/upload-image.sh index 9540158d342..d0f7abbdfdd 100755 --- a/hack/bin/upload-image.sh +++ b/hack/bin/upload-image.sh @@ -17,8 +17,8 @@ readonly DOCKER_TAG=${DOCKER_TAG:?"Please set the DOCKER_TAG env variable"} readonly usage="USAGE: $0 " readonly IMAGE_ATTR=${1:?$usage} -SCRIPT_DIR=$(cd -- "$(dirname -- "${BASH_SOURCE[0]}" )" &> /dev/null && pwd ) -ROOT_DIR=$(cd -- "$SCRIPT_DIR/../../" &> /dev/null && pwd) +SCRIPT_DIR=$(cd -- "$(dirname -- "${BASH_SOURCE[0]}")" &>/dev/null && pwd) +ROOT_DIR=$(cd -- "$SCRIPT_DIR/../../" &>/dev/null && pwd) readonly SCRIPT_DIR ROOT_DIR credsArgs="" @@ -38,8 +38,8 @@ tmp_link_store=$(mktemp -d) image_stream_file="$tmp_link_store/image_stream" nix -v --show-trace -L build -f "$ROOT_DIR/nix" "$IMAGE_ATTR" -o "$image_stream_file" image_file="$tmp_link_store/image" -"$image_stream_file" > "$image_file" +"$image_stream_file" >"$image_file" repo=$(skopeo list-tags "docker-archive://$image_file" | jq -r '.Tags[0] | split(":") | .[0]') -printf "*** Uploading $image_file to %s:%s" "$repo" "$DOCKER_TAG" +printf "*** Uploading $image_file to %s:%s\n" "$repo" "$DOCKER_TAG" # shellcheck disable=SC2086 skopeo --insecure-policy copy --retry-times 5 $credsArgs "docker-archive://$image_file" "docker://$repo:$DOCKER_TAG" diff --git a/hack/bin/upload-images.sh b/hack/bin/upload-images.sh index 205a5dfab09..79c0798f2ce 100755 --- a/hack/bin/upload-images.sh +++ b/hack/bin/upload-images.sh @@ -17,8 +17,8 @@ readonly usage="USAGE: $0 " # nix attribute under wireServer from "$ROOT_DIR/nix" containing all the images readonly IMAGES_ATTR=${1:?$usage} -SCRIPT_DIR=$(cd -- "$(dirname -- "${BASH_SOURCE[0]}" )" &> /dev/null && pwd ) -ROOT_DIR=$(cd -- "$SCRIPT_DIR/../../" &> /dev/null && pwd) +SCRIPT_DIR=$(cd -- "$(dirname -- "${BASH_SOURCE[0]}")" &>/dev/null && pwd) +ROOT_DIR=$(cd -- "$SCRIPT_DIR/../../" &>/dev/null && pwd) readonly SCRIPT_DIR ROOT_DIR tmp_link_store=$(mktemp -d) @@ -28,8 +28,12 @@ nix -v --show-trace -L build -f "$ROOT_DIR/nix" wireServer.imagesList -o "$image # Build everything first so we can benefit the most from having many cores. nix -v --show-trace -L build -f "$ROOT_DIR/nix" "wireServer.$IMAGES_ATTR" --no-link -while IFS="" read -r image_name || [ -n "$image_name" ] -do +while IFS="" read -r image_name || [ -n "$image_name" ]; do printf '*** Uploading image %s\n' "$image_name" "$SCRIPT_DIR/upload-image.sh" "wireServer.$IMAGES_ATTR.$image_name" -done < "$image_list_file" +done <"$image_list_file" + +for image_name in nginz nginz-disco; do + printf '*** Uploading image %s\n' "$image_name" + "$SCRIPT_DIR/upload-image.sh" "$image_name" +done diff --git a/nix/default.nix b/nix/default.nix index 11ed4ac483d..34f37250e00 100644 --- a/nix/default.nix +++ b/nix/default.nix @@ -11,16 +11,18 @@ let }; profileEnv = pkgs.writeTextFile { - name = "profile-env"; - destination = "/.profile"; - # This gets sourced by direnv. Set NIX_PATH, so `nix-shell` uses the same nixpkgs as here. - text = '' - export NIX_PATH=nixpkgs=${toString pkgs.path} - export LOCALE_ARCHIVE=${pkgs.glibcLocales}/lib/locale/locale-archive - ''; - }; + name = "profile-env"; + destination = "/.profile"; + # This gets sourced by direnv. Set NIX_PATH, so `nix-shell` uses the same nixpkgs as here. + text = '' + export NIX_PATH=nixpkgs=${toString pkgs.path} + export LOCALE_ARCHIVE=${pkgs.glibcLocales}/lib/locale/locale-archive + ''; + }; wireServer = import ./wire-server.nix pkgs; + nginz = pkgs.callPackage ./nginz.nix { }; + nginz-disco = pkgs.callPackage ./nginz-disco.nix { }; # packages necessary to build wire-server docs docsPkgs = [ @@ -65,4 +67,5 @@ let }; mls-test-cli = pkgs.mls-test-cli; rusty-jwt-tools = pkgs.rusty-jwt-tools; -in {inherit pkgs profileEnv wireServer docs docsEnv mls-test-cli;} +in +{ inherit pkgs profileEnv wireServer docs docsEnv mls-test-cli nginz nginz-disco; } diff --git a/nix/nginz-disco.nix b/nix/nginz-disco.nix new file mode 100644 index 00000000000..be3dabac474 --- /dev/null +++ b/nix/nginz-disco.nix @@ -0,0 +1,42 @@ +{ stdenv +, dockerTools +, gnugrep +, coreutils +, which +, dumb-init +, bashInteractive +, lib +, makeWrapper +, writers +, dig +, gawk +, diffutils +}: +let + nginz-disco = stdenv.mkDerivation { + name = "nginz-disco"; + src = (writers.writeBash "nginz_disco.sh" ../tools/nginz_disco/nginz_disco.sh); + phases = "installPhase"; + nativeBuildInputs = [ makeWrapper ]; + installPhase = '' + mkdir -p $out/bin + cp $src $out/bin/nginz_disco.sh + wrapProgram $out/bin/nginz_disco.sh \ + --prefix PATH : "${lib.makeBinPath [ gnugrep gawk dig diffutils ]}" + ''; + }; + + nginz-disco-image = dockerTools.streamLayeredImage { + name = "quay.io/wire/nginz_disco"; + maxLayers = 10; + contents = [ + bashInteractive + coreutils + which + ]; + config = { + Entrypoint = [ "${dumb-init}/bin/dumb-init" "--" "${nginz-disco}/bin/nginz_disco.sh" ]; + }; + }; +in +nginz-disco-image diff --git a/nix/nginz.nix b/nix/nginz.nix new file mode 100644 index 00000000000..67636b9180e --- /dev/null +++ b/nix/nginz.nix @@ -0,0 +1,80 @@ +{ stdenv +, symlinkJoin +, dockerTools +, writeTextDir +, runCommand +, gnugrep +, coreutils +, which +, inotify-tools +, dumb-init +, cacert +, bashInteractive +, lib +, makeWrapper +, writers +, nginz +}: +let + + nginzWithReloader = stdenv.mkDerivation { + name = "reload-script"; + src = (writers.writeBash "nginz_reload.sh" ../services/nginz/nginz_reload.sh); + phases = "installPhase"; + nativeBuildInputs = [ makeWrapper ]; + installPhase = '' + mkdir -p $out/bin + cp $src $out/bin/nginz_reload.sh + wrapProgram $out/bin/nginz_reload.sh \ + --prefix PATH : "${lib.makeBinPath [ inotify-tools nginz ]}" + ''; + }; + + # copied from nixpkgs fakeNss, but using nginx as username + nginxFakeNss = symlinkJoin { + name = "fake-nss"; + paths = [ + (writeTextDir "etc/passwd" '' + root:x:0:0:root user:/var/empty:/bin/sh + nginx:x:101:101:nginx:/var/empty:/bin/sh + nobody:x:65534:65534:nobody:/var/empty:/bin/sh + '') + (writeTextDir "etc/group" '' + root:x:0: + nginx:x:101: + nobody:x:65534: + '') + (writeTextDir "etc/nsswitch.conf" '' + hosts: files dns + '') + (runCommand "var-empty" { } '' + mkdir -p $out/var/empty + '') + # it seems nginx still tries to log, and doesn't create + # these directories automatically + (runCommand "nginx-misc" { } '' + mkdir -p $out/var/log/nginx + mkdir -p $out/var/cache/nginx + '') + ]; + }; + + nginzImage = dockerTools.streamLayeredImage { + name = "quay.io/wire/nginz"; + maxLayers = 10; + contents = [ + cacert + bashInteractive + gnugrep + which + coreutils + nginxFakeNss + nginz # so preStop lifecycle hook in cannon can nginx -c … quit + ]; + config = { + Entrypoint = [ "${dumb-init}/bin/dumb-init" "--" "${nginzWithReloader}/bin/nginz_reload.sh" "-g" "daemon off;" "-c" "/etc/wire/nginz/conf/nginx.conf" ]; + Env = [ "SSL_CERT_FILE=/etc/ssl/certs/ca-bundle.crt" ]; + }; + }; +in +nginzImage diff --git a/nix/overlay.nix b/nix/overlay.nix index 917301f96d3..d63b1214324 100644 --- a/nix/overlay.nix +++ b/nix/overlay.nix @@ -30,10 +30,11 @@ let src = if stdenv.isDarwin then - fetchurl { - url = darwinAmd64Url; - sha256 = darwinAmd64Sha256; - } + fetchurl + { + url = darwinAmd64Url; + sha256 = darwinAmd64Sha256; + } else fetchurl { url = linuxAmd64Url; diff --git a/services/nginz/Dockerfile b/services/nginz/Dockerfile deleted file mode 100644 index e608fe96246..00000000000 --- a/services/nginz/Dockerfile +++ /dev/null @@ -1,154 +0,0 @@ -# Requires docker >= 17.05 (requires support for multi-stage builds) -FROM alpine:3.15 as libzauth-builder - -# Compile libzauth -COPY libs/libzauth /src/libzauth -RUN cd /src/libzauth/libzauth-c \ - && apk add --no-cache make bash cargo libsodium-dev \ - && make install - -# Nginz container -FROM alpine:3.15 - -# Install libzauth -COPY --from=libzauth-builder /usr/local/include/zauth.h /usr/local/include/zauth.h -COPY --from=libzauth-builder /usr/local/lib/libzauth.so /usr/local/lib/libzauth.so -COPY --from=libzauth-builder /usr/local/lib/pkgconfig/libzauth.pc /usr/local/lib/pkgconfig/libzauth.pc - -COPY services/nginz/third_party /src/third_party - -ENV CONFIG --prefix=/etc/nginx \ - --sbin-path=/usr/sbin/nginx \ - --modules-path=/usr/lib/nginx/modules \ - --conf-path=/etc/nginx/nginx.conf \ - --error-log-path=/var/log/nginx/error.log \ - --http-log-path=/var/log/nginx/access.log \ - --pid-path=/var/run/nginx.pid \ - --lock-path=/var/run/nginx.lock \ - --http-client-body-temp-path=/var/cache/nginx/client_temp \ - --http-proxy-temp-path=/var/cache/nginx/proxy_temp \ - --http-fastcgi-temp-path=/var/cache/nginx/fastcgi_temp \ - --http-uwsgi-temp-path=/var/cache/nginx/uwsgi_temp \ - --http-scgi-temp-path=/var/cache/nginx/scgi_temp \ - --user=nginx \ - --group=nginx \ - --with-http_ssl_module \ - --with-http_v2_module \ - --with-http_stub_status_module \ - --with-http_realip_module \ - --with-http_gunzip_module \ - --add-module=/src/third_party/nginx-zauth-module \ - --add-module=/src/third_party/headers-more-nginx-module \ - --add-module=/src/third_party/nginx-module-vts - -################# similar block as upstream ######################################## -# see https://github.com/nginxinc/docker-nginx/blob/master/stable/alpine/Dockerfile -# This uses dockerfile logic from before 1.16 -#################################################################################### - -ENV NGINX_VERSION 1.22.1 - -RUN apk update - -RUN apk add -vv --virtual .build-deps \ - libsodium-dev \ - llvm-libunwind-dev \ - gcc \ - libc-dev \ - make \ - openssl-dev \ - pcre-dev \ - zlib-dev \ - linux-headers \ - curl \ - gnupg1 \ - libxslt-dev \ - gd-dev \ - geoip-dev - -# This line checks whether the 'apk add' succeeded, sometimes it doesn't work. -RUN curl -h - -RUN set -x \ - && addgroup -g 101 -S nginx \ - && adduser -S -D -H -u 101 -h /var/cache/nginx -s /sbin/nologin -G nginx -g nginx nginx \ - && export GPG_KEYS=13C82A63B603576156E30A4EA0EA981B66B0D967 \ - && curl -fSL https://nginx.org/download/nginx-$NGINX_VERSION.tar.gz -o nginx.tar.gz \ - && curl -fSL https://nginx.org/download/nginx-$NGINX_VERSION.tar.gz.asc -o nginx.tar.gz.asc \ - && found=''; \ - for server in \ - ha.pool.sks-keyservers.net \ - hkp://keyserver.ubuntu.com:80 \ - hkp://p80.pool.sks-keyservers.net:80 \ - pgp.mit.edu \ - ; do \ - echo "Fetching GPG key $GPG_KEYS from $server"; \ - gpg --keyserver "$server" --keyserver-options timeout=10 --recv-keys "$GPG_KEYS" && found=yes && break; \ - done; \ - test -z "$found" && echo >&2 "error: failed to fetch GPG key $GPG_KEYS" && exit 1; \ - gpg --batch --verify nginx.tar.gz.asc nginx.tar.gz \ - && rm -rf "$GNUPGHOME" nginx.tar.gz.asc \ - && mkdir -p /usr/src \ - && tar -zxC /usr/src -f nginx.tar.gz \ - && rm nginx.tar.gz \ - && cd /usr/src/nginx-$NGINX_VERSION \ - && ./configure $CONFIG --with-debug \ - && make -j$(getconf _NPROCESSORS_ONLN) \ - && mv objs/nginx objs/nginx-debug \ - && ./configure $CONFIG \ - && make -j$(getconf _NPROCESSORS_ONLN) \ - && make install \ - && rm -rf /etc/nginx/html/ \ - && mkdir /etc/nginx/conf.d/ \ - && mkdir -p /usr/share/nginx/html/ \ - && install -m644 html/index.html /usr/share/nginx/html/ \ - && install -m644 html/50x.html /usr/share/nginx/html/ \ - && install -m755 objs/nginx-debug /usr/sbin/nginx-debug \ - && ln -s ../../usr/lib/nginx/modules /etc/nginx/modules \ - && strip /usr/sbin/nginx* \ - && rm -rf /usr/src/nginx-$NGINX_VERSION \ - \ - # Bring in gettext so we can get `envsubst`, then throw - # the rest away. To do this, we need to install `gettext` - # then move `envsubst` out of the way so `gettext` can - # be deleted completely, then move `envsubst` back. - && apk add --no-cache --virtual .gettext gettext \ - && mv /usr/bin/envsubst /tmp/ \ - \ - && runDepsTmp="$( \ - scanelf --needed --nobanner --format '%n#p' /usr/sbin/nginx /usr/lib/nginx/modules/*.so /tmp/envsubst \ - | tr ',' '\n' \ - | sort -u \ - | awk 'system("[ -e /usr/local/lib/" $1 " ]") == 0 { next } { print "so:" $1 }' \ - )" \ - \ - # exclude libzauth from runDeps - && runDeps=${runDepsTmp/so:libzauth.so/''} \ - && apk add --no-cache --virtual .nginx-rundeps $runDeps \ - && apk del .build-deps \ - && apk del .gettext \ - && mv /tmp/envsubst /usr/local/bin/ \ - \ - # Bring in tzdata so users could set the timezones through the environment - # variables - && apk add --no-cache tzdata \ - \ - # forward request and error logs to docker log collector - && ln -sf /dev/stdout /var/log/nginx/access.log \ - && ln -sf /dev/stderr /var/log/nginx/error.log - -################# wire/nginz specific ###################### - -# Fix file permissions -RUN mkdir -p /var/cache/nginx/client_temp && chown -R nginx:nginx /var/cache/nginx - -RUN apk add --no-cache inotify-tools dumb-init bash curl && \ - # add libzauth runtime dependencies back in - apk add --no-cache libsodium llvm-libunwind libgcc && \ - # add openssl runtime dependencies for TLS/SSL certificate support - apk add --no-cache openssl - -COPY services/nginz/nginz_reload.sh /usr/bin/nginz_reload.sh - -ENTRYPOINT ["/usr/bin/dumb-init", "--"] -CMD ["/usr/bin/nginz_reload.sh", "-g", "daemon off;", "-c", "/etc/wire/nginz/conf/nginx.conf"] diff --git a/services/nginz/Makefile b/services/nginz/Makefile deleted file mode 100644 index 1803bdb8a66..00000000000 --- a/services/nginz/Makefile +++ /dev/null @@ -1,133 +0,0 @@ -LANG := en_US.UTF-8 -SHELL := /usr/bin/env bash -NAME := nginz -NGINX_VERSION = 1.22.1 -NGINZ_VERSION ?= -SWAGGER_VERSION:= 2.2.10 -SHELL := /usr/bin/env bash -DIST := build -BIN := src/objs/nginx -ifeq ($(DEBUG), 1) -WITH_DEBUG = --with-debug -endif -DOCKER_REGISTRY ?= quay.io -DOCKER_USER ?= quay.io/wire -DOCKER_TAG ?= local - -DEST_PATH ?= /opt/nginz -# Use a folder that can be written to since errors during startup do not respect -# your config and will use the `LOG_PATH` defined here -LOG_PATH ?= /var/log/nginz -CONF_PATH ?= /etc/nginz -PID_PATH ?= /var/run - -# You may need to use this if you have some dependencies in non-standard -# locations. For macOS, we use Brew default directories for OpenSSL (if they -# exist). These variables can be always overridden when running the -# Makefile, though. -ifeq ($(wildcard /usr/local/opt/openssl/.),) - EXTRA_CC_INC ?= - EXTRA_CC_LIB ?= -else - EXTRA_CC_INC ?= -I/usr/local/opt/openssl/include - EXTRA_CC_LIB ?= -L/usr/local/opt/openssl/lib -endif - -# Where should we look for packages, locally or globally? -EXTRA_PKG_PATH := $(shell [ -w /usr/local ] && echo /usr/local || echo "$(HOME)/.wire-dev")/lib/pkgconfig - -CONFIG_OPTIONS = \ - --prefix=$(DEST_PATH) \ - $(WITH_DEBUG) \ - --with-cc-opt="-std=gnu99 $(EXTRA_CC_INC)" \ - --with-ld-opt="$(EXTRA_CC_LIB)" \ - --error-log-path=$(LOG_PATH)/error.log \ - --http-log-path=$(LOG_PATH)/access.log \ - --conf-path=$(CONF_PATH)/nginx.conf \ - --pid-path=$(PID_PATH) - -ADDITIONAL_MODULES = \ - --with-http_ssl_module \ - --with-http_v2_module \ - --with-http_stub_status_module \ - --with-http_realip_module \ - --with-http_gunzip_module \ - --add-module=../third_party/nginx-zauth-module \ - --add-module=../third_party/headers-more-nginx-module \ - --add-module=../third_party/nginx-module-vts - -guard-%: - @ if [ "${${*}}" = "" ]; then \ - echo "Environment variable $* not set"; \ - exit 1; \ - fi - -default: compile - -.PHONY: clean -clean: - -rm -rf src $(DIST) .metadata zwagger-ui/swagger-ui - -.PHONY: compile -compile: $(BIN) - mkdir -p ../../dist - cp src/objs/nginx ../../dist/ - -$(BIN): src zwagger-ui/swagger-ui integration-test/conf/nginz/zwagger-ui - PKG_CONFIG_PATH=$(EXTRA_PKG_PATH) pkg-config --exists libzauth || { echo -e "\n\033[0;31m The 'libzauth' library was not found\033[0m\n pkg-config path = $(EXTRA_PKG_PATH)\n\n Attempting to install it...\n" && $(MAKE) libzauth; } - git submodule update --init - (cd src; PKG_CONFIG_PATH=$(EXTRA_PKG_PATH) ./configure $(CONFIG_OPTIONS) $(ADDITIONAL_MODULES)) - make -C src - -$(DIST): - mkdir -p $(DIST) - -# -# Dependencies -# - -NGINX_BUNDLE=nginx-$(NGINX_VERSION).tar.gz -SWAGGER_BUNDLE=swagger-$(SWAGGER_VERSION).tar.gz - -.PHONY: integration-test/conf/nginz/zwagger-ui -integration-test/conf/nginz/zwagger-ui: zwagger-ui/swagger-ui - cp -r "zwagger-ui/." integration-test/conf/nginz/zwagger-ui/ - -.PHONY: zwagger-ui/swagger-ui -zwagger-ui/swagger-ui: $(SWAGGER_BUNDLE) - tar zxf $(SWAGGER_BUNDLE) - rm -rf zwagger-ui/swagger-ui - mv -v swagger-ui-$(SWAGGER_VERSION)/dist zwagger-ui/swagger-ui - touch zwagger-ui/swagger-ui - rm -rf swagger-ui-$(SWAGGER_VERSION) - -$(SWAGGER_BUNDLE): - curl -L https://github.com/swagger-api/swagger-ui/archive/v$(SWAGGER_VERSION).tar.gz -o $(SWAGGER_BUNDLE) - -src: $(NGINX_BUNDLE) - #Find keys on https://nginx.org/en/pgp_keys.html - gpg --verify $(NGINX_BUNDLE).asc $(NGINX_BUNDLE) - tar zxf $(NGINX_BUNDLE) - rm -rf src && mv nginx-$(NGINX_VERSION) src - -$(NGINX_BUNDLE): - curl -O https://nginx.org/download/$(NGINX_BUNDLE).asc - curl -O https://nginx.org/download/$(NGINX_BUNDLE) - -.PHONY: docker -docker: - git submodule update --init - docker build -t $(DOCKER_USER)/nginz:$(DOCKER_TAG) -f Dockerfile ../.. - docker tag $(DOCKER_USER)/nginz:$(DOCKER_TAG) $(DOCKER_USER)/nginz:latest - if test -n "$$DOCKER_PUSH"; then docker login $(DOCKER_REGISTRY); docker push $(DOCKER_USER)/nginz:$(DOCKER_TAG); docker push $(DOCKER_USER)/nginz:latest; fi; - -.PHONY: libzauth -libzauth: - $(MAKE) -C ../../libs/libzauth install - -# a target to start the locally-compiled docker image (tagged 'local') -# using the configuration in wire-server/deploy/services-demo -# can aid when updating nginx versions and configuration -.PHONY: docker-run-demo-local -docker-run-demo: - docker run --network=host -it -v $$(pwd)/../../deploy/services-demo:/configs --entrypoint /usr/sbin/nginx quay.io/wire/nginz:local -p /configs -c /configs/conf/nginz/nginx-docker.conf diff --git a/services/nginz/README.md b/services/nginz/README.md deleted file mode 100644 index fb1832268a4..00000000000 --- a/services/nginz/README.md +++ /dev/null @@ -1,76 +0,0 @@ -# NGINX build with extra modules - -## Compile natively - -To build nginz natively, you will need to have the usual C compiler toolchains installed, along with the following dependencies: - -* gpg (needed to verify nginx's signatures) -* openssl -* libossp-uuid -* libpcre3 -* [libzauth](../../libs/libzauth) - * depends on the rust compiler, libsodium23 - -### Alpine -If you're on alpine, see the [Dockerfile](Dockerfile) for the precise dependency names. - -### Ubuntu / Debian (backports / testing / unstable) - -_Note_: Debian packages are only used as part of wire's infrastructure, and as such, you do not need to install them to run the integration tests or the demo. - -_Note_: Debian stable does not contain a new enough version of libsodium. you must get it from backports, testing, or unstable. - -_Note_: On some Ubuntu versions, upstart is installed in addition to systemd, causing runit to fail with an error like "Unable to connect to Upstart: Failed to connect to socket". Luckily, there is [a simple fix](https://forum.peppermintos.com/index.php?topic=5210.0). - -#### Build Dependencies: -```bash -sudo apt install libossp-uuid-dev libpcre3-dev libsodium23 runit gnupg -``` - -#### Building -```bash -make -``` - -### Compile with docker - -`make docker` - -### Generic -If you're on another platform, the names of the dependencies might differ slightly. - -Once you have all necessary dependencies, `make` in this directory should work. - -## Common problems while compiling - -``` -gpg: Can't check signature: public key not found -``` - -This means that you haven't imported the public key that was used to sign nginx. Look for the keys at https://nginx.org/en/pgp_keys.html and make sure to import ALL of them with: - -`gpg --import ` - -Alternatively, you can ask GPG to find the key by its ID (printed in the error message): - -`gpg --recv-keys KEY_ID` - ---- - -``` -checking for OpenSSL library ... not found -[...] -./configure: error: SSL modules require the OpenSSL library. -You can either do not enable the modules, or install the OpenSSL library -into the system, or build the OpenSSL library statically from the source -with nginx by using --with-openssl= option. -``` - -openssl is required to compile nginx and it may be installed in a "non-standard" path in your system. Once you are sure you have installed it, look for `EXTRA_CC_INC` and `EXTRA_CC_LIB` in the `Makefile` and point them to the correct location in your system. - -If you are using macOS and you used `brew` to install openssl, the `Makefile` already contains the right paths so you should not be seeing that error. - -## How to run it - -Have a look at our demo config in [./integration-test/conf/nginz/](./integration-test/conf/nginz/) - From 3caf802a4fdc450422be122bbf2022645bf2b6ed Mon Sep 17 00:00:00 2001 From: Florian Klink Date: Tue, 8 Nov 2022 10:56:04 +0000 Subject: [PATCH 17/76] nix/wire-server: add nixpkgs-fmt and treefmt to the dev env --- nix/wire-server.nix | 2 ++ 1 file changed, 2 insertions(+) diff --git a/nix/wire-server.nix b/nix/wire-server.nix index 0f36d942b15..6639fddbe9c 100644 --- a/nix/wire-server.nix +++ b/nix/wire-server.nix @@ -285,8 +285,10 @@ let lib = pkgs.lib; pkgs.hlint pkgs.jq pkgs.kubectl + pkgs.nixpkgs-fmt pkgs.ormolu pkgs.shellcheck + pkgs.treefmt (hlib.justStaticExecutables pkgs.haskellPackages.cabal-fmt) ] ++ pkgs.lib.optionals pkgs.stdenv.isLinux [ pkgs.skopeo From 23c50ace8c6992fe280cf99cd3d0c714f6cd854f Mon Sep 17 00:00:00 2001 From: Florian Klink Date: Tue, 8 Nov 2022 10:56:23 +0000 Subject: [PATCH 18/76] treefmt: configure nixpkgs-fmt as a .nix formatter --- treefmt.toml | 5 +++++ 1 file changed, 5 insertions(+) create mode 100644 treefmt.toml diff --git a/treefmt.toml b/treefmt.toml new file mode 100644 index 00000000000..3bca4a2ccf9 --- /dev/null +++ b/treefmt.toml @@ -0,0 +1,5 @@ +[formatter.nix] +command = "nixpkgs-fmt" +includes = ["*.nix"] +excludes = [ +] From 6ab019dab40f4a7b079b6c850de38c01eefe3c91 Mon Sep 17 00:00:00 2001 From: Florian Klink Date: Tue, 8 Nov 2022 11:02:45 +0000 Subject: [PATCH 19/76] hack/bin/generate-local-nix-packages.sh: ensure files are formatted --- hack/bin/generate-local-nix-packages.sh | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/hack/bin/generate-local-nix-packages.sh b/hack/bin/generate-local-nix-packages.sh index 50e6e047f28..abfdfeb9251 100755 --- a/hack/bin/generate-local-nix-packages.sh +++ b/hack/bin/generate-local-nix-packages.sh @@ -21,7 +21,7 @@ echo "$cabalFiles" \ # shellcheck disable=SC2016 echo "$cabalFiles" \ - | xargs -I {} bash -c 'cd $(dirname {}); cabal2nix . --no-hpack --extra-arguments gitignoreSource | sed "s/.\/./gitignoreSource .\/./g" >> default.nix' + | xargs -I {} bash -c 'cd $(dirname {}); cabal2nix . --no-hpack --extra-arguments gitignoreSource | sed "s/.\/./gitignoreSource .\/./g" >> default.nix; nixpkgs-fmt default.nix &> /dev/null' overridesFile="$ROOT_DIR/nix/local-haskell-packages.nix" @@ -30,3 +30,6 @@ cat "$warningFile" <(echo "{ gitignoreSource }: hsuper: hself: {") > "$overrides echo "$cabalFiles" \ | xargs -I {} bash -c 'name=$(basename {} | sed "s|.cabal||"); echo " $name = hself.callPackage $(realpath --relative-to='"$ROOT_DIR/nix"' "$(dirname {})")/default.nix { inherit gitignoreSource; };"' >> "$overridesFile" echo "}" >> "$overridesFile" + +# ensure the file is formatted +nixpkgs-fmt "$overridesFile" &> /dev/null From cc8e75568e4407f32679bd765d712752ed6532fc Mon Sep 17 00:00:00 2001 From: Florian Klink Date: Tue, 8 Nov 2022 11:37:52 +0000 Subject: [PATCH 20/76] libs,services,tools: re-run hack/bin/generate-local-nix-packages.sh Ensure all these files are formatted. --- libs/api-bot/default.nix | 92 +++- libs/api-client/default.nix | 63 ++- libs/bilge/default.nix | 56 ++- libs/brig-types/default.nix | 79 ++- libs/cargohold-types/default.nix | 16 +- libs/cassandra-util/default.nix | 48 +- libs/deriving-swagger2/default.nix | 7 +- libs/dns-util/default.nix | 28 +- libs/extended/default.nix | 74 ++- libs/galley-types/default.nix | 71 ++- libs/gundeck-types/default.nix | 32 +- libs/hscim/default.nix | 187 +++++-- libs/imports/default.nix | 30 +- libs/jwt-tools/default.nix | 52 +- libs/metrics-core/default.nix | 24 +- libs/metrics-wai/default.nix | 58 ++- libs/polysemy-wire-zoo/default.nix | 54 +- libs/ropes/default.nix | 28 +- libs/schema-profunctor/default.nix | 49 +- libs/sodium-crypto-sign/default.nix | 15 +- libs/ssl-util/default.nix | 20 +- libs/tasty-cannon/default.nix | 42 +- libs/types-common-aws/default.nix | 37 +- libs/types-common-journal/default.nix | 24 +- libs/types-common/default.nix | 152 +++++- libs/wai-utilities/default.nix | 71 ++- libs/wire-api-federation/default.nix | 156 +++++- libs/wire-api/default.nix | 287 +++++++++-- libs/wire-message-proto-lens/default.nix | 10 +- libs/zauth/default.nix | 72 ++- services/brig/default.nix | 476 +++++++++++++++--- services/cannon/default.nix | 149 +++++- services/cargohold/default.nix | 196 ++++++-- services/federator/default.nix | 312 ++++++++++-- services/galley/default.nix | 421 +++++++++++++--- services/gundeck/default.nix | 291 +++++++++-- services/proxy/default.nix | 68 ++- services/spar/default.nix | 350 ++++++++++--- tools/api-simulations/default.nix | 69 ++- tools/db/assets/default.nix | 66 ++- tools/db/auto-whitelist/default.nix | 28 +- .../billing-team-member-backfill/default.nix | 30 +- tools/db/find-undead/default.nix | 36 +- tools/db/migrate-sso-feature-flag/default.nix | 32 +- tools/db/move-team/default.nix | 88 +++- tools/db/repair-handles/default.nix | 35 +- tools/db/service-backfill/default.nix | 28 +- tools/rex/default.nix | 46 +- tools/stern/default.nix | 112 ++++- 49 files changed, 3998 insertions(+), 769 deletions(-) diff --git a/libs/api-bot/default.nix b/libs/api-bot/default.nix index 823fad86b12..8116ba9ceb4 100644 --- a/libs/api-bot/default.nix +++ b/libs/api-bot/default.nix @@ -2,27 +2,89 @@ # 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, ansi-terminal, api-client, async, attoparsec -, base, base64-bytestring, bilge, bytestring, bytestring-conversion -, cereal, containers, cryptobox-haskell, cryptonite, exceptions -, filepath, gitignoreSource, HaskellNet, HaskellNet-SSL -, http-client, imports, iso639, lib, memory, metrics-core, mime -, monad-control, mwc-random, optparse-applicative, resource-pool -, stm, text, time, tinylog, transformers-base, types-common -, unordered-containers, uuid, vector +{ mkDerivation +, aeson +, ansi-terminal +, api-client +, async +, attoparsec +, base +, base64-bytestring +, bilge +, bytestring +, bytestring-conversion +, cereal +, containers +, cryptobox-haskell +, cryptonite +, exceptions +, filepath +, gitignoreSource +, HaskellNet +, HaskellNet-SSL +, http-client +, imports +, iso639 +, lib +, memory +, metrics-core +, mime +, monad-control +, mwc-random +, optparse-applicative +, resource-pool +, stm +, text +, time +, tinylog +, transformers-base +, types-common +, unordered-containers +, uuid +, vector }: mkDerivation { pname = "api-bot"; version = "0.4.2"; src = gitignoreSource ./.; libraryHaskellDepends = [ - aeson ansi-terminal api-client async attoparsec base - base64-bytestring bilge bytestring bytestring-conversion cereal - containers cryptobox-haskell cryptonite exceptions filepath - HaskellNet HaskellNet-SSL http-client imports iso639 memory - metrics-core mime monad-control mwc-random optparse-applicative - resource-pool stm text time tinylog transformers-base types-common - unordered-containers uuid vector + aeson + ansi-terminal + api-client + async + attoparsec + base + base64-bytestring + bilge + bytestring + bytestring-conversion + cereal + containers + cryptobox-haskell + cryptonite + exceptions + filepath + HaskellNet + HaskellNet-SSL + http-client + imports + iso639 + memory + metrics-core + mime + monad-control + mwc-random + optparse-applicative + resource-pool + stm + text + time + tinylog + transformers-base + types-common + unordered-containers + uuid + vector ]; description = "(Internal) API automation around wire-client"; license = lib.licenses.agpl3Only; diff --git a/libs/api-client/default.nix b/libs/api-client/default.nix index 52b3c069cdc..bbf842e4f83 100644 --- a/libs/api-client/default.nix +++ b/libs/api-client/default.nix @@ -2,11 +2,34 @@ # 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, async, base, bilge, bytestring -, bytestring-conversion, connection, cookie, data-default-class -, errors, exceptions, gitignoreSource, http-client, http-types -, imports, lib, mime, retry, text, time, tinylog, transformers -, types-common, unliftio, unordered-containers, uuid, websockets +{ mkDerivation +, aeson +, async +, base +, bilge +, bytestring +, bytestring-conversion +, connection +, cookie +, data-default-class +, errors +, exceptions +, gitignoreSource +, http-client +, http-types +, imports +, lib +, mime +, retry +, text +, time +, tinylog +, transformers +, types-common +, unliftio +, unordered-containers +, uuid +, websockets , wire-api }: mkDerivation { @@ -14,10 +37,32 @@ mkDerivation { version = "0.4.2"; src = gitignoreSource ./.; libraryHaskellDepends = [ - aeson async base bilge bytestring bytestring-conversion connection - cookie data-default-class errors exceptions http-client http-types - imports mime retry text time tinylog transformers types-common - unliftio unordered-containers uuid websockets wire-api + aeson + async + base + bilge + bytestring + bytestring-conversion + connection + cookie + data-default-class + errors + exceptions + http-client + http-types + imports + mime + retry + text + time + tinylog + transformers + types-common + unliftio + unordered-containers + uuid + websockets + wire-api ]; description = "(Internal) Wire HTTP API Client"; license = lib.licenses.agpl3Only; diff --git a/libs/bilge/default.nix b/libs/bilge/default.nix index 07dba5db2f9..6a32b06d68e 100644 --- a/libs/bilge/default.nix +++ b/libs/bilge/default.nix @@ -2,21 +2,59 @@ # 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, ansi-terminal, base, bytestring -, case-insensitive, cookie, errors, exceptions, gitignoreSource -, http-client, http-types, imports, lens, lib, monad-control, mtl -, text, tinylog, transformers-base, types-common, unliftio -, uri-bytestring, wai, wai-extra +{ mkDerivation +, aeson +, ansi-terminal +, base +, bytestring +, case-insensitive +, cookie +, errors +, exceptions +, gitignoreSource +, http-client +, http-types +, imports +, lens +, lib +, monad-control +, mtl +, text +, tinylog +, transformers-base +, types-common +, unliftio +, uri-bytestring +, wai +, wai-extra }: mkDerivation { pname = "bilge"; version = "0.22.0"; src = gitignoreSource ./.; libraryHaskellDepends = [ - aeson ansi-terminal base bytestring case-insensitive cookie errors - exceptions http-client http-types imports lens monad-control mtl - text tinylog transformers-base types-common unliftio uri-bytestring - wai wai-extra + aeson + ansi-terminal + base + bytestring + case-insensitive + cookie + errors + exceptions + http-client + http-types + imports + lens + monad-control + mtl + text + tinylog + transformers-base + types-common + unliftio + uri-bytestring + wai + wai-extra ]; description = "Library for composing HTTP requests"; license = lib.licenses.agpl3Only; diff --git a/libs/brig-types/default.nix b/libs/brig-types/default.nix index 46a87df55a5..ba0b67dcec9 100644 --- a/libs/brig-types/default.nix +++ b/libs/brig-types/default.nix @@ -2,29 +2,80 @@ # 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, attoparsec, base, bytestring -, bytestring-conversion, cassandra-util, containers -, deriving-swagger2, gitignoreSource, imports, lib, QuickCheck -, schema-profunctor, servant-server, servant-swagger -, string-conversions, swagger2, tasty, tasty-hunit -, tasty-quickcheck, text, time, tinylog, types-common -, unordered-containers, wire-api +{ mkDerivation +, aeson +, attoparsec +, base +, bytestring +, bytestring-conversion +, cassandra-util +, containers +, deriving-swagger2 +, gitignoreSource +, imports +, lib +, QuickCheck +, schema-profunctor +, servant-server +, servant-swagger +, string-conversions +, swagger2 +, tasty +, tasty-hunit +, tasty-quickcheck +, text +, time +, tinylog +, types-common +, unordered-containers +, wire-api }: mkDerivation { pname = "brig-types"; version = "1.35.0"; src = gitignoreSource ./.; libraryHaskellDepends = [ - aeson attoparsec base bytestring bytestring-conversion - cassandra-util containers deriving-swagger2 imports QuickCheck - schema-profunctor servant-server servant-swagger string-conversions - swagger2 text time tinylog types-common unordered-containers + aeson + attoparsec + base + bytestring + bytestring-conversion + cassandra-util + containers + deriving-swagger2 + imports + QuickCheck + schema-profunctor + servant-server + servant-swagger + string-conversions + swagger2 + text + time + tinylog + types-common + unordered-containers wire-api ]; testHaskellDepends = [ - aeson attoparsec base bytestring bytestring-conversion containers - imports QuickCheck swagger2 tasty tasty-hunit tasty-quickcheck text - time tinylog types-common unordered-containers wire-api + aeson + attoparsec + base + bytestring + bytestring-conversion + containers + imports + QuickCheck + swagger2 + tasty + tasty-hunit + tasty-quickcheck + text + time + tinylog + types-common + unordered-containers + wire-api ]; description = "User Service"; license = lib.licenses.agpl3Only; diff --git a/libs/cargohold-types/default.nix b/libs/cargohold-types/default.nix index 523e4eab3a1..6415170a566 100644 --- a/libs/cargohold-types/default.nix +++ b/libs/cargohold-types/default.nix @@ -2,15 +2,25 @@ # 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, base, bytestring-conversion, gitignoreSource -, imports, lib, types-common, wire-api +{ mkDerivation +, base +, bytestring-conversion +, gitignoreSource +, imports +, lib +, types-common +, wire-api }: mkDerivation { pname = "cargohold-types"; version = "1.5.0"; src = gitignoreSource ./.; libraryHaskellDepends = [ - base bytestring-conversion imports types-common wire-api + base + bytestring-conversion + imports + types-common + wire-api ]; description = "Asset Storage API Types"; license = lib.licenses.agpl3Only; diff --git a/libs/cassandra-util/default.nix b/libs/cassandra-util/default.nix index fdc62d62b53..9f57e34427f 100644 --- a/libs/cassandra-util/default.nix +++ b/libs/cassandra-util/default.nix @@ -2,19 +2,53 @@ # 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, conduit, containers, cql, cql-io -, cql-io-tinylog, exceptions, gitignoreSource, imports, lens -, lens-aeson, lib, optparse-applicative, retry, split, text, time -, tinylog, uuid, wreq +{ mkDerivation +, aeson +, base +, conduit +, containers +, cql +, cql-io +, cql-io-tinylog +, exceptions +, gitignoreSource +, imports +, lens +, lens-aeson +, lib +, optparse-applicative +, retry +, split +, text +, time +, tinylog +, uuid +, wreq }: mkDerivation { pname = "cassandra-util"; version = "0.16.5"; src = gitignoreSource ./.; libraryHaskellDepends = [ - aeson base conduit containers cql cql-io cql-io-tinylog exceptions - imports lens lens-aeson optparse-applicative retry split text time - tinylog uuid wreq + aeson + base + conduit + containers + cql + cql-io + cql-io-tinylog + exceptions + imports + lens + lens-aeson + optparse-applicative + retry + split + text + time + tinylog + uuid + wreq ]; description = "Cassandra Utilities"; license = lib.licenses.agpl3Only; diff --git a/libs/deriving-swagger2/default.nix b/libs/deriving-swagger2/default.nix index b11f6619f0d..fdf39de254a 100644 --- a/libs/deriving-swagger2/default.nix +++ b/libs/deriving-swagger2/default.nix @@ -2,7 +2,12 @@ # 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, base, extra, gitignoreSource, imports, lib +{ mkDerivation +, base +, extra +, gitignoreSource +, imports +, lib , swagger2 }: mkDerivation { diff --git a/libs/dns-util/default.nix b/libs/dns-util/default.nix index 1da76aea207..509dedafdc3 100644 --- a/libs/dns-util/default.nix +++ b/libs/dns-util/default.nix @@ -2,18 +2,38 @@ # 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, base, dns, gitignoreSource, hspec, hspec-discover -, imports, iproute, lib, polysemy, random +{ mkDerivation +, base +, dns +, gitignoreSource +, hspec +, hspec-discover +, imports +, iproute +, lib +, polysemy +, random }: mkDerivation { pname = "dns-util"; version = "0.1.0"; src = gitignoreSource ./.; libraryHaskellDepends = [ - base dns imports iproute polysemy random + base + dns + imports + iproute + polysemy + random ]; testHaskellDepends = [ - base dns hspec imports iproute polysemy random + base + dns + hspec + imports + iproute + polysemy + random ]; testToolDepends = [ hspec-discover ]; description = "Library to deal with DNS SRV records"; diff --git a/libs/extended/default.nix b/libs/extended/default.nix index 0f193232ce6..d51ab0466c5 100644 --- a/libs/extended/default.nix +++ b/libs/extended/default.nix @@ -2,26 +2,76 @@ # 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, cassandra-util, containers -, errors, exceptions, extra, gitignoreSource, hspec, hspec-discover -, http-types, imports, lib, metrics-wai, optparse-applicative -, servant, servant-server, servant-swagger, string-conversions -, temporary, tinylog, wai +{ mkDerivation +, aeson +, base +, bytestring +, cassandra-util +, containers +, errors +, exceptions +, extra +, gitignoreSource +, hspec +, hspec-discover +, http-types +, imports +, lib +, metrics-wai +, optparse-applicative +, servant +, servant-server +, servant-swagger +, string-conversions +, temporary +, tinylog +, wai }: mkDerivation { pname = "extended"; version = "0.1.0"; src = gitignoreSource ./.; libraryHaskellDepends = [ - aeson base bytestring cassandra-util containers errors exceptions - extra http-types imports metrics-wai optparse-applicative servant - servant-server servant-swagger string-conversions tinylog wai + aeson + base + bytestring + cassandra-util + containers + errors + exceptions + extra + http-types + imports + metrics-wai + optparse-applicative + servant + servant-server + servant-swagger + string-conversions + tinylog + wai ]; testHaskellDepends = [ - aeson base bytestring cassandra-util containers errors exceptions - extra hspec http-types imports metrics-wai optparse-applicative - servant servant-server servant-swagger string-conversions temporary - tinylog wai + aeson + base + bytestring + cassandra-util + containers + errors + exceptions + extra + hspec + http-types + imports + metrics-wai + optparse-applicative + servant + servant-server + servant-swagger + string-conversions + temporary + tinylog + wai ]; testToolDepends = [ hspec-discover ]; description = "Extended versions of common modules"; diff --git a/libs/galley-types/default.nix b/libs/galley-types/default.nix index 9c499e44404..478a0c540e9 100644 --- a/libs/galley-types/default.nix +++ b/libs/galley-types/default.nix @@ -2,11 +2,33 @@ # 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, bytestring-conversion -, containers, cryptonite, currency-codes, errors, exceptions -, gitignoreSource, imports, lens, lib, memory, QuickCheck -, schema-profunctor, string-conversions, swagger2, tagged, tasty -, tasty-hunit, tasty-quickcheck, text, time, types-common, uuid +{ mkDerivation +, aeson +, base +, bytestring +, bytestring-conversion +, containers +, cryptonite +, currency-codes +, errors +, exceptions +, gitignoreSource +, imports +, lens +, lib +, memory +, QuickCheck +, schema-profunctor +, string-conversions +, swagger2 +, tagged +, tasty +, tasty-hunit +, tasty-quickcheck +, text +, time +, types-common +, uuid , wire-api }: mkDerivation { @@ -14,14 +36,41 @@ mkDerivation { version = "0.81.0"; src = gitignoreSource ./.; libraryHaskellDepends = [ - aeson base bytestring bytestring-conversion containers cryptonite - currency-codes errors exceptions imports lens memory QuickCheck - schema-profunctor string-conversions swagger2 tagged text time - types-common uuid wire-api + aeson + base + bytestring + bytestring-conversion + containers + cryptonite + currency-codes + errors + exceptions + imports + lens + memory + QuickCheck + schema-profunctor + string-conversions + swagger2 + tagged + text + time + types-common + uuid + wire-api ]; testHaskellDepends = [ - aeson base containers imports lens QuickCheck tasty tasty-hunit - tasty-quickcheck types-common wire-api + aeson + base + containers + imports + lens + QuickCheck + tasty + tasty-hunit + tasty-quickcheck + types-common + wire-api ]; license = lib.licenses.agpl3Only; } diff --git a/libs/gundeck-types/default.nix b/libs/gundeck-types/default.nix index 19d76ecf6fa..ea45673e17c 100644 --- a/libs/gundeck-types/default.nix +++ b/libs/gundeck-types/default.nix @@ -2,9 +2,21 @@ # 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, attoparsec, base, bytestring -, bytestring-conversion, containers, gitignoreSource, imports, lens -, lib, network-uri, text, types-common, unordered-containers +{ mkDerivation +, aeson +, attoparsec +, base +, bytestring +, bytestring-conversion +, containers +, gitignoreSource +, imports +, lens +, lib +, network-uri +, text +, types-common +, unordered-containers , wire-api }: mkDerivation { @@ -12,8 +24,18 @@ mkDerivation { version = "1.45.0"; src = gitignoreSource ./.; libraryHaskellDepends = [ - aeson attoparsec base bytestring bytestring-conversion containers - imports lens network-uri text types-common unordered-containers + aeson + attoparsec + base + bytestring + bytestring-conversion + containers + imports + lens + network-uri + text + types-common + unordered-containers wire-api ]; license = lib.licenses.agpl3Only; diff --git a/libs/hscim/default.nix b/libs/hscim/default.nix index 4ee4f9c87d7..ff9dda29550 100644 --- a/libs/hscim/default.nix +++ b/libs/hscim/default.nix @@ -2,15 +2,49 @@ # 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, aeson-qq, attoparsec, base, bytestring -, case-insensitive, email-validate, gitignoreSource, hashable -, hedgehog, hspec, hspec-discover, hspec-expectations, hspec-wai -, http-api-data, http-media, http-types, hw-hspec-hedgehog -, indexed-traversable, lib, list-t, microlens, mmorph, mtl -, network-uri, retry, scientific, servant, servant-client -, servant-client-core, servant-server, stm, stm-containers -, string-conversions, template-haskell, text, time -, unordered-containers, uuid, wai, wai-extra, warp +{ mkDerivation +, aeson +, aeson-qq +, attoparsec +, base +, bytestring +, case-insensitive +, email-validate +, gitignoreSource +, hashable +, hedgehog +, hspec +, hspec-discover +, hspec-expectations +, hspec-wai +, http-api-data +, http-media +, http-types +, hw-hspec-hedgehog +, indexed-traversable +, lib +, list-t +, microlens +, mmorph +, mtl +, network-uri +, retry +, scientific +, servant +, servant-client +, servant-client-core +, servant-server +, stm +, stm-containers +, string-conversions +, template-haskell +, text +, time +, unordered-containers +, uuid +, wai +, wai-extra +, warp }: mkDerivation { pname = "hscim"; @@ -19,31 +53,124 @@ mkDerivation { isLibrary = true; isExecutable = true; libraryHaskellDepends = [ - aeson aeson-qq attoparsec base bytestring case-insensitive - email-validate hashable hedgehog hspec hspec-expectations hspec-wai - http-api-data http-media http-types hw-hspec-hedgehog list-t - microlens mmorph mtl network-uri retry scientific servant - servant-client servant-client-core servant-server stm - stm-containers string-conversions template-haskell text time - unordered-containers uuid wai wai-extra warp + aeson + aeson-qq + attoparsec + base + bytestring + case-insensitive + email-validate + hashable + hedgehog + hspec + hspec-expectations + hspec-wai + http-api-data + http-media + http-types + hw-hspec-hedgehog + list-t + microlens + mmorph + mtl + network-uri + retry + scientific + servant + servant-client + servant-client-core + servant-server + stm + stm-containers + string-conversions + template-haskell + text + time + unordered-containers + uuid + wai + wai-extra + warp ]; executableHaskellDepends = [ - aeson aeson-qq attoparsec base bytestring case-insensitive - email-validate hashable hedgehog hspec hspec-expectations hspec-wai - http-api-data http-media http-types hw-hspec-hedgehog list-t - microlens mmorph mtl network-uri retry scientific servant - servant-client servant-client-core servant-server stm - stm-containers string-conversions template-haskell text time - unordered-containers uuid wai wai-extra warp + aeson + aeson-qq + attoparsec + base + bytestring + case-insensitive + email-validate + hashable + hedgehog + hspec + hspec-expectations + hspec-wai + http-api-data + http-media + http-types + hw-hspec-hedgehog + list-t + microlens + mmorph + mtl + network-uri + retry + scientific + servant + servant-client + servant-client-core + servant-server + stm + stm-containers + string-conversions + template-haskell + text + time + unordered-containers + uuid + wai + wai-extra + warp ]; testHaskellDepends = [ - aeson aeson-qq attoparsec base bytestring case-insensitive - email-validate hashable hedgehog hspec hspec-expectations hspec-wai - http-api-data http-media http-types hw-hspec-hedgehog - indexed-traversable list-t microlens mmorph mtl network-uri retry - scientific servant servant-client servant-client-core - servant-server stm stm-containers string-conversions - template-haskell text time unordered-containers uuid wai wai-extra + aeson + aeson-qq + attoparsec + base + bytestring + case-insensitive + email-validate + hashable + hedgehog + hspec + hspec-expectations + hspec-wai + http-api-data + http-media + http-types + hw-hspec-hedgehog + indexed-traversable + list-t + microlens + mmorph + mtl + network-uri + retry + scientific + servant + servant-client + servant-client-core + servant-server + stm + stm-containers + string-conversions + template-haskell + text + time + unordered-containers + uuid + wai + wai-extra warp ]; testToolDepends = [ hspec-discover ]; diff --git a/libs/imports/default.nix b/libs/imports/default.nix index d8b9861d17f..728fca8f3b5 100644 --- a/libs/imports/default.nix +++ b/libs/imports/default.nix @@ -2,17 +2,37 @@ # 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, base, bytestring, containers, deepseq, extra -, gitignoreSource, lib, mtl, text, transformers, unliftio -, unliftio-core, unordered-containers +{ mkDerivation +, base +, bytestring +, containers +, deepseq +, extra +, gitignoreSource +, lib +, mtl +, text +, transformers +, unliftio +, unliftio-core +, unordered-containers }: mkDerivation { pname = "imports"; version = "0.1.0"; src = gitignoreSource ./.; libraryHaskellDepends = [ - base bytestring containers deepseq extra mtl text transformers - unliftio unliftio-core unordered-containers + base + bytestring + containers + deepseq + extra + mtl + text + transformers + unliftio + unliftio-core + unordered-containers ]; description = "Very common imports"; license = lib.licenses.agpl3Only; diff --git a/libs/jwt-tools/default.nix b/libs/jwt-tools/default.nix index 13a50bca3c0..4dff35909a0 100644 --- a/libs/jwt-tools/default.nix +++ b/libs/jwt-tools/default.nix @@ -2,24 +2,58 @@ # 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, base, base64-bytestring, bytestring -, bytestring-conversion, either, extra, gitignoreSource, hspec -, http-types, imports, lib, QuickCheck, rusty_jwt_tools_ffi -, string-conversions, text, transformers, unliftio, uuid +{ mkDerivation +, base +, base64-bytestring +, bytestring +, bytestring-conversion +, either +, extra +, gitignoreSource +, hspec +, http-types +, imports +, lib +, QuickCheck +, rusty_jwt_tools_ffi +, string-conversions +, text +, transformers +, unliftio +, uuid }: mkDerivation { pname = "jwt-tools"; version = "0.1.0"; src = gitignoreSource ./.; libraryHaskellDepends = [ - base base64-bytestring bytestring bytestring-conversion http-types - imports QuickCheck string-conversions transformers unliftio + base + base64-bytestring + bytestring + bytestring-conversion + http-types + imports + QuickCheck + string-conversions + transformers + unliftio ]; librarySystemDepends = [ rusty_jwt_tools_ffi ]; testHaskellDepends = [ - base base64-bytestring bytestring bytestring-conversion either - extra hspec http-types imports QuickCheck string-conversions text - transformers uuid + base + base64-bytestring + bytestring + bytestring-conversion + either + extra + hspec + http-types + imports + QuickCheck + string-conversions + text + transformers + uuid ]; description = "FFI to rusty-jwt-tools"; license = lib.licenses.agpl3Only; diff --git a/libs/metrics-core/default.nix b/libs/metrics-core/default.nix index eb21ca9b1ee..f3eab69051a 100644 --- a/libs/metrics-core/default.nix +++ b/libs/metrics-core/default.nix @@ -2,8 +2,17 @@ # 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, base, containers, gitignoreSource, hashable -, immortal, imports, lib, prometheus-client, text, time +{ mkDerivation +, base +, containers +, gitignoreSource +, hashable +, immortal +, imports +, lib +, prometheus-client +, text +, time , unordered-containers }: mkDerivation { @@ -11,8 +20,15 @@ mkDerivation { version = "0.3.2"; src = gitignoreSource ./.; libraryHaskellDepends = [ - base containers hashable immortal imports prometheus-client text - time unordered-containers + base + containers + hashable + immortal + imports + prometheus-client + text + time + unordered-containers ]; description = "Metrics core"; license = lib.licenses.agpl3Only; diff --git a/libs/metrics-wai/default.nix b/libs/metrics-wai/default.nix index 9449e05d91e..7a3a90c45d3 100644 --- a/libs/metrics-wai/default.nix +++ b/libs/metrics-wai/default.nix @@ -2,24 +2,62 @@ # 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, base, bytestring, containers, gitignoreSource -, hspec, hspec-discover, http-types, imports, lib, metrics-core -, servant, servant-multipart, string-conversions, text, wai -, wai-middleware-prometheus, wai-route, wai-routing +{ mkDerivation +, base +, bytestring +, containers +, gitignoreSource +, hspec +, hspec-discover +, http-types +, imports +, lib +, metrics-core +, servant +, servant-multipart +, string-conversions +, text +, wai +, wai-middleware-prometheus +, wai-route +, wai-routing }: mkDerivation { pname = "metrics-wai"; version = "0.5.7"; src = gitignoreSource ./.; libraryHaskellDepends = [ - base bytestring containers http-types imports metrics-core servant - servant-multipart string-conversions text wai - wai-middleware-prometheus wai-route wai-routing + base + bytestring + containers + http-types + imports + metrics-core + servant + servant-multipart + string-conversions + text + wai + wai-middleware-prometheus + wai-route + wai-routing ]; testHaskellDepends = [ - base bytestring containers hspec http-types imports metrics-core - servant servant-multipart string-conversions text wai - wai-middleware-prometheus wai-route wai-routing + base + bytestring + containers + hspec + http-types + imports + metrics-core + servant + servant-multipart + string-conversions + text + wai + wai-middleware-prometheus + wai-route + wai-routing ]; testToolDepends = [ hspec-discover ]; description = "Metrics WAI integration"; diff --git a/libs/polysemy-wire-zoo/default.nix b/libs/polysemy-wire-zoo/default.nix index 178182a1410..ea3e21fdf0f 100644 --- a/libs/polysemy-wire-zoo/default.nix +++ b/libs/polysemy-wire-zoo/default.nix @@ -2,23 +2,59 @@ # 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, base, cassandra-util, containers, gitignoreSource -, HsOpenSSL, hspec, hspec-discover, imports, lib, polysemy -, polysemy-check, polysemy-plugin, QuickCheck, saml2-web-sso, time -, tinylog, types-common, unliftio, uuid, wire-api +{ mkDerivation +, base +, cassandra-util +, containers +, gitignoreSource +, HsOpenSSL +, hspec +, hspec-discover +, imports +, lib +, polysemy +, polysemy-check +, polysemy-plugin +, QuickCheck +, saml2-web-sso +, time +, tinylog +, types-common +, unliftio +, uuid +, wire-api }: mkDerivation { pname = "polysemy-wire-zoo"; version = "0.1.0"; src = gitignoreSource ./.; libraryHaskellDepends = [ - base cassandra-util HsOpenSSL hspec imports polysemy polysemy-check - polysemy-plugin QuickCheck saml2-web-sso time tinylog types-common - unliftio uuid wire-api + base + cassandra-util + HsOpenSSL + hspec + imports + polysemy + polysemy-check + polysemy-plugin + QuickCheck + saml2-web-sso + time + tinylog + types-common + unliftio + uuid + wire-api ]; testHaskellDepends = [ - base containers hspec imports polysemy polysemy-check - polysemy-plugin unliftio + base + containers + hspec + imports + polysemy + polysemy-check + polysemy-plugin + unliftio ]; testToolDepends = [ hspec-discover ]; description = "Polysemy interface for various libraries"; diff --git a/libs/ropes/default.nix b/libs/ropes/default.nix index a97db020001..6dd3c1ed69f 100644 --- a/libs/ropes/default.nix +++ b/libs/ropes/default.nix @@ -2,17 +2,35 @@ # 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 +, 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 + 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/schema-profunctor/default.nix b/libs/schema-profunctor/default.nix index f2d47ba2248..a498d97378b 100644 --- a/libs/schema-profunctor/default.nix +++ b/libs/schema-profunctor/default.nix @@ -2,22 +2,55 @@ # 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, aeson-qq, base, bifunctors, comonad -, containers, gitignoreSource, imports, insert-ordered-containers -, lens, lib, profunctors, swagger2, tasty, tasty-hunit, text -, transformers, vector +{ mkDerivation +, aeson +, aeson-qq +, base +, bifunctors +, comonad +, containers +, gitignoreSource +, imports +, insert-ordered-containers +, lens +, lib +, profunctors +, swagger2 +, tasty +, tasty-hunit +, text +, transformers +, vector }: mkDerivation { pname = "schema-profunctor"; version = "0.1.0"; src = gitignoreSource ./.; libraryHaskellDepends = [ - aeson base bifunctors comonad containers imports lens profunctors - swagger2 text transformers vector + aeson + base + bifunctors + comonad + containers + imports + lens + profunctors + swagger2 + text + transformers + vector ]; testHaskellDepends = [ - aeson aeson-qq base imports insert-ordered-containers lens swagger2 - tasty tasty-hunit text + aeson + aeson-qq + base + imports + insert-ordered-containers + lens + swagger2 + tasty + tasty-hunit + text ]; license = lib.licenses.agpl3Only; } diff --git a/libs/sodium-crypto-sign/default.nix b/libs/sodium-crypto-sign/default.nix index b7ab77265d3..16278c2952a 100644 --- a/libs/sodium-crypto-sign/default.nix +++ b/libs/sodium-crypto-sign/default.nix @@ -2,15 +2,24 @@ # 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, base, base64-bytestring, bytestring -, gitignoreSource, imports, lib, libsodium +{ mkDerivation +, base +, base64-bytestring +, bytestring +, gitignoreSource +, imports +, lib +, libsodium }: mkDerivation { pname = "sodium-crypto-sign"; version = "0.1.2"; src = gitignoreSource ./.; libraryHaskellDepends = [ - base base64-bytestring bytestring imports + base + base64-bytestring + bytestring + imports ]; libraryPkgconfigDepends = [ libsodium ]; description = "FFI to some of the libsodium crypto_sign_* functions"; diff --git a/libs/ssl-util/default.nix b/libs/ssl-util/default.nix index 1ff0f94b886..1ec717b7f74 100644 --- a/libs/ssl-util/default.nix +++ b/libs/ssl-util/default.nix @@ -2,15 +2,29 @@ # 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, base, byteable, bytestring, gitignoreSource -, HsOpenSSL, http-client, imports, lib, time +{ mkDerivation +, base +, byteable +, bytestring +, gitignoreSource +, HsOpenSSL +, http-client +, imports +, lib +, time }: mkDerivation { pname = "ssl-util"; version = "0.1.0"; src = gitignoreSource ./.; libraryHaskellDepends = [ - base byteable bytestring HsOpenSSL http-client imports time + base + byteable + bytestring + HsOpenSSL + http-client + imports + time ]; description = "SSL-related utilities"; license = lib.licenses.agpl3Only; diff --git a/libs/tasty-cannon/default.nix b/libs/tasty-cannon/default.nix index 4b79d90f246..297f3ce945d 100644 --- a/libs/tasty-cannon/default.nix +++ b/libs/tasty-cannon/default.nix @@ -2,19 +2,47 @@ # 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, async, base, bilge, bytestring -, bytestring-conversion, data-timeout, exceptions, gitignoreSource -, http-client, http-types, imports, lib, random, tasty-hunit -, types-common, websockets, wire-api +{ mkDerivation +, aeson +, async +, base +, bilge +, bytestring +, bytestring-conversion +, data-timeout +, exceptions +, gitignoreSource +, http-client +, http-types +, imports +, lib +, random +, tasty-hunit +, types-common +, websockets +, wire-api }: mkDerivation { pname = "tasty-cannon"; version = "0.4.0"; src = gitignoreSource ./.; libraryHaskellDepends = [ - aeson async base bilge bytestring bytestring-conversion - data-timeout exceptions http-client http-types imports random - tasty-hunit types-common websockets wire-api + aeson + async + base + bilge + bytestring + bytestring-conversion + data-timeout + exceptions + http-client + http-types + imports + random + tasty-hunit + types-common + websockets + wire-api ]; description = "Cannon Integration Testing Utilities"; license = lib.licenses.agpl3Only; diff --git a/libs/types-common-aws/default.nix b/libs/types-common-aws/default.nix index 229d7060bfb..647dd6884dc 100644 --- a/libs/types-common-aws/default.nix +++ b/libs/types-common-aws/default.nix @@ -2,17 +2,44 @@ # 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, amazonka, amazonka-sqs, base, base64-bytestring -, exceptions, gitignoreSource, imports, lens, lib, monad-control -, proto-lens, resourcet, safe, tasty, tasty-hunit, text, time +{ mkDerivation +, amazonka +, amazonka-sqs +, base +, base64-bytestring +, exceptions +, gitignoreSource +, imports +, lens +, lib +, monad-control +, proto-lens +, resourcet +, safe +, tasty +, tasty-hunit +, text +, time }: mkDerivation { pname = "types-common-aws"; version = "0.16.0"; src = gitignoreSource ./.; libraryHaskellDepends = [ - amazonka amazonka-sqs base base64-bytestring exceptions imports - lens monad-control proto-lens resourcet safe tasty tasty-hunit text + amazonka + amazonka-sqs + base + base64-bytestring + exceptions + imports + lens + monad-control + proto-lens + resourcet + safe + tasty + tasty-hunit + text time ]; description = "Shared AWS type definitions"; diff --git a/libs/types-common-journal/default.nix b/libs/types-common-journal/default.nix index 338c21abae2..7dae825dfb4 100644 --- a/libs/types-common-journal/default.nix +++ b/libs/types-common-journal/default.nix @@ -2,9 +2,19 @@ # 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, base, bytestring, Cabal, gitignoreSource, imports -, lib, proto-lens-protoc, proto-lens-runtime, proto-lens-setup -, time, types-common, uuid +{ mkDerivation +, base +, bytestring +, Cabal +, gitignoreSource +, imports +, lib +, proto-lens-protoc +, proto-lens-runtime +, proto-lens-setup +, time +, types-common +, uuid }: mkDerivation { pname = "types-common-journal"; @@ -12,7 +22,13 @@ mkDerivation { src = gitignoreSource ./.; setupHaskellDepends = [ base Cabal proto-lens-setup ]; libraryHaskellDepends = [ - base bytestring imports proto-lens-runtime time types-common uuid + base + bytestring + imports + proto-lens-runtime + time + types-common + uuid ]; libraryToolDepends = [ proto-lens-protoc ]; description = "Shared protobuf type definitions"; diff --git a/libs/types-common/default.nix b/libs/types-common/default.nix index 425dfeffffa..b1f22221ba0 100644 --- a/libs/types-common/default.nix +++ b/libs/types-common/default.nix @@ -2,40 +2,140 @@ # 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, attoparsec, attoparsec-iso8601, base -, base16-bytestring, base64-bytestring, binary, bytestring -, bytestring-conversion, cassandra-util, cereal, containers -, cryptohash-md5, cryptohash-sha1, cryptonite, currency-codes -, data-default, generic-random, gitignoreSource, hashable -, http-api-data, imports, iproute, iso3166-country-codes, iso639 -, lens, lens-datetime, lib, mime, optparse-applicative, pem -, protobuf, QuickCheck, quickcheck-instances, random -, schema-profunctor, scientific, servant-server, singletons -, string-conversions, swagger, swagger2, tagged, tasty, tasty-hunit -, tasty-quickcheck, text, time, time-locale-compat, tinylog, unix -, unordered-containers, uri-bytestring, uuid, vector, yaml +{ mkDerivation +, aeson +, attoparsec +, attoparsec-iso8601 +, base +, base16-bytestring +, base64-bytestring +, binary +, bytestring +, bytestring-conversion +, cassandra-util +, cereal +, containers +, cryptohash-md5 +, cryptohash-sha1 +, cryptonite +, currency-codes +, data-default +, generic-random +, gitignoreSource +, hashable +, http-api-data +, imports +, iproute +, iso3166-country-codes +, iso639 +, lens +, lens-datetime +, lib +, mime +, optparse-applicative +, pem +, protobuf +, QuickCheck +, quickcheck-instances +, random +, schema-profunctor +, scientific +, servant-server +, singletons +, string-conversions +, swagger +, swagger2 +, tagged +, tasty +, tasty-hunit +, tasty-quickcheck +, text +, time +, time-locale-compat +, tinylog +, unix +, unordered-containers +, uri-bytestring +, uuid +, vector +, yaml }: mkDerivation { pname = "types-common"; version = "0.16.0"; src = gitignoreSource ./.; libraryHaskellDepends = [ - aeson attoparsec attoparsec-iso8601 base base16-bytestring - base64-bytestring binary bytestring bytestring-conversion - cassandra-util containers cryptohash-md5 cryptohash-sha1 cryptonite - currency-codes data-default generic-random hashable http-api-data - imports iproute iso3166-country-codes iso639 lens lens-datetime - mime optparse-applicative pem protobuf QuickCheck - quickcheck-instances random schema-profunctor scientific - servant-server singletons string-conversions swagger swagger2 - tagged tasty text time time-locale-compat tinylog unix - unordered-containers uri-bytestring uuid vector yaml + aeson + attoparsec + attoparsec-iso8601 + base + base16-bytestring + base64-bytestring + binary + bytestring + bytestring-conversion + cassandra-util + containers + cryptohash-md5 + cryptohash-sha1 + cryptonite + currency-codes + data-default + generic-random + hashable + http-api-data + imports + iproute + iso3166-country-codes + iso639 + lens + lens-datetime + mime + optparse-applicative + pem + protobuf + QuickCheck + quickcheck-instances + random + schema-profunctor + scientific + servant-server + singletons + string-conversions + swagger + swagger2 + tagged + tasty + text + time + time-locale-compat + tinylog + unix + unordered-containers + uri-bytestring + uuid + vector + yaml ]; testHaskellDepends = [ - aeson base base16-bytestring base64-bytestring bytestring - bytestring-conversion cereal imports protobuf QuickCheck - string-conversions tasty tasty-hunit tasty-quickcheck text time - unordered-containers uuid + aeson + base + base16-bytestring + base64-bytestring + bytestring + bytestring-conversion + cereal + imports + protobuf + QuickCheck + string-conversions + tasty + tasty-hunit + tasty-quickcheck + text + time + unordered-containers + uuid ]; description = "Shared type definitions"; license = lib.licenses.agpl3Only; diff --git a/libs/wai-utilities/default.nix b/libs/wai-utilities/default.nix index ea9cebed797..93a249b3c7a 100644 --- a/libs/wai-utilities/default.nix +++ b/libs/wai-utilities/default.nix @@ -2,24 +2,71 @@ # 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, async, base, bytestring -, bytestring-conversion, errors, exceptions, gitignoreSource -, http-types, imports, kan-extensions, lib, metrics-core -, metrics-wai, pipes, prometheus-client, servant-server -, streaming-commons, string-conversions, swagger, swagger2, text -, tinylog, types-common, unix, wai, wai-predicates, wai-routing -, warp, warp-tls +{ mkDerivation +, aeson +, async +, base +, bytestring +, bytestring-conversion +, errors +, exceptions +, gitignoreSource +, http-types +, imports +, kan-extensions +, lib +, metrics-core +, metrics-wai +, pipes +, prometheus-client +, servant-server +, streaming-commons +, string-conversions +, swagger +, swagger2 +, text +, tinylog +, types-common +, unix +, wai +, wai-predicates +, wai-routing +, warp +, warp-tls }: mkDerivation { pname = "wai-utilities"; version = "0.16.1"; src = gitignoreSource ./.; libraryHaskellDepends = [ - aeson async base bytestring bytestring-conversion errors exceptions - http-types imports kan-extensions metrics-core metrics-wai pipes - prometheus-client servant-server streaming-commons - string-conversions swagger swagger2 text tinylog types-common unix - wai wai-predicates wai-routing warp warp-tls + aeson + async + base + bytestring + bytestring-conversion + errors + exceptions + http-types + imports + kan-extensions + metrics-core + metrics-wai + pipes + prometheus-client + servant-server + streaming-commons + string-conversions + swagger + swagger2 + text + tinylog + types-common + unix + wai + wai-predicates + wai-routing + warp + warp-tls ]; description = "Various helpers for WAI"; license = lib.licenses.agpl3Only; diff --git a/libs/wire-api-federation/default.nix b/libs/wire-api-federation/default.nix index 1fffa573fb0..3c7d80254e0 100644 --- a/libs/wire-api-federation/default.nix +++ b/libs/wire-api-federation/default.nix @@ -2,39 +2,145 @@ # 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, aeson-pretty, async, base, bytestring -, bytestring-conversion, case-insensitive, containers, either -, errors, exceptions, gitignoreSource, hspec, hspec-discover -, http-media, http-types, http2, HUnit, imports, kan-extensions -, lens, lib, lifted-base, metrics-wai, mtl, network, QuickCheck -, retry, schema-profunctor, servant, servant-client -, servant-client-core, servant-server, singletons, sop-core -, streaming-commons, swagger2, template-haskell, text, time -, time-manager, tls, transformers, types-common, uuid -, wai-utilities, wire-api +{ mkDerivation +, aeson +, aeson-pretty +, async +, base +, bytestring +, bytestring-conversion +, case-insensitive +, containers +, either +, errors +, exceptions +, gitignoreSource +, hspec +, hspec-discover +, http-media +, http-types +, http2 +, HUnit +, imports +, kan-extensions +, lens +, lib +, lifted-base +, metrics-wai +, mtl +, network +, QuickCheck +, retry +, schema-profunctor +, servant +, servant-client +, servant-client-core +, servant-server +, singletons +, sop-core +, streaming-commons +, swagger2 +, template-haskell +, text +, time +, time-manager +, tls +, transformers +, types-common +, uuid +, wai-utilities +, wire-api }: mkDerivation { pname = "wire-api-federation"; version = "0.1.0"; src = gitignoreSource ./.; libraryHaskellDepends = [ - aeson async base bytestring bytestring-conversion case-insensitive - containers either errors exceptions http-media http-types http2 - imports kan-extensions lens lifted-base metrics-wai mtl network - QuickCheck schema-profunctor servant servant-client - servant-client-core servant-server singletons sop-core - streaming-commons swagger2 template-haskell text time time-manager - tls transformers types-common wai-utilities wire-api + aeson + async + base + bytestring + bytestring-conversion + case-insensitive + containers + either + errors + exceptions + http-media + http-types + http2 + imports + kan-extensions + lens + lifted-base + metrics-wai + mtl + network + QuickCheck + schema-profunctor + servant + servant-client + servant-client-core + servant-server + singletons + sop-core + streaming-commons + swagger2 + template-haskell + text + time + time-manager + tls + transformers + types-common + wai-utilities + wire-api ]; testHaskellDepends = [ - aeson aeson-pretty async base bytestring bytestring-conversion - case-insensitive containers either errors exceptions hspec - http-media http-types http2 HUnit imports kan-extensions lens - lifted-base metrics-wai mtl network QuickCheck retry - schema-profunctor servant servant-client servant-client-core - servant-server singletons sop-core streaming-commons swagger2 - template-haskell text time time-manager tls transformers - types-common uuid wai-utilities wire-api + aeson + aeson-pretty + async + base + bytestring + bytestring-conversion + case-insensitive + containers + either + errors + exceptions + hspec + http-media + http-types + http2 + HUnit + imports + kan-extensions + lens + lifted-base + metrics-wai + mtl + network + QuickCheck + retry + schema-profunctor + servant + servant-client + servant-client-core + servant-server + singletons + sop-core + streaming-commons + swagger2 + template-haskell + text + time + time-manager + tls + transformers + types-common + uuid + wai-utilities + wire-api ]; testToolDepends = [ hspec-discover ]; description = "The Wire server-to-server API for federation"; diff --git a/libs/wire-api/default.nix b/libs/wire-api/default.nix index 0569448d068..8564a5767ac 100644 --- a/libs/wire-api/default.nix +++ b/libs/wire-api/default.nix @@ -2,61 +2,254 @@ # 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, aeson-pretty, aeson-qq, async, attoparsec -, base, base64-bytestring, binary, binary-parsers, bytestring -, bytestring-arbitrary, bytestring-conversion, case-insensitive -, cassandra-util, cassava, cereal, comonad, conduit, constraints -, containers, cookie, cryptonite, currency-codes, deriving-aeson -, deriving-swagger2, directory, either, email-validate, errors -, extended, extra, filepath, generic-random, generics-sop, ghc-prim -, gitignoreSource, hashable, hex, hostname-validate, hscim -, http-api-data, http-media, http-types, imports -, insert-ordered-containers, iproute, iso3166-country-codes, iso639 -, lens, lib, memory, metrics-wai, mime, mtl, pem, polysemy, pretty -, process, proto-lens, protobuf, QuickCheck, quickcheck-instances -, random, resourcet, saml2-web-sso, schema-profunctor, scientific -, servant, servant-client, servant-client-core, servant-conduit -, servant-multipart, servant-server, servant-swagger -, servant-swagger-ui, singletons, sop-core, string-conversions -, swagger, swagger2, tagged, tasty, tasty-expected-failure -, tasty-hunit, tasty-quickcheck, text, time, types-common, unliftio -, unordered-containers, uri-bytestring, utf8-string, uuid, vector -, wai, wai-extra, wai-utilities, wai-websockets, websockets -, wire-message-proto-lens, x509, zauth +{ mkDerivation +, aeson +, aeson-pretty +, aeson-qq +, async +, attoparsec +, base +, base64-bytestring +, binary +, binary-parsers +, bytestring +, bytestring-arbitrary +, bytestring-conversion +, case-insensitive +, cassandra-util +, cassava +, cereal +, comonad +, conduit +, constraints +, containers +, cookie +, cryptonite +, currency-codes +, deriving-aeson +, deriving-swagger2 +, directory +, either +, email-validate +, errors +, extended +, extra +, filepath +, generic-random +, generics-sop +, ghc-prim +, gitignoreSource +, hashable +, hex +, hostname-validate +, hscim +, http-api-data +, http-media +, http-types +, imports +, insert-ordered-containers +, iproute +, iso3166-country-codes +, iso639 +, lens +, lib +, memory +, metrics-wai +, mime +, mtl +, pem +, polysemy +, pretty +, process +, proto-lens +, protobuf +, QuickCheck +, quickcheck-instances +, random +, resourcet +, saml2-web-sso +, schema-profunctor +, scientific +, servant +, servant-client +, servant-client-core +, servant-conduit +, servant-multipart +, servant-server +, servant-swagger +, servant-swagger-ui +, singletons +, sop-core +, string-conversions +, swagger +, swagger2 +, tagged +, tasty +, tasty-expected-failure +, tasty-hunit +, tasty-quickcheck +, text +, time +, types-common +, unliftio +, unordered-containers +, uri-bytestring +, utf8-string +, uuid +, vector +, wai +, wai-extra +, wai-utilities +, wai-websockets +, websockets +, wire-message-proto-lens +, x509 +, zauth }: mkDerivation { pname = "wire-api"; version = "0.1.0"; src = gitignoreSource ./.; libraryHaskellDepends = [ - aeson attoparsec base base64-bytestring binary binary-parsers - bytestring bytestring-conversion case-insensitive cassandra-util - cassava cereal comonad conduit constraints containers cookie - cryptonite currency-codes deriving-aeson deriving-swagger2 either - email-validate errors extended extra filepath generic-random - generics-sop ghc-prim hashable hostname-validate hscim - http-api-data http-media http-types imports - insert-ordered-containers iproute iso3166-country-codes iso639 lens - memory metrics-wai mime mtl pem polysemy proto-lens protobuf - QuickCheck quickcheck-instances random resourcet saml2-web-sso - schema-profunctor scientific servant servant-client - servant-client-core servant-conduit servant-multipart - servant-server servant-swagger servant-swagger-ui singletons - sop-core string-conversions swagger swagger2 tagged text time - types-common unordered-containers uri-bytestring utf8-string uuid - vector wai wai-extra wai-utilities wai-websockets websockets - wire-message-proto-lens x509 zauth + aeson + attoparsec + base + base64-bytestring + binary + binary-parsers + bytestring + bytestring-conversion + case-insensitive + cassandra-util + cassava + cereal + comonad + conduit + constraints + containers + cookie + cryptonite + currency-codes + deriving-aeson + deriving-swagger2 + either + email-validate + errors + extended + extra + filepath + generic-random + generics-sop + ghc-prim + hashable + hostname-validate + hscim + http-api-data + http-media + http-types + imports + insert-ordered-containers + iproute + iso3166-country-codes + iso639 + lens + memory + metrics-wai + mime + mtl + pem + polysemy + proto-lens + protobuf + QuickCheck + quickcheck-instances + random + resourcet + saml2-web-sso + schema-profunctor + scientific + servant + servant-client + servant-client-core + servant-conduit + servant-multipart + servant-server + servant-swagger + servant-swagger-ui + singletons + sop-core + string-conversions + swagger + swagger2 + tagged + text + time + types-common + unordered-containers + uri-bytestring + utf8-string + uuid + vector + wai + wai-extra + wai-utilities + wai-websockets + websockets + wire-message-proto-lens + x509 + zauth ]; testHaskellDepends = [ - aeson aeson-pretty aeson-qq async base binary bytestring - bytestring-arbitrary bytestring-conversion case-insensitive cassava - containers cryptonite currency-codes directory either filepath hex - hscim imports iso3166-country-codes iso639 lens memory metrics-wai - mime pem pretty process proto-lens QuickCheck saml2-web-sso - schema-profunctor servant servant-swagger-ui string-conversions - swagger2 tasty tasty-expected-failure tasty-hunit tasty-quickcheck - text time types-common unliftio unordered-containers uri-bytestring - uuid vector wire-message-proto-lens + aeson + aeson-pretty + aeson-qq + async + base + binary + bytestring + bytestring-arbitrary + bytestring-conversion + case-insensitive + cassava + containers + cryptonite + currency-codes + directory + either + filepath + hex + hscim + imports + iso3166-country-codes + iso639 + lens + memory + metrics-wai + mime + pem + pretty + process + proto-lens + QuickCheck + saml2-web-sso + schema-profunctor + servant + servant-swagger-ui + string-conversions + swagger2 + tasty + tasty-expected-failure + tasty-hunit + tasty-quickcheck + text + time + types-common + unliftio + unordered-containers + uri-bytestring + uuid + vector + wire-message-proto-lens ]; license = lib.licenses.agpl3Only; } diff --git a/libs/wire-message-proto-lens/default.nix b/libs/wire-message-proto-lens/default.nix index 598b4edb7f2..3c58511773e 100644 --- a/libs/wire-message-proto-lens/default.nix +++ b/libs/wire-message-proto-lens/default.nix @@ -2,8 +2,14 @@ # 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, base, Cabal, gitignoreSource, lib -, proto-lens-protoc, proto-lens-runtime, proto-lens-setup +{ mkDerivation +, base +, Cabal +, gitignoreSource +, lib +, proto-lens-protoc +, proto-lens-runtime +, proto-lens-setup }: mkDerivation { pname = "wire-message-proto-lens"; diff --git a/libs/zauth/default.nix b/libs/zauth/default.nix index 9cc4a774c0b..0ff83b47035 100644 --- a/libs/zauth/default.nix +++ b/libs/zauth/default.nix @@ -2,11 +2,29 @@ # 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, attoparsec, base, base64-bytestring, bytestring -, bytestring-conversion, errors, exceptions, gitignoreSource -, imports, lens, lib, mtl, mwc-random, optparse-applicative -, sodium-crypto-sign, tasty, tasty-hunit, tasty-quickcheck, text -, time, uuid, vector +{ mkDerivation +, attoparsec +, base +, base64-bytestring +, bytestring +, bytestring-conversion +, errors +, exceptions +, gitignoreSource +, imports +, lens +, lib +, mtl +, mwc-random +, optparse-applicative +, sodium-crypto-sign +, tasty +, tasty-hunit +, tasty-quickcheck +, text +, time +, uuid +, vector }: mkDerivation { pname = "zauth"; @@ -15,17 +33,47 @@ mkDerivation { isLibrary = true; isExecutable = true; libraryHaskellDepends = [ - attoparsec base base64-bytestring bytestring bytestring-conversion - errors exceptions imports lens mtl mwc-random sodium-crypto-sign - time uuid vector + attoparsec + base + base64-bytestring + bytestring + bytestring-conversion + errors + exceptions + imports + lens + mtl + mwc-random + sodium-crypto-sign + time + uuid + vector ]; executableHaskellDepends = [ - base base64-bytestring bytestring bytestring-conversion errors - imports lens optparse-applicative sodium-crypto-sign uuid + base + base64-bytestring + bytestring + bytestring-conversion + errors + imports + lens + optparse-applicative + sodium-crypto-sign + uuid ]; testHaskellDepends = [ - base bytestring bytestring-conversion errors imports lens - sodium-crypto-sign tasty tasty-hunit tasty-quickcheck text uuid + base + bytestring + bytestring-conversion + errors + imports + lens + sodium-crypto-sign + tasty + tasty-hunit + tasty-quickcheck + text + uuid ]; description = "Creation and validation of signed tokens"; license = lib.licenses.agpl3Only; diff --git a/services/brig/default.nix b/services/brig/default.nix index c8ea67ba1dd..cb9aa3523dc 100644 --- a/services/brig/default.nix +++ b/services/brig/default.nix @@ -2,39 +2,157 @@ # 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, amazonka, amazonka-dynamodb, amazonka-ses -, amazonka-sqs, async, attoparsec, auto-update, base, base-prelude -, base16-bytestring, base64-bytestring, bilge, binary, bloodhound -, brig-types, bytestring, bytestring-conversion, cargohold-types -, case-insensitive, cassandra-util, comonad, conduit, containers -, cookie, cryptobox-haskell, currency-codes, data-default -, data-timeout, dns, dns-util, either, email-validate -, enclosed-exceptions, errors, exceptions, extended, extra -, federator, file-embed, file-embed-lzma, filepath, fsnotify -, galley-types, geoip2, gitignoreSource, gundeck-types, hashable -, HaskellNet, HaskellNet-SSL, hscim, HsOpenSSL -, HsOpenSSL-x509-system, html-entities, http-api-data, http-client -, http-client-openssl, http-client-tls, http-media -, http-reverse-proxy, http-types, imports -, insert-ordered-containers, iproute, iso639, jwt-tools, lens -, lens-aeson, lib, metrics-core, metrics-wai, mime, mime-mail -, mmorph, MonadRandom, mtl, multihash, mwc-random, network -, network-conduit-tls, optparse-applicative, pem, polysemy -, polysemy-plugin, polysemy-wire-zoo, process, proto-lens -, QuickCheck, random, random-shuffle, raw-strings-qq, resource-pool -, resourcet, retry, ropes, safe, safe-exceptions, saml2-web-sso -, schema-profunctor, scientific, scrypt, servant, servant-client -, servant-client-core, servant-server, servant-swagger -, servant-swagger-ui, sodium-crypto-sign, spar, split, ssl-util -, statistics, stomp-queue, string-conversions, swagger, swagger2 -, tagged, tasty, tasty-cannon, tasty-hunit, tasty-quickcheck -, template, template-haskell, temporary, text, text-icu-translit -, time, tinylog, transformers, types-common, types-common-aws -, types-common-journal, unliftio, unordered-containers -, uri-bytestring, uuid, vector, wai, wai-extra -, wai-middleware-gunzip, wai-predicates, wai-route, wai-routing -, wai-utilities, warp, warp-tls, wire-api, wire-api-federation -, yaml, zauth +{ mkDerivation +, aeson +, amazonka +, amazonka-dynamodb +, amazonka-ses +, amazonka-sqs +, async +, attoparsec +, auto-update +, base +, base-prelude +, base16-bytestring +, base64-bytestring +, bilge +, binary +, bloodhound +, brig-types +, bytestring +, bytestring-conversion +, cargohold-types +, case-insensitive +, cassandra-util +, comonad +, conduit +, containers +, cookie +, cryptobox-haskell +, currency-codes +, data-default +, data-timeout +, dns +, dns-util +, either +, email-validate +, enclosed-exceptions +, errors +, exceptions +, extended +, extra +, federator +, file-embed +, file-embed-lzma +, filepath +, fsnotify +, galley-types +, geoip2 +, gitignoreSource +, gundeck-types +, hashable +, HaskellNet +, HaskellNet-SSL +, hscim +, HsOpenSSL +, HsOpenSSL-x509-system +, html-entities +, http-api-data +, http-client +, http-client-openssl +, http-client-tls +, http-media +, http-reverse-proxy +, http-types +, imports +, insert-ordered-containers +, iproute +, iso639 +, jwt-tools +, lens +, lens-aeson +, lib +, metrics-core +, metrics-wai +, mime +, mime-mail +, mmorph +, MonadRandom +, mtl +, multihash +, mwc-random +, network +, network-conduit-tls +, optparse-applicative +, pem +, polysemy +, polysemy-plugin +, polysemy-wire-zoo +, process +, proto-lens +, QuickCheck +, random +, random-shuffle +, raw-strings-qq +, resource-pool +, resourcet +, retry +, ropes +, safe +, safe-exceptions +, saml2-web-sso +, schema-profunctor +, scientific +, scrypt +, servant +, servant-client +, servant-client-core +, servant-server +, servant-swagger +, servant-swagger-ui +, sodium-crypto-sign +, spar +, split +, ssl-util +, statistics +, stomp-queue +, string-conversions +, swagger +, swagger2 +, tagged +, tasty +, tasty-cannon +, tasty-hunit +, tasty-quickcheck +, template +, template-haskell +, temporary +, text +, text-icu-translit +, time +, tinylog +, transformers +, types-common +, types-common-aws +, types-common-journal +, unliftio +, unordered-containers +, uri-bytestring +, uuid +, vector +, wai +, wai-extra +, wai-middleware-gunzip +, wai-predicates +, wai-route +, wai-routing +, wai-utilities +, warp +, warp-tls +, wire-api +, wire-api-federation +, yaml +, zauth }: mkDerivation { pname = "brig"; @@ -43,56 +161,256 @@ mkDerivation { isLibrary = true; isExecutable = true; libraryHaskellDepends = [ - aeson amazonka amazonka-dynamodb amazonka-ses amazonka-sqs async - attoparsec auto-update base base-prelude base16-bytestring - base64-bytestring bilge bloodhound brig-types bytestring - bytestring-conversion cassandra-util comonad conduit containers - cookie cryptobox-haskell currency-codes data-default data-timeout - dns dns-util either enclosed-exceptions errors exceptions extended - extra file-embed file-embed-lzma filepath fsnotify galley-types - geoip2 gundeck-types hashable HaskellNet HaskellNet-SSL HsOpenSSL - HsOpenSSL-x509-system html-entities http-client http-client-openssl - http-media http-types imports insert-ordered-containers iproute - iso639 jwt-tools lens lens-aeson metrics-core metrics-wai mime - mime-mail mmorph MonadRandom mtl multihash mwc-random network - network-conduit-tls optparse-applicative pem polysemy - polysemy-plugin polysemy-wire-zoo proto-lens random-shuffle - resource-pool resourcet retry ropes safe safe-exceptions - saml2-web-sso schema-profunctor scientific scrypt servant - servant-client servant-client-core servant-server servant-swagger - servant-swagger-ui sodium-crypto-sign split ssl-util statistics - stomp-queue string-conversions swagger swagger2 tagged template - template-haskell text text-icu-translit time tinylog transformers - types-common types-common-aws types-common-journal unliftio - unordered-containers uri-bytestring uuid vector wai wai-extra - wai-middleware-gunzip wai-predicates wai-routing wai-utilities warp - wire-api wire-api-federation yaml zauth + aeson + amazonka + amazonka-dynamodb + amazonka-ses + amazonka-sqs + async + attoparsec + auto-update + base + base-prelude + base16-bytestring + base64-bytestring + bilge + bloodhound + brig-types + bytestring + bytestring-conversion + cassandra-util + comonad + conduit + containers + cookie + cryptobox-haskell + currency-codes + data-default + data-timeout + dns + dns-util + either + enclosed-exceptions + errors + exceptions + extended + extra + file-embed + file-embed-lzma + filepath + fsnotify + galley-types + geoip2 + gundeck-types + hashable + HaskellNet + HaskellNet-SSL + HsOpenSSL + HsOpenSSL-x509-system + html-entities + http-client + http-client-openssl + http-media + http-types + imports + insert-ordered-containers + iproute + iso639 + jwt-tools + lens + lens-aeson + metrics-core + metrics-wai + mime + mime-mail + mmorph + MonadRandom + mtl + multihash + mwc-random + network + network-conduit-tls + optparse-applicative + pem + polysemy + polysemy-plugin + polysemy-wire-zoo + proto-lens + random-shuffle + resource-pool + resourcet + retry + ropes + safe + safe-exceptions + saml2-web-sso + schema-profunctor + scientific + scrypt + servant + servant-client + servant-client-core + servant-server + servant-swagger + servant-swagger-ui + sodium-crypto-sign + split + ssl-util + statistics + stomp-queue + string-conversions + swagger + swagger2 + tagged + template + template-haskell + text + text-icu-translit + time + tinylog + transformers + types-common + types-common-aws + types-common-journal + unliftio + unordered-containers + uri-bytestring + uuid + vector + wai + wai-extra + wai-middleware-gunzip + wai-predicates + wai-routing + wai-utilities + warp + wire-api + wire-api-federation + yaml + zauth ]; executableHaskellDepends = [ - aeson async attoparsec base base16-bytestring base64-bytestring - bilge bloodhound brig-types bytestring bytestring-conversion - cargohold-types case-insensitive cassandra-util containers cookie - data-default data-timeout email-validate exceptions extended extra - federator filepath galley-types gundeck-types hscim HsOpenSSL - http-api-data http-client http-client-tls http-media - http-reverse-proxy http-types imports lens lens-aeson metrics-wai - mime MonadRandom mtl network optparse-applicative pem polysemy - polysemy-wire-zoo process proto-lens QuickCheck random - random-shuffle raw-strings-qq retry safe saml2-web-sso servant - servant-client servant-client-core spar string-conversions tasty - tasty-cannon tasty-hunit temporary text time tinylog transformers - types-common types-common-aws types-common-journal unliftio - unordered-containers uri-bytestring uuid vector wai wai-extra - wai-route wai-utilities warp warp-tls wire-api wire-api-federation - yaml zauth + aeson + async + attoparsec + base + base16-bytestring + base64-bytestring + bilge + bloodhound + brig-types + bytestring + bytestring-conversion + cargohold-types + case-insensitive + cassandra-util + containers + cookie + data-default + data-timeout + email-validate + exceptions + extended + extra + federator + filepath + galley-types + gundeck-types + hscim + HsOpenSSL + http-api-data + http-client + http-client-tls + http-media + http-reverse-proxy + http-types + imports + lens + lens-aeson + metrics-wai + mime + MonadRandom + mtl + network + optparse-applicative + pem + polysemy + polysemy-wire-zoo + process + proto-lens + QuickCheck + random + random-shuffle + raw-strings-qq + retry + safe + saml2-web-sso + servant + servant-client + servant-client-core + spar + string-conversions + tasty + tasty-cannon + tasty-hunit + temporary + text + time + tinylog + transformers + types-common + types-common-aws + types-common-journal + unliftio + unordered-containers + uri-bytestring + uuid + vector + wai + wai-extra + wai-route + wai-utilities + warp + warp-tls + wire-api + wire-api-federation + yaml + zauth ]; testHaskellDepends = [ - aeson base binary bloodhound brig-types bytestring containers - data-timeout dns dns-util exceptions HsOpenSSL http-types imports - lens polysemy polysemy-wire-zoo QuickCheck retry - servant-client-core string-conversions tasty tasty-hunit - tasty-quickcheck time tinylog types-common unliftio uri-bytestring - uuid wai-utilities wire-api wire-api-federation + aeson + base + binary + bloodhound + brig-types + bytestring + containers + data-timeout + dns + dns-util + exceptions + HsOpenSSL + http-types + imports + lens + polysemy + polysemy-wire-zoo + QuickCheck + retry + servant-client-core + string-conversions + tasty + tasty-hunit + tasty-quickcheck + time + tinylog + types-common + unliftio + uri-bytestring + uuid + wai-utilities + wire-api + wire-api-federation ]; description = "User Service"; license = lib.licenses.agpl3Only; diff --git a/services/cannon/default.nix b/services/cannon/default.nix index ef0bff58d78..ef66129761f 100644 --- a/services/cannon/default.nix +++ b/services/cannon/default.nix @@ -2,16 +2,58 @@ # 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, api-field-json-th, async, base, bilge -, bytestring, bytestring-conversion, conduit, criterion -, data-default, data-timeout, exceptions, extended, extra -, gitignoreSource, gundeck-types, hashable, http-types, imports -, lens, lens-family-core, lib, metrics-wai, mwc-random, QuickCheck -, random, retry, safe-exceptions, servant, servant-conduit -, servant-server, strict, swagger, tasty, tasty-hunit -, tasty-quickcheck, text, tinylog, types-common, unix, unliftio -, uuid, vector, wai, wai-extra, wai-predicates, wai-utilities -, wai-websockets, warp, websockets, wire-api +{ mkDerivation +, aeson +, api-field-json-th +, async +, base +, bilge +, bytestring +, bytestring-conversion +, conduit +, criterion +, data-default +, data-timeout +, exceptions +, extended +, extra +, gitignoreSource +, gundeck-types +, hashable +, http-types +, imports +, lens +, lens-family-core +, lib +, metrics-wai +, mwc-random +, QuickCheck +, random +, retry +, safe-exceptions +, servant +, servant-conduit +, servant-server +, strict +, swagger +, tasty +, tasty-hunit +, tasty-quickcheck +, text +, tinylog +, types-common +, unix +, unliftio +, uuid +, vector +, wai +, wai-extra +, wai-predicates +, wai-utilities +, wai-websockets +, warp +, websockets +, wire-api }: mkDerivation { pname = "cannon"; @@ -20,24 +62,85 @@ mkDerivation { isLibrary = true; isExecutable = true; libraryHaskellDepends = [ - aeson api-field-json-th async base bilge bytestring - bytestring-conversion conduit data-default data-timeout exceptions - extended extra gundeck-types hashable http-types imports lens - lens-family-core metrics-wai mwc-random retry safe-exceptions - servant servant-conduit servant-server strict swagger text tinylog - types-common unix unliftio uuid vector wai wai-extra wai-predicates - wai-utilities wai-websockets warp websockets wire-api + aeson + api-field-json-th + async + base + bilge + bytestring + bytestring-conversion + conduit + data-default + data-timeout + exceptions + extended + extra + gundeck-types + hashable + http-types + imports + lens + lens-family-core + metrics-wai + mwc-random + retry + safe-exceptions + servant + servant-conduit + servant-server + strict + swagger + text + tinylog + types-common + unix + unliftio + uuid + vector + wai + wai-extra + wai-predicates + wai-utilities + wai-websockets + warp + websockets + wire-api ]; executableHaskellDepends = [ base extended imports types-common ]; testHaskellDepends = [ - async base bytestring criterion extended imports metrics-wai - QuickCheck random tasty tasty-hunit tasty-quickcheck types-common - uuid wai-utilities wire-api + async + base + bytestring + criterion + extended + imports + metrics-wai + QuickCheck + random + tasty + tasty-hunit + tasty-quickcheck + types-common + uuid + wai-utilities + wire-api ]; benchmarkHaskellDepends = [ - async base bytestring criterion extended imports metrics-wai - QuickCheck random tasty tasty-hunit tasty-quickcheck types-common - uuid wai-utilities + async + base + bytestring + criterion + extended + imports + metrics-wai + QuickCheck + random + tasty + tasty-hunit + tasty-quickcheck + types-common + uuid + wai-utilities ]; description = "Push Notification API"; license = lib.licenses.agpl3Only; diff --git a/services/cargohold/default.nix b/services/cargohold/default.nix index 23fc8e986b4..082cf037e3b 100644 --- a/services/cargohold/default.nix +++ b/services/cargohold/default.nix @@ -2,20 +2,74 @@ # 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, amazonka, amazonka-core, amazonka-s3 -, attoparsec, auto-update, base, base64-bytestring, bilge -, bytestring, bytestring-conversion, cargohold-types -, case-insensitive, conduit, conduit-extra, containers, cryptonite -, data-default, errors, exceptions, extended, federator -, gitignoreSource, HsOpenSSL, HsOpenSSL-x509-system, http-api-data -, http-client, http-client-openssl, http-client-tls, http-media -, http-types, imports, kan-extensions, lens, lib, metrics-core -, metrics-wai, mime, mmorph, mtl, optparse-applicative, resourcet -, retry, safe, servant, servant-client, servant-client-core -, servant-server, swagger, tagged, tasty, tasty-hunit, text, time -, tinylog, types-common, types-common-aws, unliftio -, unordered-containers, uri-bytestring, uuid, wai, wai-extra -, wai-utilities, wire-api, wire-api-federation, yaml +{ mkDerivation +, aeson +, amazonka +, amazonka-core +, amazonka-s3 +, attoparsec +, auto-update +, base +, base64-bytestring +, bilge +, bytestring +, bytestring-conversion +, cargohold-types +, case-insensitive +, conduit +, conduit-extra +, containers +, cryptonite +, data-default +, errors +, exceptions +, extended +, federator +, gitignoreSource +, HsOpenSSL +, HsOpenSSL-x509-system +, http-api-data +, http-client +, http-client-openssl +, http-client-tls +, http-media +, http-types +, imports +, kan-extensions +, lens +, lib +, metrics-core +, metrics-wai +, mime +, mmorph +, mtl +, optparse-applicative +, resourcet +, retry +, safe +, servant +, servant-client +, servant-client-core +, servant-server +, swagger +, tagged +, tasty +, tasty-hunit +, text +, time +, tinylog +, types-common +, types-common-aws +, unliftio +, unordered-containers +, uri-bytestring +, uuid +, wai +, wai-extra +, wai-utilities +, wire-api +, wire-api-federation +, yaml }: mkDerivation { pname = "cargohold"; @@ -24,25 +78,105 @@ mkDerivation { isLibrary = true; isExecutable = true; libraryHaskellDepends = [ - aeson amazonka amazonka-core amazonka-s3 attoparsec auto-update - base base64-bytestring bilge bytestring bytestring-conversion - cargohold-types case-insensitive conduit conduit-extra containers - cryptonite data-default errors exceptions extended HsOpenSSL - HsOpenSSL-x509-system http-client http-client-openssl http-types - imports kan-extensions lens metrics-core metrics-wai mime - optparse-applicative resourcet retry safe servant servant-server - swagger text time tinylog types-common types-common-aws unliftio - unordered-containers uri-bytestring uuid wai wai-extra - wai-utilities wire-api wire-api-federation yaml + aeson + amazonka + amazonka-core + amazonka-s3 + attoparsec + auto-update + base + base64-bytestring + bilge + bytestring + bytestring-conversion + cargohold-types + case-insensitive + conduit + conduit-extra + containers + cryptonite + data-default + errors + exceptions + extended + HsOpenSSL + HsOpenSSL-x509-system + http-client + http-client-openssl + http-types + imports + kan-extensions + lens + metrics-core + metrics-wai + mime + optparse-applicative + resourcet + retry + safe + servant + servant-server + swagger + text + time + tinylog + types-common + types-common-aws + unliftio + unordered-containers + uri-bytestring + uuid + wai + wai-extra + wai-utilities + wire-api + wire-api-federation + yaml ]; executableHaskellDepends = [ - aeson base base64-bytestring bilge bytestring bytestring-conversion - cargohold-types conduit containers cryptonite data-default errors - exceptions extended federator HsOpenSSL http-api-data http-client - http-client-tls http-media http-types imports kan-extensions lens - mime mmorph mtl optparse-applicative safe servant-client - servant-client-core tagged tasty tasty-hunit text time types-common - uuid wai wai-utilities wire-api wire-api-federation yaml + aeson + base + base64-bytestring + bilge + bytestring + bytestring-conversion + cargohold-types + conduit + containers + cryptonite + data-default + errors + exceptions + extended + federator + HsOpenSSL + http-api-data + http-client + http-client-tls + http-media + http-types + imports + kan-extensions + lens + mime + mmorph + mtl + optparse-applicative + safe + servant-client + servant-client-core + tagged + tasty + tasty-hunit + text + time + types-common + uuid + wai + wai-utilities + wire-api + wire-api-federation + yaml ]; description = "Asset Storage API"; license = lib.licenses.agpl3Only; diff --git a/services/federator/default.nix b/services/federator/default.nix index 40d51f9e4e7..2704a157dcb 100644 --- a/services/federator/default.nix +++ b/services/federator/default.nix @@ -2,21 +2,83 @@ # 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, async, base, bilge, binary, bytestring -, bytestring-conversion, connection, constraints, containers -, cryptonite, data-default, directory, dns, dns-util, either -, errors, exceptions, extended, filepath, gitignoreSource, hinotify -, hspec, http-client, http-client-openssl, http-client-tls -, http-media, http-types, http2, imports, interpolate -, kan-extensions, lens, lib, metrics-core, metrics-wai, mtl -, network, network-uri, optparse-applicative, pem, polysemy -, polysemy-wire-zoo, QuickCheck, random, retry, servant -, servant-client, servant-client-core, streaming-commons -, string-conversions, tasty, tasty-hunit, tasty-quickcheck -, temporary, text, time-manager, tinylog, tls, transformers -, types-common, unix, uri-bytestring, uuid, wai, wai-extra -, wai-utilities, warp, warp-tls, wire-api, wire-api-federation -, x509, x509-store, x509-system, x509-validation, yaml +{ mkDerivation +, aeson +, async +, base +, bilge +, binary +, bytestring +, bytestring-conversion +, connection +, constraints +, containers +, cryptonite +, data-default +, directory +, dns +, dns-util +, either +, errors +, exceptions +, extended +, filepath +, gitignoreSource +, hinotify +, hspec +, http-client +, http-client-openssl +, http-client-tls +, http-media +, http-types +, http2 +, imports +, interpolate +, kan-extensions +, lens +, lib +, metrics-core +, metrics-wai +, mtl +, network +, network-uri +, optparse-applicative +, pem +, polysemy +, polysemy-wire-zoo +, QuickCheck +, random +, retry +, servant +, servant-client +, servant-client-core +, streaming-commons +, string-conversions +, tasty +, tasty-hunit +, tasty-quickcheck +, temporary +, text +, time-manager +, tinylog +, tls +, transformers +, types-common +, unix +, uri-bytestring +, uuid +, wai +, wai-extra +, wai-utilities +, warp +, warp-tls +, wire-api +, wire-api-federation +, x509 +, x509-store +, x509-system +, x509-validation +, yaml }: mkDerivation { pname = "federator"; @@ -25,44 +87,200 @@ mkDerivation { isLibrary = true; isExecutable = true; libraryHaskellDepends = [ - aeson async base bilge binary bytestring bytestring-conversion - constraints containers data-default dns dns-util either exceptions - extended filepath hinotify http-client http-client-openssl - http-media http-types http2 imports kan-extensions lens - metrics-core metrics-wai mtl network network-uri pem polysemy - polysemy-wire-zoo retry servant servant-client-core - streaming-commons string-conversions text time-manager tinylog tls - types-common unix uri-bytestring uuid wai wai-utilities warp - warp-tls wire-api wire-api-federation x509 x509-store x509-system + aeson + async + base + bilge + binary + bytestring + bytestring-conversion + constraints + containers + data-default + dns + dns-util + either + exceptions + extended + filepath + hinotify + http-client + http-client-openssl + http-media + http-types + http2 + imports + kan-extensions + lens + metrics-core + metrics-wai + mtl + network + network-uri + pem + polysemy + polysemy-wire-zoo + retry + servant + servant-client-core + streaming-commons + string-conversions + text + time-manager + tinylog + tls + types-common + unix + uri-bytestring + uuid + wai + wai-utilities + warp + warp-tls + wire-api + wire-api-federation + x509 + x509-store + x509-system x509-validation ]; executableHaskellDepends = [ - aeson async base bilge binary bytestring bytestring-conversion - connection constraints containers cryptonite data-default dns - dns-util either errors exceptions extended filepath hinotify hspec - http-client http-client-openssl http-client-tls http-media - http-types http2 imports kan-extensions lens metrics-core - metrics-wai mtl network network-uri optparse-applicative pem - polysemy polysemy-wire-zoo QuickCheck random retry servant - servant-client-core streaming-commons string-conversions tasty - tasty-hunit text time-manager tinylog tls types-common unix - uri-bytestring uuid wai wai-utilities warp warp-tls wire-api - wire-api-federation x509 x509-store x509-system x509-validation + aeson + async + base + bilge + binary + bytestring + bytestring-conversion + connection + constraints + containers + cryptonite + data-default + dns + dns-util + either + errors + exceptions + extended + filepath + hinotify + hspec + http-client + http-client-openssl + http-client-tls + http-media + http-types + http2 + imports + kan-extensions + lens + metrics-core + metrics-wai + mtl + network + network-uri + optparse-applicative + pem + polysemy + polysemy-wire-zoo + QuickCheck + random + retry + servant + servant-client-core + streaming-commons + string-conversions + tasty + tasty-hunit + text + time-manager + tinylog + tls + types-common + unix + uri-bytestring + uuid + wai + wai-utilities + warp + warp-tls + wire-api + wire-api-federation + x509 + x509-store + x509-system + x509-validation yaml ]; testHaskellDepends = [ - aeson async base bilge binary bytestring bytestring-conversion - constraints containers data-default directory dns dns-util either - exceptions extended filepath hinotify http-client - http-client-openssl http-media http-types http2 imports interpolate - kan-extensions lens metrics-core metrics-wai mtl network - network-uri pem polysemy polysemy-wire-zoo QuickCheck retry servant - servant-client servant-client-core streaming-commons - string-conversions tasty tasty-hunit tasty-quickcheck temporary - text time-manager tinylog tls transformers types-common unix - uri-bytestring uuid wai wai-extra wai-utilities warp warp-tls - wire-api wire-api-federation x509 x509-store x509-system - x509-validation yaml + aeson + async + base + bilge + binary + bytestring + bytestring-conversion + constraints + containers + data-default + directory + dns + dns-util + either + exceptions + extended + filepath + hinotify + http-client + http-client-openssl + http-media + http-types + http2 + imports + interpolate + kan-extensions + lens + metrics-core + metrics-wai + mtl + network + network-uri + pem + polysemy + polysemy-wire-zoo + QuickCheck + retry + servant + servant-client + servant-client-core + streaming-commons + string-conversions + tasty + tasty-hunit + tasty-quickcheck + temporary + text + time-manager + tinylog + tls + transformers + types-common + unix + uri-bytestring + uuid + wai + wai-extra + wai-utilities + warp + warp-tls + wire-api + wire-api-federation + x509 + x509-store + x509-system + x509-validation + yaml ]; description = "Federation Service"; license = lib.licenses.agpl3Only; diff --git a/services/galley/default.nix b/services/galley/default.nix index 6fecc03f561..cf8abcd2063 100644 --- a/services/galley/default.nix +++ b/services/galley/default.nix @@ -2,32 +2,131 @@ # 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, aeson-qq, amazonka, amazonka-sqs -, asn1-encoding, asn1-types, async, base, base64-bytestring, bilge -, binary, blake2, brig-types, bytestring, bytestring-conversion -, case-insensitive, cassandra-util, cassava, cereal, comonad -, conduit, containers, cookie, cryptonite, currency-codes -, data-default, data-timeout, directory, either -, enclosed-exceptions, errors, exceptions, extended, extra -, federator, filepath, galley-types, gitignoreSource, gundeck-types -, hex, HsOpenSSL, HsOpenSSL-x509-system, hspec, http-client -, http-client-openssl, http-client-tls, http-media, http-types -, imports, insert-ordered-containers, kan-extensions, lens -, lens-aeson, lib, memory, metrics-core, metrics-wai, mtl -, optparse-applicative, pem, polysemy, polysemy-wire-zoo, process -, proto-lens, protobuf, QuickCheck, quickcheck-instances, random -, raw-strings-qq, resourcet, retry, safe, safe-exceptions -, saml2-web-sso, schema-profunctor, semigroups, servant -, servant-client, servant-client-core, servant-server -, servant-swagger, servant-swagger-ui, singletons, sop-core, split -, ssl-util, stm, string-conversions, swagger, swagger2, tagged -, tasty, tasty-cannon, tasty-hspec, tasty-hunit, tasty-quickcheck -, temporary, text, time, tinylog, tls, transformers, types-common -, types-common-aws, types-common-journal, unix, unliftio -, unordered-containers, uri-bytestring, uuid, vector, wai -, wai-extra, wai-middleware-gunzip, wai-predicates, wai-routing -, wai-utilities, warp, warp-tls, wire-api, wire-api-federation -, wire-message-proto-lens, x509, yaml +{ mkDerivation +, aeson +, aeson-qq +, amazonka +, amazonka-sqs +, asn1-encoding +, asn1-types +, async +, base +, base64-bytestring +, bilge +, binary +, blake2 +, brig-types +, bytestring +, bytestring-conversion +, case-insensitive +, cassandra-util +, cassava +, cereal +, comonad +, conduit +, containers +, cookie +, cryptonite +, currency-codes +, data-default +, data-timeout +, directory +, either +, enclosed-exceptions +, errors +, exceptions +, extended +, extra +, federator +, filepath +, galley-types +, gitignoreSource +, gundeck-types +, hex +, HsOpenSSL +, HsOpenSSL-x509-system +, hspec +, http-client +, http-client-openssl +, http-client-tls +, http-media +, http-types +, imports +, insert-ordered-containers +, kan-extensions +, lens +, lens-aeson +, lib +, memory +, metrics-core +, metrics-wai +, mtl +, optparse-applicative +, pem +, polysemy +, polysemy-wire-zoo +, process +, proto-lens +, protobuf +, QuickCheck +, quickcheck-instances +, random +, raw-strings-qq +, resourcet +, retry +, safe +, safe-exceptions +, saml2-web-sso +, schema-profunctor +, semigroups +, servant +, servant-client +, servant-client-core +, servant-server +, servant-swagger +, servant-swagger-ui +, singletons +, sop-core +, split +, ssl-util +, stm +, string-conversions +, swagger +, swagger2 +, tagged +, tasty +, tasty-cannon +, tasty-hspec +, tasty-hunit +, tasty-quickcheck +, temporary +, text +, time +, tinylog +, tls +, transformers +, types-common +, types-common-aws +, types-common-journal +, unix +, unliftio +, unordered-containers +, uri-bytestring +, uuid +, vector +, wai +, wai-extra +, wai-middleware-gunzip +, wai-predicates +, wai-routing +, wai-utilities +, warp +, warp-tls +, wire-api +, wire-api-federation +, wire-message-proto-lens +, x509 +, yaml }: mkDerivation { pname = "galley"; @@ -36,53 +135,237 @@ mkDerivation { isLibrary = true; isExecutable = true; libraryHaskellDepends = [ - aeson amazonka amazonka-sqs asn1-encoding asn1-types async base - base64-bytestring bilge binary blake2 brig-types bytestring - bytestring-conversion case-insensitive cassandra-util cassava - cereal comonad containers cryptonite currency-codes data-default - data-timeout either enclosed-exceptions errors exceptions extended - extra galley-types gundeck-types hex HsOpenSSL - HsOpenSSL-x509-system http-client http-client-openssl - http-client-tls http-media http-types imports - insert-ordered-containers kan-extensions lens memory metrics-core - metrics-wai mtl optparse-applicative pem polysemy polysemy-wire-zoo - proto-lens protobuf QuickCheck random raw-strings-qq resourcet - retry safe safe-exceptions saml2-web-sso schema-profunctor - semigroups servant servant-client servant-client-core - servant-server servant-swagger servant-swagger-ui singletons - sop-core split ssl-util stm string-conversions swagger swagger2 - tagged text time tinylog tls transformers types-common - types-common-aws types-common-journal unliftio unordered-containers - uri-bytestring uuid vector wai wai-extra wai-middleware-gunzip - wai-predicates wai-routing wai-utilities warp wire-api - wire-api-federation x509 + aeson + amazonka + amazonka-sqs + asn1-encoding + asn1-types + async + base + base64-bytestring + bilge + binary + blake2 + brig-types + bytestring + bytestring-conversion + case-insensitive + cassandra-util + cassava + cereal + comonad + containers + cryptonite + currency-codes + data-default + data-timeout + either + enclosed-exceptions + errors + exceptions + extended + extra + galley-types + gundeck-types + hex + HsOpenSSL + HsOpenSSL-x509-system + http-client + http-client-openssl + http-client-tls + http-media + http-types + imports + insert-ordered-containers + kan-extensions + lens + memory + metrics-core + metrics-wai + mtl + optparse-applicative + pem + polysemy + polysemy-wire-zoo + proto-lens + protobuf + QuickCheck + random + raw-strings-qq + resourcet + retry + safe + safe-exceptions + saml2-web-sso + schema-profunctor + semigroups + servant + servant-client + servant-client-core + servant-server + servant-swagger + servant-swagger-ui + singletons + sop-core + split + ssl-util + stm + string-conversions + swagger + swagger2 + tagged + text + time + tinylog + tls + transformers + types-common + types-common-aws + types-common-journal + unliftio + unordered-containers + uri-bytestring + uuid + vector + wai + wai-extra + wai-middleware-gunzip + wai-predicates + wai-routing + wai-utilities + warp + wire-api + wire-api-federation + x509 ]; executableHaskellDepends = [ - aeson aeson-qq amazonka amazonka-sqs async base base64-bytestring - bilge binary brig-types bytestring bytestring-conversion - case-insensitive cassandra-util cassava cereal comonad conduit - containers cookie cryptonite currency-codes data-default - data-timeout directory errors exceptions extended extra federator - filepath galley-types gundeck-types hex HsOpenSSL - HsOpenSSL-x509-system hspec http-client http-client-openssl - http-client-tls http-media http-types imports kan-extensions lens - lens-aeson memory metrics-wai mtl optparse-applicative pem process - proto-lens protobuf QuickCheck quickcheck-instances random - raw-strings-qq retry safe saml2-web-sso schema-profunctor servant - servant-client servant-client-core servant-server servant-swagger - singletons sop-core ssl-util string-conversions tagged tasty - tasty-cannon tasty-hunit temporary text time tinylog tls - transformers types-common types-common-journal unix unliftio - unordered-containers uri-bytestring uuid vector wai wai-extra - wai-utilities warp warp-tls wire-api wire-api-federation - wire-message-proto-lens yaml + aeson + aeson-qq + amazonka + amazonka-sqs + async + base + base64-bytestring + bilge + binary + brig-types + bytestring + bytestring-conversion + case-insensitive + cassandra-util + cassava + cereal + comonad + conduit + containers + cookie + cryptonite + currency-codes + data-default + data-timeout + directory + errors + exceptions + extended + extra + federator + filepath + galley-types + gundeck-types + hex + HsOpenSSL + HsOpenSSL-x509-system + hspec + http-client + http-client-openssl + http-client-tls + http-media + http-types + imports + kan-extensions + lens + lens-aeson + memory + metrics-wai + mtl + optparse-applicative + pem + process + proto-lens + protobuf + QuickCheck + quickcheck-instances + random + raw-strings-qq + retry + safe + saml2-web-sso + schema-profunctor + servant + servant-client + servant-client-core + servant-server + servant-swagger + singletons + sop-core + ssl-util + string-conversions + tagged + tasty + tasty-cannon + tasty-hunit + temporary + text + time + tinylog + tls + transformers + types-common + types-common-journal + unix + unliftio + unordered-containers + uri-bytestring + uuid + vector + wai + wai-extra + wai-utilities + warp + warp-tls + wire-api + wire-api-federation + wire-message-proto-lens + yaml ]; testHaskellDepends = [ - base case-insensitive containers extended extra galley-types - http-types imports lens QuickCheck raw-strings-qq safe - saml2-web-sso servant-client servant-swagger ssl-util tagged tasty - tasty-hspec tasty-hunit tasty-quickcheck transformers types-common - wai wai-predicates wire-api wire-api-federation + base + case-insensitive + containers + extended + extra + galley-types + http-types + imports + lens + QuickCheck + raw-strings-qq + safe + saml2-web-sso + servant-client + servant-swagger + ssl-util + tagged + tasty + tasty-hspec + tasty-hunit + tasty-quickcheck + transformers + types-common + wai + wai-predicates + wire-api + wire-api-federation ]; description = "Conversations"; license = lib.licenses.agpl3Only; diff --git a/services/gundeck/default.nix b/services/gundeck/default.nix index 6b191b50270..3b4c5dc779b 100644 --- a/services/gundeck/default.nix +++ b/services/gundeck/default.nix @@ -2,24 +2,93 @@ # 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, aeson-pretty, amazonka, amazonka-sns -, amazonka-sqs, async, attoparsec, auto-update, base -, base16-bytestring, bilge, bytestring, bytestring-conversion -, cassandra-util, containers, criterion, data-default, errors -, exceptions, extended, extra, gitignoreSource, gundeck-types -, hedis, HsOpenSSL, http-client, http-client-tls, http-types -, imports, kan-extensions, lens, lens-aeson, lib, metrics-core -, metrics-wai, MonadRandom, mtl, multiset, network, network-uri -, optparse-applicative, psqueues, QuickCheck, quickcheck-instances -, quickcheck-state-machine, random, raw-strings-qq, resourcet -, retry, safe, safe-exceptions, scientific, servant, servant-server -, servant-swagger, servant-swagger-ui, streaming-commons -, string-conversions, swagger, swagger2, tagged, tasty, tasty-hunit -, tasty-quickcheck, text, time, tinylog, tls, tree-diff -, types-common, types-common-aws, unix, unliftio -, unordered-containers, uuid, wai, wai-extra, wai-middleware-gunzip -, wai-predicates, wai-routing, wai-utilities, warp, warp-tls -, websockets, wire-api, yaml +{ mkDerivation +, aeson +, aeson-pretty +, amazonka +, amazonka-sns +, amazonka-sqs +, async +, attoparsec +, auto-update +, base +, base16-bytestring +, bilge +, bytestring +, bytestring-conversion +, cassandra-util +, containers +, criterion +, data-default +, errors +, exceptions +, extended +, extra +, gitignoreSource +, gundeck-types +, hedis +, HsOpenSSL +, http-client +, http-client-tls +, http-types +, imports +, kan-extensions +, lens +, lens-aeson +, lib +, metrics-core +, metrics-wai +, MonadRandom +, mtl +, multiset +, network +, network-uri +, optparse-applicative +, psqueues +, QuickCheck +, quickcheck-instances +, quickcheck-state-machine +, random +, raw-strings-qq +, resourcet +, retry +, safe +, safe-exceptions +, scientific +, servant +, servant-server +, servant-swagger +, servant-swagger-ui +, streaming-commons +, string-conversions +, swagger +, swagger2 +, tagged +, tasty +, tasty-hunit +, tasty-quickcheck +, text +, time +, tinylog +, tls +, tree-diff +, types-common +, types-common-aws +, unix +, unliftio +, unordered-containers +, uuid +, wai +, wai-extra +, wai-middleware-gunzip +, wai-predicates +, wai-routing +, wai-utilities +, warp +, warp-tls +, websockets +, wire-api +, yaml }: mkDerivation { pname = "gundeck"; @@ -28,41 +97,169 @@ mkDerivation { isLibrary = true; isExecutable = true; libraryHaskellDepends = [ - aeson amazonka amazonka-sns amazonka-sqs async attoparsec - auto-update base bilge bytestring bytestring-conversion - cassandra-util containers data-default errors exceptions extended - extra gundeck-types hedis HsOpenSSL http-client http-client-tls - http-types imports lens lens-aeson metrics-core metrics-wai mtl - network network-uri optparse-applicative psqueues resourcet retry - safe-exceptions servant servant-server servant-swagger - servant-swagger-ui swagger swagger2 text time tinylog tls - types-common types-common-aws unliftio unordered-containers uuid - wai wai-extra wai-middleware-gunzip wai-predicates wai-routing - wai-utilities wire-api yaml + aeson + amazonka + amazonka-sns + amazonka-sqs + async + attoparsec + auto-update + base + bilge + bytestring + bytestring-conversion + cassandra-util + containers + data-default + errors + exceptions + extended + extra + gundeck-types + hedis + HsOpenSSL + http-client + http-client-tls + http-types + imports + lens + lens-aeson + metrics-core + metrics-wai + mtl + network + network-uri + optparse-applicative + psqueues + resourcet + retry + safe-exceptions + servant + servant-server + servant-swagger + servant-swagger-ui + swagger + swagger2 + text + time + tinylog + tls + types-common + types-common-aws + unliftio + unordered-containers + uuid + wai + wai-extra + wai-middleware-gunzip + wai-predicates + wai-routing + wai-utilities + wire-api + yaml ]; executableHaskellDepends = [ - aeson async base base16-bytestring bilge bytestring - bytestring-conversion cassandra-util containers exceptions extended - gundeck-types HsOpenSSL http-client http-client-tls imports - kan-extensions lens lens-aeson metrics-wai mtl network network-uri - optparse-applicative random raw-strings-qq retry safe - streaming-commons tagged tasty tasty-hunit text time tinylog - types-common unix unordered-containers uuid wai wai-utilities warp - warp-tls websockets wire-api yaml + aeson + async + base + base16-bytestring + bilge + bytestring + bytestring-conversion + cassandra-util + containers + exceptions + extended + gundeck-types + HsOpenSSL + http-client + http-client-tls + imports + kan-extensions + lens + lens-aeson + metrics-wai + mtl + network + network-uri + optparse-applicative + random + raw-strings-qq + retry + safe + streaming-commons + tagged + tasty + tasty-hunit + text + time + tinylog + types-common + unix + unordered-containers + uuid + wai + wai-utilities + warp + warp-tls + websockets + wire-api + yaml ]; testHaskellDepends = [ - aeson aeson-pretty amazonka async base bytestring containers - exceptions extended gundeck-types HsOpenSSL imports lens - metrics-wai MonadRandom mtl multiset network-uri QuickCheck - quickcheck-instances quickcheck-state-machine scientific - string-conversions tasty tasty-hunit tasty-quickcheck text time - tinylog tree-diff types-common unordered-containers uuid - wai-utilities wire-api + aeson + aeson-pretty + amazonka + async + base + bytestring + containers + exceptions + extended + gundeck-types + HsOpenSSL + imports + lens + metrics-wai + MonadRandom + mtl + multiset + network-uri + QuickCheck + quickcheck-instances + quickcheck-state-machine + scientific + string-conversions + tasty + tasty-hunit + tasty-quickcheck + text + time + tinylog + tree-diff + types-common + unordered-containers + uuid + wai-utilities + wire-api ]; benchmarkHaskellDepends = [ - aeson amazonka base bytestring criterion extended gundeck-types - HsOpenSSL imports lens random text time types-common - unordered-containers uuid + aeson + amazonka + base + bytestring + criterion + extended + gundeck-types + HsOpenSSL + imports + lens + random + text + time + types-common + unordered-containers + uuid ]; description = "Push Notification Hub"; license = lib.licenses.agpl3Only; diff --git a/services/proxy/default.nix b/services/proxy/default.nix index 384a1f55ac2..62dc40a368b 100644 --- a/services/proxy/default.nix +++ b/services/proxy/default.nix @@ -2,12 +2,36 @@ # 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, bilge, bytestring, case-insensitive -, configurator, data-default, exceptions, extended, gitignoreSource -, http-client, http-client-tls, http-reverse-proxy, http-types -, imports, lens, lib, metrics-wai, retry, text, tinylog -, types-common, unliftio-core, wai, wai-predicates, wai-routing -, wai-utilities, warp, wire-api +{ mkDerivation +, aeson +, base +, bilge +, bytestring +, case-insensitive +, configurator +, data-default +, exceptions +, extended +, gitignoreSource +, http-client +, http-client-tls +, http-reverse-proxy +, http-types +, imports +, lens +, lib +, metrics-wai +, retry +, text +, tinylog +, types-common +, unliftio-core +, wai +, wai-predicates +, wai-routing +, wai-utilities +, warp +, wire-api }: mkDerivation { pname = "proxy"; @@ -16,11 +40,33 @@ mkDerivation { isLibrary = true; isExecutable = true; libraryHaskellDepends = [ - aeson base bilge bytestring case-insensitive configurator - data-default exceptions extended http-client http-client-tls - http-reverse-proxy http-types imports lens metrics-wai retry text - tinylog types-common unliftio-core wai wai-predicates wai-routing - wai-utilities warp wire-api + aeson + base + bilge + bytestring + case-insensitive + configurator + data-default + exceptions + extended + http-client + http-client-tls + http-reverse-proxy + http-types + imports + lens + metrics-wai + retry + text + tinylog + types-common + unliftio-core + wai + wai-predicates + wai-routing + wai-utilities + warp + wire-api ]; executableHaskellDepends = [ base extended imports types-common ]; license = lib.licenses.agpl3Only; diff --git a/services/spar/default.nix b/services/spar/default.nix index 0ee7dabd9ce..02afd551c09 100644 --- a/services/spar/default.nix +++ b/services/spar/default.nix @@ -2,23 +2,88 @@ # 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, aeson-qq, attoparsec, base -, base64-bytestring, bilge, binary, brig-types, bytestring -, bytestring-conversion, case-insensitive, cassandra-util, cassava -, conduit, containers, cookie, cryptonite, data-default -, email-validate, exceptions, extended, galley-types, ghc-prim -, gitignoreSource, hscim, HsOpenSSL, hspec, hspec-discover -, hspec-wai, http-api-data, http-client, http-media, http-types -, imports, insert-ordered-containers, iso639, lens, lens-aeson, lib -, memory, metrics-wai, MonadRandom, mtl, network-uri -, optparse-applicative, polysemy, polysemy-check, polysemy-plugin -, polysemy-wire-zoo, QuickCheck, random, raw-strings-qq, retry -, saml2-web-sso, servant, servant-multipart, servant-server -, servant-swagger, silently, string-conversions, swagger2 -, tasty-hunit, text, text-latin1, time, tinylog, transformers -, types-common, unordered-containers, uri-bytestring, uuid, vector -, wai, wai-extra, wai-utilities, warp, wire-api, x509, xml-conduit -, yaml, zauth +{ mkDerivation +, aeson +, aeson-qq +, attoparsec +, base +, base64-bytestring +, bilge +, binary +, brig-types +, bytestring +, bytestring-conversion +, case-insensitive +, cassandra-util +, cassava +, conduit +, containers +, cookie +, cryptonite +, data-default +, email-validate +, exceptions +, extended +, galley-types +, ghc-prim +, gitignoreSource +, hscim +, HsOpenSSL +, hspec +, hspec-discover +, hspec-wai +, http-api-data +, http-client +, http-media +, http-types +, imports +, insert-ordered-containers +, iso639 +, lens +, lens-aeson +, lib +, memory +, metrics-wai +, MonadRandom +, mtl +, network-uri +, optparse-applicative +, polysemy +, polysemy-check +, polysemy-plugin +, polysemy-wire-zoo +, QuickCheck +, random +, raw-strings-qq +, retry +, saml2-web-sso +, servant +, servant-multipart +, servant-server +, servant-swagger +, silently +, string-conversions +, swagger2 +, tasty-hunit +, text +, text-latin1 +, time +, tinylog +, transformers +, types-common +, unordered-containers +, uri-bytestring +, uuid +, vector +, wai +, wai-extra +, wai-utilities +, warp +, wire-api +, x509 +, xml-conduit +, yaml +, zauth }: mkDerivation { pname = "spar"; @@ -27,51 +92,222 @@ mkDerivation { isLibrary = true; isExecutable = true; libraryHaskellDepends = [ - aeson aeson-qq attoparsec base base64-bytestring bilge binary - brig-types bytestring bytestring-conversion case-insensitive - cassandra-util containers cookie cryptonite data-default - email-validate exceptions extended galley-types ghc-prim hscim - HsOpenSSL hspec http-api-data http-client http-media http-types - imports insert-ordered-containers lens memory metrics-wai mtl - network-uri optparse-applicative polysemy polysemy-check - polysemy-plugin polysemy-wire-zoo QuickCheck raw-strings-qq retry - saml2-web-sso servant servant-multipart servant-server - servant-swagger string-conversions swagger2 text text-latin1 time - tinylog transformers types-common unordered-containers - uri-bytestring uuid wai wai-utilities warp wire-api x509 - xml-conduit yaml + aeson + aeson-qq + attoparsec + base + base64-bytestring + bilge + binary + brig-types + bytestring + bytestring-conversion + case-insensitive + cassandra-util + containers + cookie + cryptonite + data-default + email-validate + exceptions + extended + galley-types + ghc-prim + hscim + HsOpenSSL + hspec + http-api-data + http-client + http-media + http-types + imports + insert-ordered-containers + lens + memory + metrics-wai + mtl + network-uri + optparse-applicative + polysemy + polysemy-check + polysemy-plugin + polysemy-wire-zoo + QuickCheck + raw-strings-qq + retry + saml2-web-sso + servant + servant-multipart + servant-server + servant-swagger + string-conversions + swagger2 + text + text-latin1 + time + tinylog + transformers + types-common + unordered-containers + uri-bytestring + uuid + wai + wai-utilities + warp + wire-api + x509 + xml-conduit + yaml ]; executableHaskellDepends = [ - aeson aeson-qq attoparsec base base64-bytestring bilge binary - brig-types bytestring bytestring-conversion case-insensitive - cassandra-util cassava conduit containers cookie cryptonite - data-default email-validate exceptions extended galley-types - ghc-prim hscim HsOpenSSL hspec hspec-wai http-api-data http-client - http-media http-types imports insert-ordered-containers iso639 lens - lens-aeson memory metrics-wai MonadRandom mtl network-uri - optparse-applicative polysemy polysemy-check polysemy-plugin - polysemy-wire-zoo QuickCheck random raw-strings-qq retry - saml2-web-sso servant servant-multipart servant-server - servant-swagger silently string-conversions swagger2 tasty-hunit - text text-latin1 time tinylog transformers types-common - unordered-containers uri-bytestring uuid vector wai wai-extra - wai-utilities warp wire-api x509 xml-conduit yaml zauth + aeson + aeson-qq + attoparsec + base + base64-bytestring + bilge + binary + brig-types + bytestring + bytestring-conversion + case-insensitive + cassandra-util + cassava + conduit + containers + cookie + cryptonite + data-default + email-validate + exceptions + extended + galley-types + ghc-prim + hscim + HsOpenSSL + hspec + hspec-wai + http-api-data + http-client + http-media + http-types + imports + insert-ordered-containers + iso639 + lens + lens-aeson + memory + metrics-wai + MonadRandom + mtl + network-uri + optparse-applicative + polysemy + polysemy-check + polysemy-plugin + polysemy-wire-zoo + QuickCheck + random + raw-strings-qq + retry + saml2-web-sso + servant + servant-multipart + servant-server + servant-swagger + silently + string-conversions + swagger2 + tasty-hunit + text + text-latin1 + time + tinylog + transformers + types-common + unordered-containers + uri-bytestring + uuid + vector + wai + wai-extra + wai-utilities + warp + wire-api + x509 + xml-conduit + yaml + zauth ]; executableToolDepends = [ hspec-discover ]; testHaskellDepends = [ - aeson aeson-qq attoparsec base base64-bytestring bilge binary - brig-types bytestring bytestring-conversion case-insensitive - cassandra-util containers cookie cryptonite data-default - email-validate exceptions extended galley-types ghc-prim hscim - HsOpenSSL hspec http-api-data http-client http-media http-types - imports insert-ordered-containers lens lens-aeson memory - metrics-wai mtl network-uri optparse-applicative polysemy - polysemy-check polysemy-plugin polysemy-wire-zoo QuickCheck - raw-strings-qq retry saml2-web-sso servant servant-multipart - servant-server servant-swagger string-conversions swagger2 text - text-latin1 time tinylog transformers types-common - unordered-containers uri-bytestring uuid wai wai-utilities warp - wire-api x509 xml-conduit yaml + aeson + aeson-qq + attoparsec + base + base64-bytestring + bilge + binary + brig-types + bytestring + bytestring-conversion + case-insensitive + cassandra-util + containers + cookie + cryptonite + data-default + email-validate + exceptions + extended + galley-types + ghc-prim + hscim + HsOpenSSL + hspec + http-api-data + http-client + http-media + http-types + imports + insert-ordered-containers + lens + lens-aeson + memory + metrics-wai + mtl + network-uri + optparse-applicative + polysemy + polysemy-check + polysemy-plugin + polysemy-wire-zoo + QuickCheck + raw-strings-qq + retry + saml2-web-sso + servant + servant-multipart + servant-server + servant-swagger + string-conversions + swagger2 + text + text-latin1 + time + tinylog + transformers + types-common + unordered-containers + uri-bytestring + uuid + wai + wai-utilities + warp + wire-api + x509 + xml-conduit + yaml ]; testToolDepends = [ hspec-discover ]; description = "User Service for SSO (Single Sign-On) provisioning and authentication"; diff --git a/tools/api-simulations/default.nix b/tools/api-simulations/default.nix index f0e6856898d..dfbc638256f 100644 --- a/tools/api-simulations/default.nix +++ b/tools/api-simulations/default.nix @@ -2,11 +2,31 @@ # 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, api-bot, api-client, base, bytestring -, bytestring-conversion, cereal, containers, exceptions, extended -, gitignoreSource, http-client, http-client-tls, imports, lens, lib -, metrics-core, mime, mwc-random, optparse-applicative, text -, tinylog, types-common, unliftio, uuid +{ mkDerivation +, api-bot +, api-client +, base +, bytestring +, bytestring-conversion +, cereal +, containers +, exceptions +, extended +, gitignoreSource +, http-client +, http-client-tls +, imports +, lens +, lib +, metrics-core +, mime +, mwc-random +, optparse-applicative +, text +, tinylog +, types-common +, unliftio +, uuid }: mkDerivation { pname = "api-simulations"; @@ -15,14 +35,41 @@ mkDerivation { isLibrary = true; isExecutable = true; libraryHaskellDepends = [ - api-bot api-client base bytestring bytestring-conversion cereal - containers exceptions imports lens text types-common + api-bot + api-client + base + bytestring + bytestring-conversion + cereal + containers + exceptions + imports + lens + text + types-common ]; executableHaskellDepends = [ - api-bot api-client base bytestring bytestring-conversion containers - exceptions extended http-client http-client-tls imports lens - metrics-core mime mwc-random optparse-applicative text tinylog - types-common unliftio uuid + api-bot + api-client + base + bytestring + bytestring-conversion + containers + exceptions + extended + http-client + http-client-tls + imports + lens + metrics-core + mime + mwc-random + optparse-applicative + text + tinylog + types-common + unliftio + uuid ]; description = "(Internal) Wire API simulations"; license = lib.licenses.agpl3Only; diff --git a/tools/db/assets/default.nix b/tools/db/assets/default.nix index 56dc211e063..babe61ec77b 100644 --- a/tools/db/assets/default.nix +++ b/tools/db/assets/default.nix @@ -2,12 +2,36 @@ # 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, attoparsec, base, brig, brig-types -, bytestring, bytestring-conversion, cassandra-util, conduit -, containers, filepath, galley, gitignoreSource, imports, iproute -, lens, lib, megaparsec, optparse-applicative, process -, raw-strings-qq, stache, text, time, tinylog, types-common, uuid -, vector, wire-api +{ mkDerivation +, aeson +, attoparsec +, base +, brig +, brig-types +, bytestring +, bytestring-conversion +, cassandra-util +, conduit +, containers +, filepath +, galley +, gitignoreSource +, imports +, iproute +, lens +, lib +, megaparsec +, optparse-applicative +, process +, raw-strings-qq +, stache +, text +, time +, tinylog +, types-common +, uuid +, vector +, wire-api }: mkDerivation { pname = "assets"; @@ -16,10 +40,32 @@ mkDerivation { isLibrary = true; isExecutable = true; libraryHaskellDepends = [ - aeson attoparsec base brig brig-types bytestring - bytestring-conversion cassandra-util conduit containers filepath - galley imports iproute lens megaparsec optparse-applicative process - raw-strings-qq stache text time tinylog types-common uuid vector + aeson + attoparsec + base + brig + brig-types + bytestring + bytestring-conversion + cassandra-util + conduit + containers + filepath + galley + imports + iproute + lens + megaparsec + optparse-applicative + process + raw-strings-qq + stache + text + time + tinylog + types-common + uuid + vector wire-api ]; executableHaskellDepends = [ base ]; diff --git a/tools/db/auto-whitelist/default.nix b/tools/db/auto-whitelist/default.nix index c1fa2858384..d749f584c97 100644 --- a/tools/db/auto-whitelist/default.nix +++ b/tools/db/auto-whitelist/default.nix @@ -2,9 +2,19 @@ # 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, base, cassandra-util, extra, gitignoreSource -, imports, lens, lib, optparse-applicative, tinylog, types-common -, unliftio, wire-api +{ mkDerivation +, base +, cassandra-util +, extra +, gitignoreSource +, imports +, lens +, lib +, optparse-applicative +, tinylog +, types-common +, unliftio +, wire-api }: mkDerivation { pname = "auto-whitelist"; @@ -13,8 +23,16 @@ mkDerivation { isLibrary = false; isExecutable = true; executableHaskellDepends = [ - base cassandra-util extra imports lens optparse-applicative tinylog - types-common unliftio wire-api + base + cassandra-util + extra + imports + lens + optparse-applicative + tinylog + types-common + unliftio + wire-api ]; description = "Backfill service tables"; license = lib.licenses.agpl3Only; diff --git a/tools/db/billing-team-member-backfill/default.nix b/tools/db/billing-team-member-backfill/default.nix index 4c298b9a951..18f60f04e76 100644 --- a/tools/db/billing-team-member-backfill/default.nix +++ b/tools/db/billing-team-member-backfill/default.nix @@ -2,9 +2,20 @@ # 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, base, cassandra-util, conduit, containers -, gitignoreSource, imports, lens, lib, optparse-applicative, text -, tinylog, types-common, wire-api +{ mkDerivation +, base +, cassandra-util +, conduit +, containers +, gitignoreSource +, imports +, lens +, lib +, optparse-applicative +, text +, tinylog +, types-common +, wire-api }: mkDerivation { pname = "billing-team-member-backfill"; @@ -13,8 +24,17 @@ mkDerivation { isLibrary = false; isExecutable = true; executableHaskellDepends = [ - base cassandra-util conduit containers imports lens - optparse-applicative text tinylog types-common wire-api + base + cassandra-util + conduit + containers + imports + lens + optparse-applicative + text + tinylog + types-common + wire-api ]; description = "Backfill billing_team_member table"; license = lib.licenses.agpl3Only; diff --git a/tools/db/find-undead/default.nix b/tools/db/find-undead/default.nix index a058990e4d7..510aeb134c3 100644 --- a/tools/db/find-undead/default.nix +++ b/tools/db/find-undead/default.nix @@ -2,9 +2,23 @@ # 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, bloodhound, brig-types, cassandra-util -, conduit, containers, gitignoreSource, http-client, imports, lens -, lib, optparse-applicative, text, tinylog, uuid +{ mkDerivation +, aeson +, base +, bloodhound +, brig-types +, cassandra-util +, conduit +, containers +, gitignoreSource +, http-client +, imports +, lens +, lib +, optparse-applicative +, text +, tinylog +, uuid }: mkDerivation { pname = "find-undead"; @@ -13,8 +27,20 @@ mkDerivation { isLibrary = false; isExecutable = true; executableHaskellDepends = [ - aeson base bloodhound brig-types cassandra-util conduit containers - http-client imports lens optparse-applicative text tinylog uuid + aeson + base + bloodhound + brig-types + cassandra-util + conduit + containers + http-client + imports + lens + optparse-applicative + text + tinylog + uuid ]; description = "Backfill billing_team_member table"; license = lib.licenses.agpl3Only; diff --git a/tools/db/migrate-sso-feature-flag/default.nix b/tools/db/migrate-sso-feature-flag/default.nix index 8bc035482ea..21223ca74e3 100644 --- a/tools/db/migrate-sso-feature-flag/default.nix +++ b/tools/db/migrate-sso-feature-flag/default.nix @@ -2,9 +2,21 @@ # 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, base, brig-types, cassandra-util, conduit, galley -, gitignoreSource, imports, lens, lib, optparse-applicative -, tinylog, types-common, unliftio, wire-api +{ mkDerivation +, base +, brig-types +, cassandra-util +, conduit +, galley +, gitignoreSource +, imports +, lens +, lib +, optparse-applicative +, tinylog +, types-common +, unliftio +, wire-api }: mkDerivation { pname = "migrate-sso-feature-flag"; @@ -13,8 +25,18 @@ mkDerivation { isLibrary = false; isExecutable = true; executableHaskellDepends = [ - base brig-types cassandra-util conduit galley imports lens - optparse-applicative tinylog types-common unliftio wire-api + base + brig-types + cassandra-util + conduit + galley + imports + lens + optparse-applicative + tinylog + types-common + unliftio + wire-api ]; description = "Backfill sso feature flag into teams that already have an IdP"; license = lib.licenses.agpl3Only; diff --git a/tools/db/move-team/default.nix b/tools/db/move-team/default.nix index 61ac6561f0b..a13200cc81e 100644 --- a/tools/db/move-team/default.nix +++ b/tools/db/move-team/default.nix @@ -2,11 +2,33 @@ # 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, brig-types, bytestring, cassandra-util -, conduit, containers, filepath, galley, gitignoreSource, imports -, iproute, lens, lib, megaparsec, optparse-applicative, process -, raw-strings-qq, stache, text, time, tinylog, types-common, uuid -, vector, wire-api +{ mkDerivation +, aeson +, base +, brig-types +, bytestring +, cassandra-util +, conduit +, containers +, filepath +, galley +, gitignoreSource +, imports +, iproute +, lens +, lib +, megaparsec +, optparse-applicative +, process +, raw-strings-qq +, stache +, text +, time +, tinylog +, types-common +, uuid +, vector +, wire-api }: mkDerivation { pname = "move-team"; @@ -15,16 +37,56 @@ mkDerivation { isLibrary = true; isExecutable = true; libraryHaskellDepends = [ - aeson base brig-types bytestring cassandra-util conduit containers - filepath galley imports iproute lens megaparsec - optparse-applicative process raw-strings-qq stache text time - tinylog types-common uuid vector wire-api + aeson + base + brig-types + bytestring + cassandra-util + conduit + containers + filepath + galley + imports + iproute + lens + megaparsec + optparse-applicative + process + raw-strings-qq + stache + text + time + tinylog + types-common + uuid + vector + wire-api ]; executableHaskellDepends = [ - aeson base brig-types bytestring cassandra-util conduit containers - filepath galley imports iproute lens megaparsec - optparse-applicative process raw-strings-qq stache text time - tinylog types-common uuid vector wire-api + aeson + base + brig-types + bytestring + cassandra-util + conduit + containers + filepath + galley + imports + iproute + lens + megaparsec + optparse-applicative + process + raw-strings-qq + stache + text + time + tinylog + types-common + uuid + vector + wire-api ]; description = "Export a team from one backend, or import it into another"; license = lib.licenses.agpl3Only; diff --git a/tools/db/repair-handles/default.nix b/tools/db/repair-handles/default.nix index 5c89be4ad94..ca0294873e8 100644 --- a/tools/db/repair-handles/default.nix +++ b/tools/db/repair-handles/default.nix @@ -2,9 +2,23 @@ # 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, base, brig, cassandra-util, conduit, containers -, gitignoreSource, imports, lens, lib, mtl, optparse-applicative -, string-conversions, text, tinylog, types-common, uuid +{ mkDerivation +, base +, brig +, cassandra-util +, conduit +, containers +, gitignoreSource +, imports +, lens +, lib +, mtl +, optparse-applicative +, string-conversions +, text +, tinylog +, types-common +, uuid }: mkDerivation { pname = "repair-handles"; @@ -13,8 +27,19 @@ mkDerivation { isLibrary = false; isExecutable = true; executableHaskellDepends = [ - base brig cassandra-util conduit containers imports lens mtl - optparse-applicative string-conversions text tinylog types-common + base + brig + cassandra-util + conduit + containers + imports + lens + mtl + optparse-applicative + string-conversions + text + tinylog + types-common uuid ]; description = "Repair inconsistencies between tables user and user_handle"; diff --git a/tools/db/service-backfill/default.nix b/tools/db/service-backfill/default.nix index 44a13363d23..c778afe2db0 100644 --- a/tools/db/service-backfill/default.nix +++ b/tools/db/service-backfill/default.nix @@ -2,9 +2,19 @@ # 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, base, cassandra-util, conduit, gitignoreSource -, imports, lens, lib, optparse-applicative, tinylog, types-common -, unliftio, wire-api +{ mkDerivation +, base +, cassandra-util +, conduit +, gitignoreSource +, imports +, lens +, lib +, optparse-applicative +, tinylog +, types-common +, unliftio +, wire-api }: mkDerivation { pname = "service-backfill"; @@ -13,8 +23,16 @@ mkDerivation { isLibrary = false; isExecutable = true; executableHaskellDepends = [ - base cassandra-util conduit imports lens optparse-applicative - tinylog types-common unliftio wire-api + base + cassandra-util + conduit + imports + lens + optparse-applicative + tinylog + types-common + unliftio + wire-api ]; description = "Backfill service tables"; license = lib.licenses.agpl3Only; diff --git a/tools/rex/default.nix b/tools/rex/default.nix index 240f1220f1f..02d05d765d4 100644 --- a/tools/rex/default.nix +++ b/tools/rex/default.nix @@ -2,10 +2,27 @@ # 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, async, attoparsec, base, bytestring, clock, dns -, exceptions, gitignoreSource, http-types, iproute, lib, mtl -, network, optparse-applicative, prometheus, text, tinylog -, unordered-containers, wai, warp +{ mkDerivation +, async +, attoparsec +, base +, bytestring +, clock +, dns +, exceptions +, gitignoreSource +, http-types +, iproute +, lib +, mtl +, network +, optparse-applicative +, prometheus +, text +, tinylog +, unordered-containers +, wai +, warp }: mkDerivation { pname = "rex"; @@ -14,9 +31,24 @@ mkDerivation { isLibrary = false; isExecutable = true; executableHaskellDepends = [ - async attoparsec base bytestring clock dns exceptions http-types - iproute mtl network optparse-applicative prometheus text tinylog - unordered-containers wai warp + async + attoparsec + base + bytestring + clock + dns + exceptions + http-types + iproute + mtl + network + optparse-applicative + prometheus + text + tinylog + unordered-containers + wai + warp ]; description = "Scrape and expose restund metrics for prometheus"; license = lib.licenses.agpl3Only; diff --git a/tools/stern/default.nix b/tools/stern/default.nix index 175db25335a..6eb54f2aa52 100644 --- a/tools/stern/default.nix +++ b/tools/stern/default.nix @@ -2,15 +2,52 @@ # 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, bilge, brig-types, bytestring -, bytestring-conversion, containers, data-default, errors -, exceptions, extended, galley-types, gitignoreSource -, gundeck-types, http-client, http-types, imports, lens, lib -, metrics-wai, mtl, schema-profunctor, servant, servant-server -, servant-swagger, servant-swagger-ui, split, string-conversions -, swagger, swagger2, text, tinylog, transformers, types-common -, unliftio, unordered-containers, uuid, wai, wai-extra -, wai-predicates, wai-routing, wai-utilities, warp, wire-api, yaml +{ mkDerivation +, aeson +, base +, bilge +, brig-types +, bytestring +, bytestring-conversion +, containers +, data-default +, errors +, exceptions +, extended +, galley-types +, gitignoreSource +, gundeck-types +, http-client +, http-types +, imports +, lens +, lib +, metrics-wai +, mtl +, schema-profunctor +, servant +, servant-server +, servant-swagger +, servant-swagger-ui +, split +, string-conversions +, swagger +, swagger2 +, text +, tinylog +, transformers +, types-common +, unliftio +, unordered-containers +, uuid +, wai +, wai-extra +, wai-predicates +, wai-routing +, wai-utilities +, warp +, wire-api +, yaml }: mkDerivation { pname = "stern"; @@ -19,17 +56,56 @@ mkDerivation { isLibrary = true; isExecutable = true; libraryHaskellDepends = [ - aeson base bilge brig-types bytestring bytestring-conversion - containers data-default errors exceptions extended galley-types - gundeck-types http-client http-types imports lens metrics-wai mtl - schema-profunctor servant servant-server servant-swagger - servant-swagger-ui split string-conversions swagger swagger2 text - tinylog transformers types-common unliftio unordered-containers - uuid wai wai-extra wai-predicates wai-routing wai-utilities warp - wire-api yaml + aeson + base + bilge + brig-types + bytestring + bytestring-conversion + containers + data-default + errors + exceptions + extended + galley-types + gundeck-types + http-client + http-types + imports + lens + metrics-wai + mtl + schema-profunctor + servant + servant-server + servant-swagger + servant-swagger-ui + split + string-conversions + swagger + swagger2 + text + tinylog + transformers + types-common + unliftio + unordered-containers + uuid + wai + wai-extra + wai-predicates + wai-routing + wai-utilities + warp + wire-api + yaml ]; executableHaskellDepends = [ - base extended imports types-common unliftio + base + extended + imports + types-common + unliftio ]; license = lib.licenses.agpl3Only; mainProgram = "stern"; From 35d6376bafffa0cce8249c0456cfea7488179640 Mon Sep 17 00:00:00 2001 From: Florian Klink Date: Tue, 8 Nov 2022 15:58:05 +0000 Subject: [PATCH 21/76] nix/wire-server.nix: nixpkgs-fmt --- nix/wire-server.nix | 494 +++++++++++++++++++++++--------------------- 1 file changed, 256 insertions(+), 238 deletions(-) diff --git a/nix/wire-server.nix b/nix/wire-server.nix index 6639fddbe9c..194c90fff84 100644 --- a/nix/wire-server.nix +++ b/nix/wire-server.nix @@ -43,173 +43,189 @@ # 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: -let lib = pkgs.lib; - hlib = pkgs.haskell.lib; - withCleanedPath = drv: - hlib.overrideCabal drv (old: { - src = lib.cleanSourceWith { - src = old.src; - filter = path: type: - let baseName = baseNameOf (toString path); - in baseName != "dist"; - }; - }); +let + lib = pkgs.lib; + hlib = pkgs.haskell.lib; + withCleanedPath = drv: + hlib.overrideCabal drv (old: { + src = lib.cleanSourceWith { + src = old.src; + filter = path: type: + let baseName = baseNameOf (toString path); + in baseName != "dist"; + }; + }); - gitignoreSource = - let gitignoreSrc = pkgs.fetchFromGitHub { - owner = "hercules-ci"; - repo = "gitignore.nix"; - # put the latest commit sha of gitignore Nix library here: - rev = "a20de23b925fd8264fd7fad6454652e142fd7f73"; - # use what nix suggests in the mismatch message here: - sha256 = "sha256:07vg2i9va38zbld9abs9lzqblz193vc5wvqd6h7amkmwf66ljcgh"; - }; - in (import gitignoreSrc { inherit (pkgs) lib; }).gitignoreSource; + gitignoreSource = + let + gitignoreSrc = pkgs.fetchFromGitHub { + owner = "hercules-ci"; + repo = "gitignore.nix"; + # put the latest commit sha of gitignore Nix library here: + rev = "a20de23b925fd8264fd7fad6454652e142fd7f73"; + # use what nix suggests in the mismatch message here: + sha256 = "sha256:07vg2i9va38zbld9abs9lzqblz193vc5wvqd6h7amkmwf66ljcgh"; + }; + in + (import gitignoreSrc { inherit (pkgs) lib; }).gitignoreSource; - # Mapping from package -> [executable] - executablesMap = { - brig = ["brig" "brig-index" "brig-integration" "brig-schema"]; - cannon = ["cannon"]; - cargohold = ["cargohold" "cargohold-integration"]; - federator = ["federator" "federator-integration"]; - galley = ["galley" "galley-integration" "galley-schema" "galley-migrate-data"]; - gundeck = ["gundeck" "gundeck-integration" "gundeck-schema"]; - proxy = ["proxy"]; - spar = ["spar" "spar-integration" "spar-schema" "spar-migrate-data"]; - stern = ["stern"]; + # Mapping from package -> [executable] + executablesMap = { + brig = [ "brig" "brig-index" "brig-integration" "brig-schema" ]; + cannon = [ "cannon" ]; + cargohold = [ "cargohold" "cargohold-integration" ]; + federator = [ "federator" "federator-integration" ]; + galley = [ "galley" "galley-integration" "galley-schema" "galley-migrate-data" ]; + gundeck = [ "gundeck" "gundeck-integration" "gundeck-schema" ]; + proxy = [ "proxy" ]; + spar = [ "spar" "spar-integration" "spar-schema" "spar-migrate-data" ]; + stern = [ "stern" ]; - billing-team-member-backfill = ["billing-team-member-backfill"]; - api-simulations = ["api-smoketest" "api-loadtest"]; - zauth = ["zauth"]; - }; + billing-team-member-backfill = [ "billing-team-member-backfill" ]; + api-simulations = [ "api-smoketest" "api-loadtest" ]; + zauth = [ "zauth" ]; + }; - attrsets = lib.attrsets; + attrsets = lib.attrsets; - pinnedPackages = import ./haskell-pins.nix { - fetchgit = pkgs.fetchgit; - inherit lib; - }; + pinnedPackages = import ./haskell-pins.nix { + fetchgit = pkgs.fetchgit; + inherit lib; + }; - localPackages = {enableOptimization, enableDocs, enableTests}: hsuper: hself: - # The default packages are expected to have optimizations and docs turned - # on. - let defaultPkgs = import ./local-haskell-packages.nix { - inherit gitignoreSource; - } hsuper hself; + localPackages = { enableOptimization, enableDocs, enableTests }: hsuper: hself: + # The default packages are expected to have optimizations and docs turned + # on. + let + defaultPkgs = import ./local-haskell-packages.nix + { + inherit gitignoreSource; + } + hsuper + hself; - werror = _: hlib.failOnAllWarnings; - opt = _: drv: - if enableOptimization - then drv - else - # We need to explicitly add `-O0` because all the cabal files - # explicitly have `-O2` in them - hlib.appendConfigureFlag (hlib.disableOptimization drv) "--ghc-option=-O0"; - tests = _: drv: - if enableTests - then drv - else hlib.dontCheck drv; - docs = _: drv: if enableDocs - then drv - else hlib.dontHaddock drv; + werror = _: hlib.failOnAllWarnings; + opt = _: drv: + if enableOptimization + then drv + else + # We need to explicitly add `-O0` because all the cabal files + # explicitly have `-O2` in them + hlib.appendConfigureFlag (hlib.disableOptimization drv) "--ghc-option=-O0"; + tests = _: drv: + if enableTests + then drv + else hlib.dontCheck drv; + docs = _: drv: + if enableDocs + then drv + else hlib.dontHaddock drv; - overrideAll = fn: overrides: - attrsets.mapAttrs fn (overrides); - in lib.lists.foldr overrideAll defaultPkgs [ - werror - opt - docs - tests - ]; - manualOverrides = import ./manual-overrides.nix (with pkgs; { - inherit hlib libsodium protobuf mls-test-cli; - }); + overrideAll = fn: overrides: + attrsets.mapAttrs fn (overrides); + in + lib.lists.foldr overrideAll defaultPkgs [ + werror + opt + docs + tests + ]; + manualOverrides = import ./manual-overrides.nix (with pkgs; { + inherit hlib libsodium protobuf mls-test-cli; + }); - executables = hself: hsuper: - attrsets.genAttrs (builtins.attrNames executablesMap) (e: withCleanedPath hsuper.${e}); + executables = hself: hsuper: + attrsets.genAttrs (builtins.attrNames executablesMap) (e: withCleanedPath hsuper.${e}); - staticExecutables = hself: hsuper: - attrsets.mapAttrs' (name: _: + staticExecutables = hself: hsuper: + attrsets.mapAttrs' + (name: _: attrsets.nameValuePair "${name}-static" (hlib.justStaticExecutables hsuper."${name}") - ) executablesMap; + ) + executablesMap; - hPkgs = localMods@{enableOptimization, enableDocs, enableTests}: pkgs.haskell.packages.ghc8107.override{ - overrides = lib.composeManyExtensions [ - pinnedPackages - (localPackages localMods) - manualOverrides - executables - staticExecutables - ]; + hPkgs = localMods@{ enableOptimization, enableDocs, enableTests }: pkgs.haskell.packages.ghc8107.override { + overrides = lib.composeManyExtensions [ + pinnedPackages + (localPackages localMods) + manualOverrides + executables + staticExecutables + ]; + }; + + extractExec = localMods@{ enableOptimization, enableDocs, enableTests }: hPkgName: execName: + pkgs.stdenv.mkDerivation { + name = execName; + buildInputs = [ (hPkgs localMods)."${hPkgName}-static" ]; + phases = "installPhase"; + installPhase = '' + mkdir -p $out/bin + cp "${(hPkgs localMods)."${hPkgName}-static"}/bin/${execName}" "$out/bin/${execName}" + ''; }; - extractExec = localMods@{enableOptimization, enableDocs, enableTests}: hPkgName: execName: - pkgs.stdenv.mkDerivation { - name = execName; - buildInputs = [(hPkgs localMods)."${hPkgName}-static"]; - phases = "installPhase"; - installPhase = '' - mkdir -p $out/bin - cp "${(hPkgs localMods)."${hPkgName}-static"}/bin/${execName}" "$out/bin/${execName}" - ''; - }; + # We extract static executables out of the output of building the packages + # so they don't depend on all the haskell dependencies. These exectuables + # are "static" from the perspective of ghc, i.e. they don't dynamically + # depend on other haskell packages but they still dynamically depend on C + # dependencies like openssl, cryptobox, libxml2, etc. Doing this makes the + # final images that we generate much smaller as we don't have to carry + # around so files for all haskell packages. + staticExecs = localMods@{ enableOptimization, enableDocs, enableTests }: + let + nested = attrsets.mapAttrs + (hPkgName: execNames: + attrsets.genAttrs execNames (extractExec localMods hPkgName) + ) + executablesMap; + unnested = lib.lists.foldr (x: y: x // y) { } (attrsets.attrValues nested); + in + unnested; - # We extract static executables out of the output of building the packages - # so they don't depend on all the haskell dependencies. These exectuables - # are "static" from the perspective of ghc, i.e. they don't dynamically - # depend on other haskell packages but they still dynamically depend on C - # dependencies like openssl, cryptobox, libxml2, etc. Doing this makes the - # final images that we generate much smaller as we don't have to carry - # around so files for all haskell packages. - staticExecs = localMods@{enableOptimization, enableDocs, enableTests}: - let nested = attrsets.mapAttrs (hPkgName: execNames: - attrsets.genAttrs execNames (extractExec localMods hPkgName) - ) executablesMap; - unnested = lib.lists.foldr (x: y: x // y) {} (attrsets.attrValues nested); - in unnested; + # Docker tools doesn't create tmp directories but some processes need this + # and so we have to create it ourself. + tmpDir = pkgs.runCommand "tmp-dir" { } '' + mkdir -p $out/tmp + mkdir -p $out/var/tmp + ''; - # Docker tools doesn't create tmp directories but some processes need this - # and so we have to create it ourself. - tmpDir = pkgs.runCommand "tmp-dir" {} '' - mkdir -p $out/tmp - mkdir -p $out/var/tmp + brig-templates = pkgs.stdenvNoCC.mkDerivation { + name = "brig-templates"; + src = ../services/brig/deb/opt/brig/templates; + installPhase = '' + mkdir -p $out/usr/share/wire + cp -r $src $out/usr/share/wire/templates ''; + }; - brig-templates = pkgs.stdenvNoCC.mkDerivation { - name = "brig-templates"; - src = ../services/brig/deb/opt/brig/templates; - installPhase = '' - mkdir -p $out/usr/share/wire - cp -r $src $out/usr/share/wire/templates - ''; - }; - - # Some images require extra things which is not possible to specify using - # cabal file dependencies, so cabal2nix cannot automatically add these. - # - # extraContents :: Map Text [Derivation] - extraContents = { - brig = [brig-templates]; - brig-integration = [brig-templates pkgs.mls-test-cli]; - galley-integration= [pkgs.mls-test-cli]; - }; + # Some images require extra things which is not possible to specify using + # cabal file dependencies, so cabal2nix cannot automatically add these. + # + # extraContents :: Map Text [Derivation] + extraContents = { + brig = [ brig-templates ]; + brig-integration = [ brig-templates pkgs.mls-test-cli ]; + galley-integration = [ pkgs.mls-test-cli ]; + }; - # useful to poke around a container during a 'kubectl exec' - debugUtils = with pkgs; [ - bashInteractive - gnugrep - coreutils - dig - curl - less - gnutar - gzip - openssl - which - ]; + # useful to poke around a container during a 'kubectl exec' + debugUtils = with pkgs; [ + bashInteractive + gnugrep + coreutils + dig + curl + less + gnutar + gzip + openssl + which + ]; - images = localMods@{enableOptimization, enableDocs, enableTests}: - attrsets.mapAttrs (execName: drv: + images = localMods@{ enableOptimization, enableDocs, enableTests }: + attrsets.mapAttrs + (execName: drv: pkgs.dockerTools.streamLayeredImage { name = "quay.io/wire/${execName}"; maxLayers = 10; @@ -223,110 +239,112 @@ let lib = pkgs.lib; # Any mkdir running in this step won't actually make it to the image, # hence we use the tmpDir derivation in the contents fakeRootCommands = '' - chmod 1777 tmp - chmod 1777 var/tmp - ''; + chmod 1777 tmp + chmod 1777 var/tmp + ''; config = { - Entrypoint = ["${pkgs.dumb-init}/bin/dumb-init" "--" "${drv}/bin/${execName}"]; - Env = ["SSL_CERT_FILE=/etc/ssl/certs/ca-bundle.crt"]; + Entrypoint = [ "${pkgs.dumb-init}/bin/dumb-init" "--" "${drv}/bin/${execName}" ]; + Env = [ "SSL_CERT_FILE=/etc/ssl/certs/ca-bundle.crt" ]; }; } - ) (staticExecs localMods); + ) + (staticExecs localMods); - localModsEnableAll = { - enableOptimization = true; - enableDocs = true; - enableTests = true; - }; - localModsOnlyTests = { - enableOptimization = false; - enableDocs = false; - enableTests = true; - }; - localModsOnlyDocs = { - enableOptimization = false; - enableDocs = true; - enableTests = false; - }; + localModsEnableAll = { + enableOptimization = true; + enableDocs = true; + enableTests = true; + }; + localModsOnlyTests = { + enableOptimization = false; + enableDocs = false; + enableTests = true; + }; + localModsOnlyDocs = { + enableOptimization = false; + enableDocs = true; + enableTests = false; + }; - imagesList = pkgs.writeTextFile { - name = "imagesList"; - text = "${lib.concatStringsSep "\n" (builtins.attrNames (images localModsEnableAll))}"; - }; - wireServerPackages = (builtins.attrNames (localPackages localModsEnableAll {} {})); + imagesList = pkgs.writeTextFile { + name = "imagesList"; + text = "${lib.concatStringsSep "\n" (builtins.attrNames (images localModsEnableAll))}"; + }; + wireServerPackages = (builtins.attrNames (localPackages localModsEnableAll { } { })); - hoogle = (hPkgs localModsOnlyDocs).hoogleWithPackages (p: builtins.map (e: p.${e}) wireServerPackages); + hoogle = (hPkgs localModsOnlyDocs).hoogleWithPackages (p: builtins.map (e: p.${e}) wireServerPackages); - # More about dockerTools.streamLayeredImage: - # https://nixos.org/manual/nixpkgs/unstable/#ssec-pkgs-dockerTools-streamLayeredImage - hoogleImage = pkgs.dockerTools.streamLayeredImage { - name = "quay.io/wire/wire-server-hoogle"; - maxLayers = 50; - contents = [ - pkgs.cacert - pkgs.coreutils - pkgs.bashInteractive - pkgs.dumb-init - hoogle - ]; - config = { - Entrypoint = ["${pkgs.dumb-init}/bin/dumb-init" "--" "${hoogle}/bin/hoogle" "server" "--local" "--host=*"]; - Env = ["SSL_CERT_FILE=/etc/ssl/certs/ca-bundle.crt"]; - }; + # More about dockerTools.streamLayeredImage: + # https://nixos.org/manual/nixpkgs/unstable/#ssec-pkgs-dockerTools-streamLayeredImage + hoogleImage = pkgs.dockerTools.streamLayeredImage { + name = "quay.io/wire/wire-server-hoogle"; + maxLayers = 50; + contents = [ + pkgs.cacert + pkgs.coreutils + pkgs.bashInteractive + pkgs.dumb-init + hoogle + ]; + config = { + Entrypoint = [ "${pkgs.dumb-init}/bin/dumb-init" "--" "${hoogle}/bin/hoogle" "server" "--local" "--host=*" ]; + Env = [ "SSL_CERT_FILE=/etc/ssl/certs/ca-bundle.crt" ]; }; + }; - # Tools common between CI and developers - commonTools = [ - pkgs.cabal2nix - pkgs.gnumake - pkgs.gnused - pkgs.helm - pkgs.helmfile - pkgs.hlint - pkgs.jq - pkgs.kubectl - pkgs.nixpkgs-fmt - pkgs.ormolu - pkgs.shellcheck - pkgs.treefmt - (hlib.justStaticExecutables pkgs.haskellPackages.cabal-fmt) - ] ++ pkgs.lib.optionals pkgs.stdenv.isLinux [ - pkgs.skopeo - ]; + # Tools common between CI and developers + commonTools = [ + pkgs.cabal2nix + pkgs.gnumake + pkgs.gnused + pkgs.helm + pkgs.helmfile + pkgs.hlint + pkgs.jq + pkgs.kubectl + pkgs.nixpkgs-fmt + pkgs.ormolu + pkgs.shellcheck + pkgs.treefmt + (hlib.justStaticExecutables pkgs.haskellPackages.cabal-fmt) + ] ++ pkgs.lib.optionals pkgs.stdenv.isLinux [ + pkgs.skopeo + ]; - # Building an image which can do nix builds is hard. This is programmed - # nicely in docker.nix at the root of https://github.com/nixos/nix. We get - # this file using "${pkgs.nix.src}/docker.nix" so we don't have to also pin - # the nix repository along with the nixpkgs repository. - ciImage = import "${pkgs.nix.src}/docker.nix" { - inherit pkgs; - name = "quay.io/wire/wire-server-ci"; - maxLayers = 2; - # We don't need to push the "latest" tag, every step in CI should depend - # deterministically on a specific image. - tag = null; - bundleNixpkgs = false; - extraPkgs = commonTools ++ [pkgs.cachix]; - nixConf = { - experimental-features = "nix-command"; - }; + # Building an image which can do nix builds is hard. This is programmed + # nicely in docker.nix at the root of https://github.com/nixos/nix. We get + # this file using "${pkgs.nix.src}/docker.nix" so we don't have to also pin + # the nix repository along with the nixpkgs repository. + ciImage = import "${pkgs.nix.src}/docker.nix" { + inherit pkgs; + name = "quay.io/wire/wire-server-ci"; + maxLayers = 2; + # We don't need to push the "latest" tag, every step in CI should depend + # deterministically on a specific image. + tag = null; + bundleNixpkgs = false; + extraPkgs = commonTools ++ [ pkgs.cachix ]; + nixConf = { + experimental-features = "nix-command"; }; + }; - shell = (hPkgs localModsOnlyTests).shellFor { - packages = p: builtins.map (e: p.${e}) wireServerPackages; - }; - ghcWithPackages = shell.nativeBuildInputs ++ shell.buildInputs; + shell = (hPkgs localModsOnlyTests).shellFor { + packages = p: builtins.map (e: p.${e}) wireServerPackages; + }; + ghcWithPackages = shell.nativeBuildInputs ++ shell.buildInputs; - profileEnv = pkgs.writeTextFile { - name = "profile-env"; - destination = "/.profile"; - # This gets sourced by direnv. Set NIX_PATH, so `nix-shell` uses the same nixpkgs as here. - text = '' - export NIX_PATH=nixpkgs=${toString pkgs.path} - export LOCALE_ARCHIVE=${pkgs.glibcLocales}/lib/locale/locale-archive - ''; - }; -in { + profileEnv = pkgs.writeTextFile { + name = "profile-env"; + destination = "/.profile"; + # This gets sourced by direnv. Set NIX_PATH, so `nix-shell` uses the same nixpkgs as here. + text = '' + export NIX_PATH=nixpkgs=${toString pkgs.path} + export LOCALE_ARCHIVE=${pkgs.glibcLocales}/lib/locale/locale-archive + ''; + }; +in +{ inherit ciImage hoogleImage; images = images localModsEnableAll; From adaea3da2abecb530823bdc621ce9f4a3f9d3ddc Mon Sep 17 00:00:00 2001 From: Florian Klink Date: Tue, 8 Nov 2022 11:38:48 +0000 Subject: [PATCH 22/76] nix/haskell-pins: nixpkgs-fmt --- nix/haskell-pins.nix | 66 ++++++++++++++++++++++++++++---------------- 1 file changed, 42 insertions(+), 24 deletions(-) diff --git a/nix/haskell-pins.nix b/nix/haskell-pins.nix index 43ad8c1fc9e..87875e4e3ac 100644 --- a/nix/haskell-pins.nix +++ b/nix/haskell-pins.nix @@ -54,7 +54,7 @@ # 1. Update version number. # 2. Make the 'sha256' blank string. # 3. Run step 3. from how to add a git pin. -{lib, fetchgit}: hself: hsuper: +{ lib, fetchgit }: hself: hsuper: let gitPins = { HaskellNet-SSL = { @@ -70,7 +70,7 @@ let rev = "2e3282e5fb27ba8d989c271a0a989823fad7ec43"; sha256 = "0vfzysn9sgpxymfvpahxrp74fczgjnw3kgknj6zk0473qk85488f"; }; - packages = { + packages = { wai-middleware-prometheus = "wai-middleware-prometheus"; }; }; @@ -89,7 +89,8 @@ let }; packages = { x509-store = "x509-store"; - };}; + }; + }; amazonka = { src = fetchgit { url = "https://github.com/wireapp/amazonka"; @@ -107,7 +108,8 @@ let amazonka-sqs = "lib/services/amazonka-sqs"; amazonka-sso = "lib/services/amazonka-sso"; amazonka-sts = "lib/services/amazonka-sts"; - };}; + }; + }; bloodhound = { src = fetchgit { url = "https://github.com/wireapp/bloodhound"; @@ -154,7 +156,8 @@ let http-client-openssl = "http-client-openssl"; http-client-tls = "http-client-tls"; http-conduit = "http-conduit"; - };}; + }; + }; http2 = { src = fetchgit { url = "https://github.com/wireapp/http2"; @@ -229,24 +232,39 @@ let }; # Name -> Source -> Maybe Subpath -> Drv mkGitDrv = name: src: subpath: - let subpathArg = if subpath == null - then "" - else "--subpath='${subpath}'"; - in hself.callCabal2nixWithOptions name src "${subpathArg}" {}; + let + subpathArg = + if subpath == null + then "" + else "--subpath='${subpath}'"; + in + hself.callCabal2nixWithOptions name src "${subpathArg}" { }; # [[AtrrSet]] - gitPackages = lib.attrsets.mapAttrsToList (name: pin: - let packages = if pin?packages - then pin.packages - else { "${name}" = null;}; - in lib.attrsets.mapAttrsToList (name: subpath: - {"${name}" = mkGitDrv name pin.src subpath;} - ) packages - ) gitPins; + gitPackages = lib.attrsets.mapAttrsToList + (name: pin: + let + packages = + if pin?packages + then pin.packages + else { "${name}" = null; }; + in + lib.attrsets.mapAttrsToList + (name: subpath: + { "${name}" = mkGitDrv name pin.src subpath; } + ) + packages + ) + gitPins; # AttrSet - hackagePackages = lib.attrsets.mapAttrs (pkg: {version, sha256}: - hself.callHackageDirect { - ver = version; - inherit pkg sha256; - } {} - ) hackagePins; -in lib.lists.foldr (a: b: a // b) hackagePackages (lib.lists.flatten gitPackages) + hackagePackages = lib.attrsets.mapAttrs + (pkg: { version, sha256 }: + hself.callHackageDirect + { + ver = version; + inherit pkg sha256; + } + { } + ) + hackagePins; +in +lib.lists.foldr (a: b: a // b) hackagePackages (lib.lists.flatten gitPackages) From 8841e3ad4cc5ced1074fadbb13f1f9f82f00db8c Mon Sep 17 00:00:00 2001 From: Florian Klink Date: Tue, 8 Nov 2022 11:39:56 +0000 Subject: [PATCH 23/76] nix/pkgs/python-docs: nixpkgs-fmt --- nix/pkgs/python-docs/sphinx-multiversion.nix | 11 +++++------ nix/pkgs/python-docs/sphinx_reredirects.nix | 11 +++++------ nix/pkgs/python-docs/sphinxcontrib-kroki.nix | 15 +++++++-------- nix/pkgs/python-docs/svg2rlg.nix | 10 ++++------ 4 files changed, 21 insertions(+), 26 deletions(-) diff --git a/nix/pkgs/python-docs/sphinx-multiversion.nix b/nix/pkgs/python-docs/sphinx-multiversion.nix index ef09691cb34..2b97e1ef912 100644 --- a/nix/pkgs/python-docs/sphinx-multiversion.nix +++ b/nix/pkgs/python-docs/sphinx-multiversion.nix @@ -1,9 +1,8 @@ -{ - buildPythonApplication, - buildPythonPackage, - fetchPypi, - - sphinx, +{ buildPythonApplication +, buildPythonPackage +, fetchPypi +, sphinx +, }: buildPythonPackage rec { pname = "sphinx-multiversion"; diff --git a/nix/pkgs/python-docs/sphinx_reredirects.nix b/nix/pkgs/python-docs/sphinx_reredirects.nix index 2985a9d7755..1bff3180551 100644 --- a/nix/pkgs/python-docs/sphinx_reredirects.nix +++ b/nix/pkgs/python-docs/sphinx_reredirects.nix @@ -1,9 +1,8 @@ -{ - fetchPypi, - buildPythonPackage, - - sphinx, -} : +{ fetchPypi +, buildPythonPackage +, sphinx +, +}: buildPythonPackage rec { pname = "sphinx_reredirects"; diff --git a/nix/pkgs/python-docs/sphinxcontrib-kroki.nix b/nix/pkgs/python-docs/sphinxcontrib-kroki.nix index 5cfa07c3653..f65a43a1352 100644 --- a/nix/pkgs/python-docs/sphinxcontrib-kroki.nix +++ b/nix/pkgs/python-docs/sphinxcontrib-kroki.nix @@ -1,11 +1,10 @@ -{ - fetchPypi, - buildPythonPackage, - - sphinx, - requests, - pyyaml, -} : +{ fetchPypi +, buildPythonPackage +, sphinx +, requests +, pyyaml +, +}: buildPythonPackage rec { pname = "sphinxcontrib-kroki"; diff --git a/nix/pkgs/python-docs/svg2rlg.nix b/nix/pkgs/python-docs/svg2rlg.nix index 7d7fd4a6962..d154f215952 100644 --- a/nix/pkgs/python-docs/svg2rlg.nix +++ b/nix/pkgs/python-docs/svg2rlg.nix @@ -1,8 +1,6 @@ -{ - buildPythonPackage, - fetchPypi, - - reportlab +{ buildPythonPackage +, fetchPypi +, reportlab }: buildPythonPackage rec { pname = "svg2rlg"; @@ -12,6 +10,6 @@ buildPythonPackage rec { sha256 = "sha256-BdtEgLkOkS4Icn1MskOF/jPoQ23vB5uPFJtho1Bji+4="; }; - buildInputs = [reportlab]; + buildInputs = [ reportlab ]; doCheck = false; } From c478e09f65666404f42a489cf03f219b975a3e64 Mon Sep 17 00:00:00 2001 From: Florian Klink Date: Tue, 8 Nov 2022 11:40:56 +0000 Subject: [PATCH 24/76] treefmt.toml: exclude nix/sources.nix This file is managed by niv --- treefmt.toml | 1 + 1 file changed, 1 insertion(+) diff --git a/treefmt.toml b/treefmt.toml index 3bca4a2ccf9..b98c61e968e 100644 --- a/treefmt.toml +++ b/treefmt.toml @@ -2,4 +2,5 @@ command = "nixpkgs-fmt" includes = ["*.nix"] excludes = [ + "nix/sources.nix" # managed by niv. ] From 089c3553e5ad26361137f0c5f1bdc954a8eb5c2e Mon Sep 17 00:00:00 2001 From: Florian Klink Date: Tue, 8 Nov 2022 11:41:25 +0000 Subject: [PATCH 25/76] services/galley/schema: nixpkgs-fmt --- services/galley/schema/default.nix | 18 +++++++++++++++--- 1 file changed, 15 insertions(+), 3 deletions(-) diff --git a/services/galley/schema/default.nix b/services/galley/schema/default.nix index d8003a87ba1..b4d117ecf8b 100644 --- a/services/galley/schema/default.nix +++ b/services/galley/schema/default.nix @@ -1,5 +1,12 @@ -{ mkDerivation, base, filepath, imports, lib, optparse-applicative -, shelly, system-filepath, text +{ mkDerivation +, base +, filepath +, imports +, lib +, optparse-applicative +, shelly +, system-filepath +, text }: mkDerivation { pname = "makedeb"; @@ -8,7 +15,12 @@ mkDerivation { isLibrary = true; isExecutable = true; libraryHaskellDepends = [ - base filepath imports optparse-applicative shelly system-filepath + base + filepath + imports + optparse-applicative + shelly + system-filepath text ]; executableHaskellDepends = [ base imports optparse-applicative ]; From bc8929ec9a54e80e974c868afd2864bff3289b26 Mon Sep 17 00:00:00 2001 From: Florian Klink Date: Tue, 8 Nov 2022 11:41:43 +0000 Subject: [PATCH 26/76] services/spar/test-scim-suite: nixpkgs-fmt --- services/spar/test-scim-suite/shell.nix | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/services/spar/test-scim-suite/shell.nix b/services/spar/test-scim-suite/shell.nix index 9a74950e8bd..3ebec7b33ee 100644 --- a/services/spar/test-scim-suite/shell.nix +++ b/services/spar/test-scim-suite/shell.nix @@ -1,5 +1,5 @@ { pkgs ? (import ../../../nix).pkgs }: with pkgs; mkShell { - buildInputs = [newman jq coreutils curl]; + buildInputs = [ newman jq coreutils curl ]; } From da9a7d952bbbce97e7587243af63638ec5d425fc Mon Sep 17 00:00:00 2001 From: Florian Klink Date: Tue, 8 Nov 2022 11:48:33 +0000 Subject: [PATCH 27/76] gh actions: run treefmt --- .github/workflows/ci.yml | 19 +++++++++++++++++++ 1 file changed, 19 insertions(+) diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml index 2c0b6fda775..9c8d153024c 100644 --- a/.github/workflows/ci.yml +++ b/.github/workflows/ci.yml @@ -4,6 +4,25 @@ on: branches: [master, develop] jobs: + treefmt: + name: Run treefmt + environment: cachix # for secrets + runs-on: ubuntu-latest + steps: + - uses: actions/checkout@v2 + with: + submodules: true + - uses: cachix/install-nix-action@v14.1 + - uses: cachix/cachix-action@v10 + with: + name: wire-server + signingKey: '${{ secrets.CACHIX_SIGNING_KEY }}' + authToken: '${{ secrets.CACHIX_AUTH_TOKEN }}' + - name: Install treefmt and nixpkgs-fmt (without pulling in all of dev-env) + run: nix-env -if nix/default.nix -iA pkgs.treefmt pkgs.nixpkgs-fmt + - name: Run treefmt + run: treefmt + build-docs: name: Build docs environment: cachix From 5c3f35a8ea1c6bdfd1ebf523080d9fe4c725f249 Mon Sep 17 00:00:00 2001 From: Florian Klink Date: Tue, 8 Nov 2022 11:51:22 +0000 Subject: [PATCH 28/76] changelog.d: add treefmt --- changelog.d/5-internal/treefmt | 1 + 1 file changed, 1 insertion(+) create mode 100644 changelog.d/5-internal/treefmt diff --git a/changelog.d/5-internal/treefmt b/changelog.d/5-internal/treefmt new file mode 100644 index 00000000000..4d8267d9883 --- /dev/null +++ b/changelog.d/5-internal/treefmt @@ -0,0 +1 @@ +Use treefmt to ensure consistent formatting of .nix files (#2831) From 85ff0d3e3bfbc97e941c49d707005a758c3d54a8 Mon Sep 17 00:00:00 2001 From: Florian Klink Date: Tue, 8 Nov 2022 11:57:51 +0000 Subject: [PATCH 29/76] treefmt: add shellcheck That list was taken from hack/bin/shellcheck.sh --- .github/workflows/ci.yml | 2 +- treefmt.toml | 43 ++++++++++++++++++++++++++++++++++++++++ 2 files changed, 44 insertions(+), 1 deletion(-) diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml index 9c8d153024c..e1b40c398db 100644 --- a/.github/workflows/ci.yml +++ b/.github/workflows/ci.yml @@ -19,7 +19,7 @@ jobs: signingKey: '${{ secrets.CACHIX_SIGNING_KEY }}' authToken: '${{ secrets.CACHIX_AUTH_TOKEN }}' - name: Install treefmt and nixpkgs-fmt (without pulling in all of dev-env) - run: nix-env -if nix/default.nix -iA pkgs.treefmt pkgs.nixpkgs-fmt + run: nix-env -if nix/default.nix -iA pkgs.treefmt pkgs.nixpkgs-fmt pkgs.shellcheck - name: Run treefmt run: treefmt diff --git a/treefmt.toml b/treefmt.toml index b98c61e968e..2984c8f027a 100644 --- a/treefmt.toml +++ b/treefmt.toml @@ -4,3 +4,46 @@ includes = ["*.nix"] excludes = [ "nix/sources.nix" # managed by niv. ] + +[formatter.shellcheck] +command = "shellcheck" +includes = ["*.sh"] +excludes = [ + "dist-newstyle/", + "services/nginz/third_party/", + "libs/wire-api/test/golden/gentests.sh", + "changelog.d/mk-changelog.sh", + "hack/bin/integration-teardown.sh", + "hack/bin/diff-failure.sh", + "hack/bin/integration-setup.sh", + "hack/bin/cabal-run-tests.sh", + "hack/bin/integration-teardown-federation.sh", + "hack/bin/integration-setup-federation.sh", + "hack/bin/serve-charts.sh", + "hack/bin/cabal-install-artefacts.sh", + "hack/bin/helm-template.sh", + "hack/bin/set-chart-image-version.sh", + "hack/bin/copy-charts.sh", + "hack/bin/set-helm-chart-version.sh", + "hack/bin/integration-spring-cleaning.sh", + "hack/bin/upload-helm-charts-s3.sh", + "hack/bin/integration-test-logs.sh", + "services/nginz/nginz_reload.sh", + "services/spar/test-scim-suite/mk_collection.sh", + "services/spar/test-scim-suite/runsuite.sh", + "services/spar/test-scim-suite/run.sh", + "services/brig/federation-tests.sh", + "services/integration.sh", + "hack/bin/create_test_team_members.sh", + "hack/bin/create_test_team_scim.sh", + "hack/bin/create_test_user.sh", + "hack/bin/create_team_members.sh", + "hack/bin/register_idp_internal.sh", + "hack/bin/create_test_team_admins.sh", + "deploy/dockerephemeral/init.sh", + "tools/nginz_disco/nginz_disco.sh", + "tools/rebase-onto-formatter.sh", + "tools/sftd_disco/sftd_disco.sh", + "tools/ormolu.sh", + "tools/db/move-team/dump_merge_teams.sh" +] From af8bad23879ec492aa65f5c84feb96b146594d18 Mon Sep 17 00:00:00 2001 From: Florian Klink Date: Tue, 8 Nov 2022 12:00:59 +0000 Subject: [PATCH 30/76] treefmt.toml: exclude third_party nginx modules --- treefmt.toml | 2 ++ 1 file changed, 2 insertions(+) diff --git a/treefmt.toml b/treefmt.toml index 2984c8f027a..53c01bf871a 100644 --- a/treefmt.toml +++ b/treefmt.toml @@ -34,6 +34,8 @@ excludes = [ "services/spar/test-scim-suite/run.sh", "services/brig/federation-tests.sh", "services/integration.sh", + "services/nginz/third_party/nginx-module-vts/*", + "services/nginz/third_party/headers-more-nginx-module/*", "hack/bin/create_test_team_members.sh", "hack/bin/create_test_team_scim.sh", "hack/bin/create_test_user.sh", From 51fefa3e436946a76f1f3f4993c39ec81e1f3582 Mon Sep 17 00:00:00 2001 From: Florian Klink Date: Tue, 8 Nov 2022 12:03:36 +0000 Subject: [PATCH 31/76] hack/bin/shellcheck.sh: remove, add treefmt target --- Makefile | 8 +++---- hack/bin/shellcheck.sh | 50 ------------------------------------------ 2 files changed, 4 insertions(+), 54 deletions(-) delete mode 100755 hack/bin/shellcheck.sh diff --git a/Makefile b/Makefile index 140ea427053..573fa4d6e6a 100644 --- a/Makefile +++ b/Makefile @@ -108,7 +108,7 @@ ghcid: # Used by CI .PHONY: lint-all -lint-all: formatc hlint-check-all shellcheck check-local-nix-derivations +lint-all: formatc hlint-check-all check-local-nix-derivations treefmt .PHONY: hlint-check-all hlint-check-all: @@ -171,9 +171,9 @@ add-license: @echo "" @echo "you might want to run 'make formatf' now to make sure ormolu is happy" -.PHONY: shellcheck -shellcheck: - ./hack/bin/shellcheck.sh +.PHONY: treefmt +treefmt: + treefmt ################################# ## docker targets diff --git a/hack/bin/shellcheck.sh b/hack/bin/shellcheck.sh deleted file mode 100755 index ff551e5dc38..00000000000 --- a/hack/bin/shellcheck.sh +++ /dev/null @@ -1,50 +0,0 @@ -#!/usr/bin/env bash - -set -eu - -# lint all shell scripts with ShellCheck -# FUTUREWORK: Fix issues of the explicitly (no globbing) excluded files. - -mapfile -t SHELL_FILES_TO_LINT < <( - git ls-files | - grep "\.sh$" | - grep -v "dist-newstyle/" | - grep -v "services/nginz/third_party/" | - grep -v "libs/wire-api/test/golden/gentests.sh" | - grep -v "changelog.d/mk-changelog.sh" | - grep -v "hack/bin/integration-teardown.sh" | - grep -v "hack/bin/diff-failure.sh" | - grep -v "hack/bin/integration-setup.sh" | - grep -v "hack/bin/cabal-run-tests.sh" | - grep -v "hack/bin/integration-teardown-federation.sh" | - grep -v "hack/bin/integration-setup-federation.sh" | - grep -v "hack/bin/serve-charts.sh" | - grep -v "hack/bin/cabal-install-artefacts.sh" | - grep -v "hack/bin/helm-template.sh" | - grep -v "hack/bin/set-chart-image-version.sh" | - grep -v "hack/bin/copy-charts.sh" | - grep -v "hack/bin/set-helm-chart-version.sh" | - grep -v "hack/bin/integration-spring-cleaning.sh" | - grep -v "hack/bin/upload-helm-charts-s3.sh" | - grep -v "hack/bin/integration-test-logs.sh" | - grep -v "services/nginz/nginz_reload.sh" | - grep -v "services/spar/test-scim-suite/mk_collection.sh" | - grep -v "services/spar/test-scim-suite/runsuite.sh" | - grep -v "services/spar/test-scim-suite/run.sh" | - grep -v "services/brig/federation-tests.sh" | - grep -v "services/integration.sh" | - grep -v "hack/bin/create_test_team_members.sh" | - grep -v "hack/bin/create_test_team_scim.sh" | - grep -v "hack/bin/create_test_user.sh" | - grep -v "hack/bin/create_team_members.sh" | - grep -v "hack/bin/register_idp_internal.sh" | - grep -v "hack/bin/create_test_team_admins.sh" | - grep -v "deploy/dockerephemeral/init.sh" | - grep -v "tools/nginz_disco/nginz_disco.sh" | - grep -v "tools/rebase-onto-formatter.sh" | - grep -v "tools/sftd_disco/sftd_disco.sh" | - grep -v "tools/ormolu.sh" | - grep -v "tools/db/move-team/dump_merge_teams.sh" -) - -shellcheck -x "${SHELL_FILES_TO_LINT[@]}" From 31761439780da6f573b8a9691cf919c8d1c040dc Mon Sep 17 00:00:00 2001 From: Florian Klink Date: Tue, 8 Nov 2022 12:04:45 +0000 Subject: [PATCH 32/76] update changelog --- changelog.d/5-internal/treefmt | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/changelog.d/5-internal/treefmt b/changelog.d/5-internal/treefmt index 4d8267d9883..e3e735311a0 100644 --- a/changelog.d/5-internal/treefmt +++ b/changelog.d/5-internal/treefmt @@ -1 +1 @@ -Use treefmt to ensure consistent formatting of .nix files (#2831) +Use treefmt to ensure consistent formatting of .nix files, use for shellcheck too (#2831) From bb900379a69ae02aaf7e2bc2c7f42ed4db859f8f Mon Sep 17 00:00:00 2001 From: jschaul Date: Tue, 8 Nov 2022 17:08:29 +0100 Subject: [PATCH 33/76] upload docker images: retry, take 2 (#2832) As it turns out, 'skopeo --retry 5' doesn't actually help us. Wrap it in bash, then. To work around: ``` *** Uploading /tmp/tmp.kIKRERgZ1H/image to quay.io/wire/spar-integration:4.25.22Getting image source signatures Copying blob f4f33343fcb5 skipped: already exists Copying blob a3ab88edf03d skipped: already exists Copying blob 9360a695c022 skipped: already exists Copying blob 62d7b43f88a6 skipped: already exists Copying blob 134eff2df9f9 skipped: already exists Copying blob 8834895fc941 skipped: already exists Copying blob 52a0756d3ab1 done ======================>----------] 30.0MiB / 40.3MiB Copying blob fa04d4e808c5 done ---------------------------------] 8.0b / 190.0KiB Copying blob 6c806be006f4 skipped: already exists FATA[0004] trying to reuse blob sha256:95218c34e1598cf423f77062d98259bedcc19c9b8f4d937d0905895ee7b0242e at destination: too many requests to registry make: *** [Makefile:242: upload-images] Error 1 make: Leaving directory '/tmp/build/80754af9/wire-server' ``` --- hack/bin/upload-image.sh | 35 ++++++++++++++++++++++++++++++++++- 1 file changed, 34 insertions(+), 1 deletion(-) diff --git a/hack/bin/upload-image.sh b/hack/bin/upload-image.sh index d0f7abbdfdd..e49eaca08b1 100755 --- a/hack/bin/upload-image.sh +++ b/hack/bin/upload-image.sh @@ -27,6 +27,39 @@ if [[ "${DOCKER_USER+x}" != "" ]]; then credsArgs="--dest-creds=$DOCKER_USER:$DOCKER_PASSWORD" fi +# Retry a command with exponential backoff +# quay.io sometimes rate-limits us, so try again. +# Also, skopeo's retry logic doesn't properly work, look here if you want to see very badly written go code: +# https://github.com/containers/skopeo/blob/869d496f185cc086f22d6bbb79bb57ac3a415617/vendor/github.com/containers/common/pkg/retry/retry.go#L52-L113 +function retry { + local maxAttempts=$1 + local secondsDelay=1 + local attemptCount=1 + local output= + shift 1 + + while [ $attemptCount -le "$maxAttempts" ]; do + output=$("$@") + local status=$? + + if [ $status -eq 0 ]; then + break + fi + + if [ $attemptCount -lt "$maxAttempts" ]; then + echo "Command [$*] failed after attempt $attemptCount of $maxAttempts. Retrying in $secondsDelay second(s)." >&2 + sleep $secondsDelay + elif [ $attemptCount -eq "$maxAttempts" ]; then + echo "Command [$*] failed after $attemptCount attempt(s)" >&2 + return $status + fi + attemptCount=$((attemptCount + 1)) + secondsDelay=$((secondsDelay * 2)) + done + + echo "$output" +} + tmp_link_store=$(mktemp -d) # Using dockerTools.streamLayeredImage outputs an executable which prints the # image tar on stdout when executed. This is done so we don't store large images @@ -42,4 +75,4 @@ image_file="$tmp_link_store/image" repo=$(skopeo list-tags "docker-archive://$image_file" | jq -r '.Tags[0] | split(":") | .[0]') printf "*** Uploading $image_file to %s:%s\n" "$repo" "$DOCKER_TAG" # shellcheck disable=SC2086 -skopeo --insecure-policy copy --retry-times 5 $credsArgs "docker-archive://$image_file" "docker://$repo:$DOCKER_TAG" +retry 5 skopeo --insecure-policy copy --retry-times 5 $credsArgs "docker-archive://$image_file" "docker://$repo:$DOCKER_TAG" From 11ddb76f0e90f34f70b3488213575169dbb99082 Mon Sep 17 00:00:00 2001 From: Leif Battermann Date: Wed, 9 Nov 2022 11:16:06 +0100 Subject: [PATCH 34/76] Make flaky integration test less flaky (#2838) --- services/galley/test/integration/API/Teams/Feature.hs | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) diff --git a/services/galley/test/integration/API/Teams/Feature.hs b/services/galley/test/integration/API/Teams/Feature.hs index c19f0161120..3df6b0271d4 100644 --- a/services/galley/test/integration/API/Teams/Feature.hs +++ b/services/galley/test/integration/API/Teams/Feature.hs @@ -540,7 +540,10 @@ testSimpleFlagTTLOverride defaultValue ttl ttlAfter = do checkTtl (FeatureTTLSeconds actualTtl) (FeatureTTLSeconds expectedTtl) = 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 (fromIntegral @Word @Int actualTtl - fromIntegral @Word @Int expectedTtl) <= 2 + ) checkTtl FeatureTTLUnlimited FeatureTTLUnlimited = pure () checkTtl FeatureTTLUnlimited _ = assertFailure "expected the actual TTL to be unlimited, but it was limited" checkTtl _ FeatureTTLUnlimited = assertFailure "expected the actual TTL to be limited, but it was unlimited" @@ -562,7 +565,7 @@ testSimpleFlagTTLOverride defaultValue ttl ttlAfter = do -- Setting should work setFlagInternal otherValue ttl getFlag otherValue - getFeatureConfig otherValue ttl -- XXXXX + getFeatureConfig otherValue ttl getFlagInternal otherValue case (ttl, ttlAfter) of From 5733150b418511180a168f4ebc31d5b3be7e088c Mon Sep 17 00:00:00 2001 From: Florian Klink Date: Wed, 9 Nov 2022 16:55:23 +0000 Subject: [PATCH 35/76] services/nginz/third_party/nginx-module-vts,more-headers: drop submodules (#2836) We use nginxModules.vts from nixpkgs now instead, so there's no need to keep the submodules around. --- .gitmodules | 6 ------ services/nginz/third_party/headers-more-nginx-module | 1 - services/nginz/third_party/nginx-module-vts | 1 - treefmt.toml | 2 -- 4 files changed, 10 deletions(-) delete mode 160000 services/nginz/third_party/headers-more-nginx-module delete mode 160000 services/nginz/third_party/nginx-module-vts diff --git a/.gitmodules b/.gitmodules index cc9c3a9e104..ad996d503f7 100644 --- a/.gitmodules +++ b/.gitmodules @@ -1,9 +1,3 @@ -[submodule "services/nginz/third_party/headers-more-nginx-module"] - path = services/nginz/third_party/headers-more-nginx-module - url = https://github.com/openresty/headers-more-nginx-module.git -[submodule "services/nginz/third_party/nginx-module-vts"] - path = services/nginz/third_party/nginx-module-vts - url = https://github.com/vozlt/nginx-module-vts.git [submodule "libs/wire-message-proto-lens/generic-message-proto"] path = libs/wire-message-proto-lens/generic-message-proto url = https://github.com/wireapp/generic-message-proto diff --git a/services/nginz/third_party/headers-more-nginx-module b/services/nginz/third_party/headers-more-nginx-module deleted file mode 160000 index 7b0762aba64..00000000000 --- a/services/nginz/third_party/headers-more-nginx-module +++ /dev/null @@ -1 +0,0 @@ -Subproject commit 7b0762aba64495e289c3f9cd7f0bd74d0051a980 diff --git a/services/nginz/third_party/nginx-module-vts b/services/nginz/third_party/nginx-module-vts deleted file mode 160000 index 0009b3bc668..00000000000 --- a/services/nginz/third_party/nginx-module-vts +++ /dev/null @@ -1 +0,0 @@ -Subproject commit 0009b3bc668a7d73751c4cd8f8c0a161cba96832 diff --git a/treefmt.toml b/treefmt.toml index 53c01bf871a..2984c8f027a 100644 --- a/treefmt.toml +++ b/treefmt.toml @@ -34,8 +34,6 @@ excludes = [ "services/spar/test-scim-suite/run.sh", "services/brig/federation-tests.sh", "services/integration.sh", - "services/nginz/third_party/nginx-module-vts/*", - "services/nginz/third_party/headers-more-nginx-module/*", "hack/bin/create_test_team_members.sh", "hack/bin/create_test_team_scim.sh", "hack/bin/create_test_user.sh", From c82f654af6ead973f142c6e3da9484d1f8a23b08 Mon Sep 17 00:00:00 2001 From: Leif Battermann Date: Fri, 11 Nov 2022 15:04:43 +0100 Subject: [PATCH 36/76] [SQSERVICES-1010] Servantify brig team API (#2824) --- changelog.d/5-internal/pr-2824 | 1 + libs/schema-profunctor/src/Data/Schema.hs | 2 + libs/wire-api/src/Wire/API/Error/Brig.hs | 12 + .../src/Wire/API/Routes/Public/Brig.hs | 119 +++++++++ libs/wire-api/src/Wire/API/Swagger.hs | 4 - libs/wire-api/src/Wire/API/Team/Invitation.hs | 230 ++++++++--------- libs/wire-api/src/Wire/API/Team/Role.hs | 15 -- libs/wire-api/src/Wire/API/Team/Size.hs | 27 +- libs/wire-api/src/Wire/API/User.hs | 239 ++++++++++++------ .../golden/Test/Wire/API/Golden/Manual.hs | 9 +- .../Test/Wire/API/Golden/Manual/TeamSize.hs | 30 +++ .../test/golden/testObject_TeamSize_1.json | 3 + .../test/golden/testObject_TeamSize_2.json | 3 + .../test/golden/testObject_TeamSize_3.json | 3 + libs/wire-api/test/unit/Main.hs | 2 + .../Test/Wire/API/Roundtrip/HttpApiData.hs | 43 ++++ libs/wire-api/wire-api.cabal | 2 + services/brig/src/Brig/API/Error.hs | 3 - services/brig/src/Brig/API/Public.hs | 2 +- services/brig/src/Brig/Team/API.hs | 195 +++----------- services/brig/src/Brig/Team/DB.hs | 4 +- services/brig/test/integration/API/Team.hs | 63 +++-- .../brig/test/integration/API/Team/Util.hs | 12 +- 23 files changed, 606 insertions(+), 417 deletions(-) create mode 100644 changelog.d/5-internal/pr-2824 create mode 100644 libs/wire-api/test/golden/Test/Wire/API/Golden/Manual/TeamSize.hs create mode 100644 libs/wire-api/test/golden/testObject_TeamSize_1.json create mode 100644 libs/wire-api/test/golden/testObject_TeamSize_2.json create mode 100644 libs/wire-api/test/golden/testObject_TeamSize_3.json create mode 100644 libs/wire-api/test/unit/Test/Wire/API/Roundtrip/HttpApiData.hs diff --git a/changelog.d/5-internal/pr-2824 b/changelog.d/5-internal/pr-2824 new file mode 100644 index 00000000000..ae0e234fee8 --- /dev/null +++ b/changelog.d/5-internal/pr-2824 @@ -0,0 +1 @@ +Brig teams API is now migrated to servant diff --git a/libs/schema-profunctor/src/Data/Schema.hs b/libs/schema-profunctor/src/Data/Schema.hs index f2cdd73dcb3..103e81429ea 100644 --- a/libs/schema-profunctor/src/Data/Schema.hs +++ b/libs/schema-profunctor/src/Data/Schema.hs @@ -861,6 +861,8 @@ instance ToSchema String where schema = genericToSchema instance ToSchema Bool where schema = genericToSchema +instance ToSchema Natural where schema = genericToSchema + declareSwaggerSchema :: SchemaP (WithDeclare d) v w a b -> Declare d declareSwaggerSchema = runDeclare . schemaDoc diff --git a/libs/wire-api/src/Wire/API/Error/Brig.hs b/libs/wire-api/src/Wire/API/Error/Brig.hs index 0903494e5ee..aa6cc3ce7fd 100644 --- a/libs/wire-api/src/Wire/API/Error/Brig.hs +++ b/libs/wire-api/src/Wire/API/Error/Brig.hs @@ -75,6 +75,10 @@ data BrigError | InvalidPasswordResetKey | InvalidPasswordResetCode | ResetPasswordMustDiffer + | NoEmail + | NotificationNotFound + | PendingInvitationNotFound + | ConflictingInvitations instance KnownError (MapError e) => IsSwaggerError (e :: BrigError) where addToSwagger = addStaticErrorToSwagger @(MapError e) @@ -217,3 +221,11 @@ type instance MapError 'InvalidPasswordResetKey = 'StaticError 400 "invalid-key" type instance MapError 'InvalidPasswordResetCode = 'StaticError 400 "invalid-code" "Invalid password reset code." type instance MapError 'ResetPasswordMustDiffer = 'StaticError 409 "password-must-differ" "For password reset, new and old password must be different." + +type instance MapError 'NoEmail = 'StaticError 403 "no-email" "This operation requires the user to have a verified email address." + +type instance MapError 'NotificationNotFound = 'StaticError 404 "not-found" "Notification not found." + +type instance MapError 'PendingInvitationNotFound = 'StaticError 404 "not-found" "No pending invitations exists." + +type instance MapError 'ConflictingInvitations = 'StaticError 409 "conflicting-invitations" "Multiple conflicting invitations to different teams exists." 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 ff31ab1ac85..5a2999282e0 100644 --- a/libs/wire-api/src/Wire/API/Routes/Public/Brig.hs +++ b/libs/wire-api/src/Wire/API/Routes/Public/Brig.hs @@ -57,6 +57,8 @@ import Wire.API.Routes.Public import Wire.API.Routes.Public.Util import Wire.API.Routes.QualifiedCapture import Wire.API.Routes.Version +import Wire.API.Team.Invitation +import Wire.API.Team.Size import Wire.API.User hiding (NoIdentity) import Wire.API.User.Activation import Wire.API.User.Auth @@ -83,6 +85,7 @@ type BrigAPI = :<|> SearchAPI :<|> AuthAPI :<|> CallingAPI + :<|> TeamsAPI brigSwagger :: Swagger brigSwagger = toSwagger (Proxy @BrigAPI) @@ -1309,3 +1312,119 @@ type CallingAPI = :> QueryParam' '[Optional, Strict, Description "Limit resulting list. Allowed values [1..10]"] "limit" (Range 1 10 Int) :> Get '[JSON] RTCConfiguration ) + +-- Teams API ----------------------------------------------------- + +type TeamsAPI = + Named + "send-team-invitation" + ( Summary "Create and send a new team invitation." + :> Description + "Invitations are sent by email. The maximum allowed number of \ + \pending team invitations is equal to the team size." + :> CanThrow 'NoEmail + :> CanThrow 'NoIdentity + :> CanThrow 'InvalidEmail + :> CanThrow 'BlacklistedEmail + :> CanThrow 'TooManyTeamInvitations + :> CanThrow 'InsufficientTeamPermissions + :> ZUser + :> "teams" + :> Capture "tid" TeamId + :> "invitations" + :> ReqBody '[JSON] InvitationRequest + :> MultiVerb1 + 'POST + '[JSON] + ( WithHeaders + '[Header "Location" InvitationLocation] + (Invitation, InvitationLocation) + (Respond 201 "Invitation was created and sent." Invitation) + ) + ) + :<|> Named + "get-team-invitations" + ( Summary "List the sent team invitations" + :> CanThrow 'InsufficientTeamPermissions + :> ZUser + :> "teams" + :> Capture "tid" TeamId + :> "invitations" + :> QueryParam' '[Optional, Strict, Description "Invitation id to start from (ascending)."] "start" InvitationId + :> QueryParam' '[Optional, Strict, Description "Number of results to return (default 100, max 500)."] "size" (Range 1 500 Int32) + :> MultiVerb1 + 'GET + '[JSON] + (Respond 200 "List of sent invitations" InvitationList) + ) + :<|> Named + "get-team-invitation" + ( Summary "Get a pending team invitation by ID." + :> CanThrow 'InsufficientTeamPermissions + :> ZUser + :> "teams" + :> Capture "tid" TeamId + :> "invitations" + :> Capture "iid" InvitationId + :> MultiVerb + 'GET + '[JSON] + '[ ErrorResponse 'NotificationNotFound, + Respond 200 "Invitation" Invitation + ] + (Maybe Invitation) + ) + :<|> Named + "delete-team-invitation" + ( Summary "Delete a pending team invitation by ID." + :> CanThrow 'InsufficientTeamPermissions + :> ZUser + :> "teams" + :> Capture "tid" TeamId + :> "invitations" + :> Capture "iid" InvitationId + :> MultiVerb1 'DELETE '[JSON] (RespondEmpty 200 "Invitation deleted") + ) + :<|> Named + "get-team-invitation-info" + ( Summary "Get invitation info given a code." + :> CanThrow 'InvalidInvitationCode + :> "teams" + :> "invitations" + :> "info" + :> QueryParam' '[Required, Strict, Description "Invitation code"] "code" InvitationCode + :> MultiVerb1 + 'GET + '[JSON] + (Respond 200 "Invitation info" Invitation) + ) + -- FUTUREWORK: Add another endpoint to allow resending of invitation codes + :<|> Named + "head-team-invitations" + ( Summary "Check if there is an invitation pending given an email address." + :> "teams" + :> "invitations" + :> "by-email" + :> QueryParam' '[Required, Strict, Description "Email address"] "email" Email + :> MultiVerb + 'HEAD + '[JSON] + HeadInvitationsResponses + HeadInvitationByEmailResult + ) + :<|> Named + "get-team-size" + ( Summary + "Returns the number of team members as an integer. \ + \Can be out of sync by roughly the `refresh_interval` \ + \of the ES index." + :> CanThrow 'InvalidInvitationCode + :> ZUser + :> "teams" + :> Capture "tid" TeamId + :> "size" + :> MultiVerb1 + 'GET + '[JSON] + (Respond 200 "Number of team members" TeamSize) + ) diff --git a/libs/wire-api/src/Wire/API/Swagger.hs b/libs/wire-api/src/Wire/API/Swagger.hs index 575ded7007e..3b757e15486 100644 --- a/libs/wire-api/src/Wire/API/Swagger.hs +++ b/libs/wire-api/src/Wire/API/Swagger.hs @@ -31,7 +31,6 @@ import qualified Wire.API.Properties as Properties import qualified Wire.API.Provider.Service as Provider.Service import qualified Wire.API.Team as Team import qualified Wire.API.Team.Conversation as Team.Conversation -import qualified Wire.API.Team.Invitation as Team.Invitation import qualified Wire.API.Team.Permission as Team.Permission import qualified Wire.API.User as User import qualified Wire.API.User.Client as User.Client @@ -85,9 +84,6 @@ models = Team.modelTeamDelete, Team.Conversation.modelTeamConversation, Team.Conversation.modelTeamConversationList, - Team.Invitation.modelTeamInvitation, - Team.Invitation.modelTeamInvitationList, - Team.Invitation.modelTeamInvitationRequest, Team.Permission.modelPermissions, User.modelUserIdList, User.modelUser, diff --git a/libs/wire-api/src/Wire/API/Team/Invitation.hs b/libs/wire-api/src/Wire/API/Team/Invitation.hs index efcc60de35c..20eea89c533 100644 --- a/libs/wire-api/src/Wire/API/Team/Invitation.hs +++ b/libs/wire-api/src/Wire/API/Team/Invitation.hs @@ -21,21 +21,28 @@ module Wire.API.Team.Invitation ( InvitationRequest (..), Invitation (..), InvitationList (..), - - -- * Swagger - modelTeamInvitation, - modelTeamInvitationList, - modelTeamInvitationRequest, + InvitationLocation (..), + HeadInvitationByEmailResult (..), + HeadInvitationsResponses, ) where -import Data.Aeson +import Control.Lens ((?~)) +import qualified Data.Aeson as A +import Data.ByteString.Conversion import Data.Id import Data.Json.Util -import qualified Data.Swagger.Build.Api as Doc +import Data.SOP +import Data.Schema +import qualified Data.Swagger as S +import qualified Data.Text.Encoding as TE import Imports +import Servant (FromHttpApiData (..), ToHttpApiData (..)) import URI.ByteString -import Wire.API.Team.Role (Role, defaultRole, typeRole) +import Wire.API.Error +import Wire.API.Error.Brig +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.Arbitrary (Arbitrary, GenericUniform (..)) @@ -52,45 +59,22 @@ data InvitationRequest = InvitationRequest } deriving stock (Eq, Show, Generic) deriving (Arbitrary) via (GenericUniform InvitationRequest) - -modelTeamInvitationRequest :: Doc.Model -modelTeamInvitationRequest = Doc.defineModel "TeamInvitationRequest" $ do - Doc.description "A request to join a team on Wire." - Doc.property "locale" Doc.string' $ do - Doc.description "Locale to use for the invitation." - Doc.optional - Doc.property "role" typeRole $ do - Doc.description "Role of the invitee (invited user)." - Doc.optional - Doc.property "name" Doc.string' $ do - Doc.description "Name of the invitee (1 - 128 characters)." - Doc.optional - Doc.property "email" Doc.string' $ - Doc.description "Email of the invitee." - Doc.property "phone" Doc.string' $ do - Doc.description "Phone number of the invitee, in the E.164 format." - Doc.optional - Doc.property "inviter_name" Doc.string' $ - Doc.description "DEPRECATED - WILL BE IGNORED IN FAVOR OF REQ AUTH DATA - Name of the inviter (1 - 128 characters)." - -instance ToJSON InvitationRequest where - toJSON i = - object - [ "locale" .= irLocale i, - "role" .= irRole i, - "name" .= irInviteeName i, - "email" .= irInviteeEmail i, - "phone" .= irInviteePhone i - ] - -instance FromJSON InvitationRequest where - parseJSON = withObject "invitation-request" $ \o -> - InvitationRequest - <$> o .:? "locale" - <*> o .:? "role" - <*> o .:? "name" - <*> o .: "email" - <*> o .:? "phone" + deriving (A.FromJSON, A.ToJSON, S.ToSchema) via (Schema InvitationRequest) + +instance ToSchema InvitationRequest where + schema = + objectWithDocModifier "InvitationRequest" (description ?~ "A request to join a team on Wire.") $ + InvitationRequest + <$> irLocale + .= optFieldWithDocModifier "locale" (description ?~ "Locale to use for the invitation.") (maybeWithDefault A.Null schema) + <*> irRole + .= optFieldWithDocModifier "role" (description ?~ "Role of the invitee (invited user).") (maybeWithDefault A.Null schema) + <*> irInviteeName + .= optFieldWithDocModifier "name" (description ?~ "Name of the invitee (1 - 128 characters).") (maybeWithDefault A.Null schema) + <*> irInviteeEmail + .= fieldWithDocModifier "email" (description ?~ "Email of the invitee.") schema + <*> irInviteePhone + .= optFieldWithDocModifier "phone" (description ?~ "Phone number of the invitee, in the E.164 format.") (maybeWithDefault A.Null schema) -------------------------------------------------------------------------------- -- Invitation @@ -110,63 +94,73 @@ data Invitation = Invitation } deriving stock (Eq, Show, Generic) deriving (Arbitrary) via (GenericUniform Invitation) + deriving (A.FromJSON, A.ToJSON, S.ToSchema) via (Schema Invitation) + +instance ToSchema Invitation where + schema = + objectWithDocModifier "Invitation" (description ?~ "An invitation to join a team on Wire") $ + Invitation + <$> inTeam + .= fieldWithDocModifier "team" (description ?~ "Team ID of the inviting team") schema + <*> inRole + -- clients, when leaving "role" empty, can leave the default role choice to us + .= (fromMaybe defaultRole <$> optFieldWithDocModifier "role" (description ?~ "Role of the invited user") schema) + <*> inInvitation + .= fieldWithDocModifier "id" (description ?~ "UUID used to refer the invitation") schema + <*> inCreatedAt + .= fieldWithDocModifier "created_at" (description ?~ "Timestamp of invitation creation") schema + <*> inCreatedBy + .= optFieldWithDocModifier "created_by" (description ?~ "ID of the inviting user") (maybeWithDefault A.Null schema) + <*> inInviteeEmail + .= fieldWithDocModifier "email" (description ?~ "Email of the invitee") schema + <*> inInviteeName + .= optFieldWithDocModifier "name" (description ?~ "Name of the invitee (1 - 128 characters)") (maybeWithDefault A.Null schema) + <*> inInviteePhone + .= optFieldWithDocModifier "phone" (description ?~ "Phone number of the invitee, in the E.164 format") (maybeWithDefault A.Null schema) + <*> (fmap (TE.decodeUtf8 . serializeURIRef') . inInviteeUrl) + .= optFieldWithDocModifier "url" (description ?~ "URL of the invitation link to be sent to the invitee") (maybeWithDefault A.Null urlSchema) + where + urlSchema = parsedText "URIRef Absolute" (runParser (uriParser strictURIParserOptions) . TE.encodeUtf8) + +newtype InvitationLocation = InvitationLocation + { unInvitationLocation :: ByteString + } + deriving stock (Eq, Show, Generic) --- | (This is *not* the swagger model for the 'TeamInvitation' type (which does not exist), --- but for the use of 'Invitation' under @/teams/{tid}/invitations@.) -modelTeamInvitation :: Doc.Model -modelTeamInvitation = Doc.defineModel "TeamInvitation" $ do - Doc.description "An invitation to join a team on Wire" - Doc.property "team" Doc.bytes' $ - Doc.description "Team ID of the inviting team" - Doc.property "role" typeRole $ do - Doc.description "Role of the invited user" - Doc.optional - Doc.property "id" Doc.bytes' $ - Doc.description "UUID used to refer the invitation" - Doc.property "created_at" Doc.dateTime' $ - Doc.description "Timestamp of invitation creation" - Doc.property "created_by" Doc.bytes' $ do - Doc.description "ID of the inviting user" - Doc.optional - Doc.property "email" Doc.string' $ - Doc.description "Email of the invitee" - Doc.property "name" Doc.string' $ do - Doc.description "Name of the invitee (1 - 128 characters)" - Doc.optional - Doc.property "phone" Doc.string' $ do - Doc.description "Phone number of the invitee, in the E.164 format" - Doc.optional - Doc.property "url" Doc.string' $ do - Doc.description "URL of the invitation link to be sent to the invitee" - Doc.optional - -instance ToJSON Invitation where - toJSON i = - object - [ "team" .= inTeam i, - "role" .= inRole i, - "id" .= inInvitation i, - "created_at" .= inCreatedAt i, - "created_by" .= inCreatedBy i, - "email" .= inInviteeEmail i, - "name" .= inInviteeName i, - "phone" .= inInviteePhone i, - "url" .= inInviteeUrl i - ] - -instance FromJSON Invitation where - parseJSON = withObject "invitation" $ \o -> - Invitation - <$> o .: "team" - -- clients, when leaving "role" empty, can leave the default role choice to us - <*> o .:? "role" .!= defaultRole - <*> o .: "id" - <*> o .: "created_at" - <*> o .:? "created_by" - <*> o .: "email" - <*> o .:? "name" - <*> o .:? "phone" - <*> o .:? "url" +instance S.ToParamSchema InvitationLocation where + toParamSchema _ = + mempty + & S.type_ ?~ S.SwaggerString + & S.format ?~ "url" + +instance FromHttpApiData InvitationLocation where + parseUrlPiece = parseHeader . TE.encodeUtf8 + parseHeader = pure . InvitationLocation + +instance ToHttpApiData InvitationLocation where + toUrlPiece = TE.decodeUtf8 . toHeader + toHeader = unInvitationLocation + +data HeadInvitationByEmailResult + = InvitationByEmail + | InvitationByEmailNotFound + | InvitationByEmailMoreThanOne + +type HeadInvitationsResponses = + '[ ErrorResponse 'PendingInvitationNotFound, + ErrorResponse 'ConflictingInvitations, + RespondEmpty 200 "Pending invitation exists." + ] + +instance AsUnion HeadInvitationsResponses HeadInvitationByEmailResult where + toUnion InvitationByEmailNotFound = Z (I (dynError @(MapError 'PendingInvitationNotFound))) + toUnion InvitationByEmailMoreThanOne = S (Z (I (dynError @(MapError 'ConflictingInvitations)))) + toUnion InvitationByEmail = S (S (Z (I ()))) + + fromUnion (Z (I _)) = InvitationByEmailNotFound + fromUnion (S (Z (I _))) = InvitationByEmailMoreThanOne + fromUnion (S (S (Z (I ())))) = InvitationByEmail + fromUnion (S (S (S x))) = case x of {} -------------------------------------------------------------------------------- -- InvitationList @@ -177,23 +171,13 @@ data InvitationList = InvitationList } deriving stock (Eq, Show, Generic) deriving (Arbitrary) via (GenericUniform InvitationList) - -modelTeamInvitationList :: Doc.Model -modelTeamInvitationList = Doc.defineModel "TeamInvitationList" $ do - Doc.description "A list of sent team invitations." - Doc.property "invitations" (Doc.unique $ Doc.array (Doc.ref modelTeamInvitation)) Doc.end - Doc.property "has_more" Doc.bool' $ - Doc.description "Indicator that the server has more invitations than returned." - -instance ToJSON InvitationList where - toJSON (InvitationList l m) = - object - [ "invitations" .= l, - "has_more" .= m - ] - -instance FromJSON InvitationList where - parseJSON = withObject "InvitationList" $ \o -> - InvitationList - <$> o .: "invitations" - <*> o .: "has_more" + deriving (A.FromJSON, A.ToJSON, S.ToSchema) via (Schema InvitationList) + +instance ToSchema InvitationList where + schema = + objectWithDocModifier "InvitationList" (description ?~ "A list of sent team invitations.") $ + InvitationList + <$> ilInvitations + .= field "invitations" (array schema) + <*> ilHasMore + .= fieldWithDocModifier "has_more" (description ?~ "Indicator that the server has more invitations than returned.") schema diff --git a/libs/wire-api/src/Wire/API/Team/Role.hs b/libs/wire-api/src/Wire/API/Team/Role.hs index 2879766d4b3..c79f191fa6b 100644 --- a/libs/wire-api/src/Wire/API/Team/Role.hs +++ b/libs/wire-api/src/Wire/API/Team/Role.hs @@ -20,9 +20,6 @@ module Wire.API.Team.Role ( Role (..), defaultRole, - - -- * Swagger - typeRole, ) where @@ -34,7 +31,6 @@ import Data.Attoparsec.ByteString.Char8 (string) import Data.ByteString.Conversion (FromByteString (..), ToByteString (..)) import Data.Schema import qualified Data.Swagger as S -import qualified Data.Swagger.Model.Api as Doc import qualified Data.Text as T import Imports import Servant.API (FromHttpApiData, parseQueryParam) @@ -101,17 +97,6 @@ instance FromHttpApiData Role where flip foldMap [minBound .. maxBound] $ \s -> guard (T.pack (show s) == name) $> s -typeRole :: Doc.DataType -typeRole = - Doc.Prim $ - Doc.Primitive - { Doc.primType = Doc.PrimString, - Doc.defaultValue = Just defaultRole, - Doc.enum = Just [minBound ..], - Doc.minVal = Just minBound, - Doc.maxVal = Just maxBound - } - roleName :: IsString a => Role -> a roleName RoleOwner = "owner" roleName RoleAdmin = "admin" diff --git a/libs/wire-api/src/Wire/API/Team/Size.hs b/libs/wire-api/src/Wire/API/Team/Size.hs index 44cad608baf..75768861cdc 100644 --- a/libs/wire-api/src/Wire/API/Team/Size.hs +++ b/libs/wire-api/src/Wire/API/Team/Size.hs @@ -17,27 +17,24 @@ module Wire.API.Team.Size ( TeamSize (TeamSize), - modelTeamSize, ) where -import Data.Aeson -import qualified Data.Swagger.Build.Api as Doc +import Control.Lens ((?~)) +import qualified Data.Aeson as A +import Data.Schema +import qualified Data.Swagger as S import Imports import Numeric.Natural newtype TeamSize = TeamSize Natural deriving (Show, Eq) + deriving (A.ToJSON, A.FromJSON, S.ToSchema) via (Schema TeamSize) -instance ToJSON TeamSize where - toJSON (TeamSize s) = object ["teamSize" .= s] - -instance FromJSON TeamSize where - parseJSON = - withObject "TeamSize" $ \o -> TeamSize <$> o .: "teamSize" - -modelTeamSize :: Doc.Model -modelTeamSize = Doc.defineModel "TeamSize" $ do - Doc.description "A simple object with a total number of team members." - Doc.property "teamSize" Doc.int32' $ do - Doc.description "Team size." +instance ToSchema TeamSize where + schema = + objectWithDocModifier "TeamSize" (description ?~ "A simple object with a total number of team members.") $ + TeamSize <$> (unTeamSize .= fieldWithDocModifier "teamSize" (description ?~ "Team size.") schema) + where + unTeamSize :: TeamSize -> Natural + unTeamSize (TeamSize n) = n diff --git a/libs/wire-api/src/Wire/API/User.hs b/libs/wire-api/src/Wire/API/User.hs index c9eeca6cd07..0df82c7912c 100644 --- a/libs/wire-api/src/Wire/API/User.hs +++ b/libs/wire-api/src/Wire/API/User.hs @@ -145,7 +145,7 @@ import Data.String.Conversions (cs) import qualified Data.Swagger as S import qualified Data.Swagger.Build.Api as Doc import qualified Data.Text as T -import Data.Text.Ascii (AsciiBase64Url) +import Data.Text.Ascii import qualified Data.Text.Encoding as T import Data.UUID (UUID, nil) import qualified Data.UUID as UUID @@ -189,7 +189,8 @@ instance ToSchema UserIdList where schema = object "UserIdList" $ UserIdList - <$> mUsers .= field "user_ids" (array schema) + <$> mUsers + .= field "user_ids" (array schema) modelUserIdList :: Doc.Model modelUserIdList = Doc.defineModel "UserIdList" $ do @@ -209,8 +210,10 @@ instance ToSchema QualifiedUserIdList where schema = object "QualifiedUserIdList" $ QualifiedUserIdList - <$> qualifiedUserIdList .= field "qualified_user_ids" (array schema) - <* (fmap qUnqualified . qualifiedUserIdList) .= field "user_ids" (deprecatedSchema "qualified_user_ids" (array schema)) + <$> qualifiedUserIdList + .= field "qualified_user_ids" (array schema) + <* (fmap qUnqualified . qualifiedUserIdList) + .= field "user_ids" (deprecatedSchema "qualified_user_ids" (array schema)) -------------------------------------------------------------------------------- -- LimitedQualifiedUserIdList @@ -263,21 +266,32 @@ instance ToSchema UserProfile where schema = object "UserProfile" $ UserProfile - <$> profileQualifiedId .= field "qualified_id" schema + <$> profileQualifiedId + .= field "qualified_id" schema <* (qUnqualified . profileQualifiedId) .= optional (field "id" (deprecatedSchema "qualified_id" schema)) - <*> profileName .= field "name" schema - <*> profilePict .= (field "picture" schema <|> pure noPict) - <*> profileAssets .= (field "assets" (array schema) <|> pure []) - <*> profileAccentId .= field "accent_id" schema + <*> profileName + .= field "name" schema + <*> profilePict + .= (field "picture" schema <|> pure noPict) + <*> profileAssets + .= (field "assets" (array schema) <|> pure []) + <*> profileAccentId + .= field "accent_id" schema <*> ((\del -> if del then Just True else Nothing) . profileDeleted) .= maybe_ (fromMaybe False <$> optField "deleted" schema) - <*> profileService .= maybe_ (optField "service" schema) - <*> profileHandle .= maybe_ (optField "handle" schema) - <*> profileExpire .= maybe_ (optField "expires_at" schema) - <*> profileTeam .= maybe_ (optField "team" schema) - <*> profileEmail .= maybe_ (optField "email" schema) - <*> profileLegalholdStatus .= field "legalhold_status" schema + <*> profileService + .= maybe_ (optField "service" schema) + <*> profileHandle + .= maybe_ (optField "handle" schema) + <*> profileExpire + .= maybe_ (optField "expires_at" schema) + <*> profileTeam + .= maybe_ (optField "team" schema) + <*> profileEmail + .= maybe_ (optField "email" schema) + <*> profileLegalholdStatus + .= field "legalhold_status" schema modelUser :: Doc.Model modelUser = Doc.defineModel "User" $ do @@ -371,20 +385,33 @@ instance ToSchema User where userObjectSchema :: ObjectSchema SwaggerDoc User userObjectSchema = User - <$> userId .= field "id" schema - <*> userQualifiedId .= field "qualified_id" schema - <*> userIdentity .= maybeUserIdentityObjectSchema - <*> userDisplayName .= field "name" schema - <*> userPict .= (fromMaybe noPict <$> optField "picture" schema) - <*> userAssets .= (fromMaybe [] <$> optField "assets" (array schema)) - <*> userAccentId .= field "accent_id" schema + <$> userId + .= field "id" schema + <*> userQualifiedId + .= field "qualified_id" schema + <*> userIdentity + .= maybeUserIdentityObjectSchema + <*> userDisplayName + .= field "name" schema + <*> userPict + .= (fromMaybe noPict <$> optField "picture" schema) + <*> userAssets + .= (fromMaybe [] <$> optField "assets" (array schema)) + <*> userAccentId + .= field "accent_id" schema <*> (fromMaybe False <$> (\u -> if userDeleted u then Just True else Nothing) .= maybe_ (optField "deleted" schema)) - <*> userLocale .= field "locale" schema - <*> userService .= maybe_ (optField "service" schema) - <*> userHandle .= maybe_ (optField "handle" schema) - <*> userExpire .= maybe_ (optField "expires_at" schema) - <*> userTeam .= maybe_ (optField "team" schema) - <*> userManagedBy .= (fromMaybe ManagedByWire <$> optField "managed_by" schema) + <*> userLocale + .= field "locale" schema + <*> userService + .= maybe_ (optField "service" schema) + <*> userHandle + .= maybe_ (optField "handle" schema) + <*> userExpire + .= maybe_ (optField "expires_at" schema) + <*> userTeam + .= maybe_ (optField "team" schema) + <*> userManagedBy + .= (fromMaybe ManagedByWire <$> optField "managed_by" schema) userEmail :: User -> Maybe Email userEmail = emailIdentity <=< userIdentity @@ -671,14 +698,22 @@ instance ToSchema NewUserSpar where schema = object "NewUserSpar" $ NewUserSpar - <$> newUserSparUUID .= field "newUserSparUUID" genericToSchema - <*> newUserSparSSOId .= field "newUserSparSSOId" genericToSchema - <*> newUserSparDisplayName .= field "newUserSparDisplayName" schema - <*> newUserSparTeamId .= field "newUserSparTeamId" schema - <*> newUserSparManagedBy .= field "newUserSparManagedBy" schema - <*> newUserSparHandle .= maybe_ (optField "newUserSparHandle" schema) - <*> newUserSparRichInfo .= maybe_ (optField "newUserSparRichInfo" schema) - <*> newUserSparLocale .= maybe_ (optField "newUserSparLocale" schema) + <$> newUserSparUUID + .= field "newUserSparUUID" genericToSchema + <*> newUserSparSSOId + .= field "newUserSparSSOId" genericToSchema + <*> newUserSparDisplayName + .= field "newUserSparDisplayName" schema + <*> newUserSparTeamId + .= field "newUserSparTeamId" schema + <*> newUserSparManagedBy + .= field "newUserSparManagedBy" schema + <*> newUserSparHandle + .= maybe_ (optField "newUserSparHandle" schema) + <*> newUserSparRichInfo + .= maybe_ (optField "newUserSparRichInfo" schema) + <*> newUserSparLocale + .= maybe_ (optField "newUserSparLocale" schema) newUserFromSpar :: NewUserSpar -> NewUser newUserFromSpar new = @@ -769,25 +804,44 @@ data NewUserRaw = NewUserRaw newUserRawObjectSchema :: ObjectSchema SwaggerDoc NewUserRaw newUserRawObjectSchema = NewUserRaw - <$> newUserRawDisplayName .= field "name" schema - <*> newUserRawUUID .= maybe_ (optField "uuid" genericToSchema) - <*> newUserRawEmail .= maybe_ (optField "email" schema) - <*> newUserRawPhone .= maybe_ (optField "phone" schema) - <*> newUserRawSSOId .= maybe_ (optField "sso_id" genericToSchema) - <*> newUserRawPict .= maybe_ (optField "picture" schema) - <*> newUserRawAssets .= (fromMaybe [] <$> optField "assets" (array schema)) - <*> newUserRawAccentId .= maybe_ (optField "accent_id" schema) - <*> newUserRawEmailCode .= maybe_ (optField "email_code" schema) - <*> newUserRawPhoneCode .= maybe_ (optField "phone_code" schema) - <*> newUserRawInvitationCode .= maybe_ (optField "invitation_code" schema) - <*> newUserRawTeamCode .= maybe_ (optField "team_code" schema) - <*> newUserRawTeam .= maybe_ (optField "team" schema) - <*> newUserRawTeamId .= maybe_ (optField "team_id" schema) - <*> newUserRawLabel .= maybe_ (optField "label" schema) - <*> newUserRawLocale .= maybe_ (optField "locale" schema) - <*> newUserRawPassword .= maybe_ (optField "password" schema) - <*> newUserRawExpiresIn .= maybe_ (optField "expires_in" schema) - <*> newUserRawManagedBy .= maybe_ (optField "managed_by" schema) + <$> newUserRawDisplayName + .= field "name" schema + <*> newUserRawUUID + .= maybe_ (optField "uuid" genericToSchema) + <*> newUserRawEmail + .= maybe_ (optField "email" schema) + <*> newUserRawPhone + .= maybe_ (optField "phone" schema) + <*> newUserRawSSOId + .= maybe_ (optField "sso_id" genericToSchema) + <*> newUserRawPict + .= maybe_ (optField "picture" schema) + <*> newUserRawAssets + .= (fromMaybe [] <$> optField "assets" (array schema)) + <*> newUserRawAccentId + .= maybe_ (optField "accent_id" schema) + <*> newUserRawEmailCode + .= maybe_ (optField "email_code" schema) + <*> newUserRawPhoneCode + .= maybe_ (optField "phone_code" schema) + <*> newUserRawInvitationCode + .= maybe_ (optField "invitation_code" schema) + <*> newUserRawTeamCode + .= maybe_ (optField "team_code" schema) + <*> newUserRawTeam + .= maybe_ (optField "team" schema) + <*> newUserRawTeamId + .= maybe_ (optField "team_id" schema) + <*> newUserRawLabel + .= maybe_ (optField "label" schema) + <*> newUserRawLocale + .= maybe_ (optField "locale" schema) + <*> newUserRawPassword + .= maybe_ (optField "password" schema) + <*> newUserRawExpiresIn + .= maybe_ (optField "expires_in" schema) + <*> newUserRawManagedBy + .= maybe_ (optField "managed_by" schema) instance ToSchema NewUser where schema = @@ -959,6 +1013,15 @@ newtype InvitationCode = InvitationCode deriving newtype (ToSchema, ToByteString, FromByteString, Arbitrary) deriving (FromJSON, ToJSON, S.ToSchema) via Schema InvitationCode +instance S.ToParamSchema InvitationCode where + toParamSchema _ = S.toParamSchema (Proxy @Text) + +instance FromHttpApiData InvitationCode where + parseQueryParam = bimap cs InvitationCode . validateBase64Url + +instance ToHttpApiData InvitationCode where + toQueryParam = cs . toByteString . fromInvitationCode + -------------------------------------------------------------------------------- -- NewTeamUser @@ -1003,8 +1066,10 @@ instance ToSchema BindingNewTeamUser where schema = object "BindingNewTeamUser" $ BindingNewTeamUser - <$> bnuTeam .= bindingNewTeamObjectSchema - <*> bnuCurrency .= maybe_ (optField "currency" genericToSchema) + <$> bnuTeam + .= bindingNewTeamObjectSchema + <*> bnuCurrency + .= maybe_ (optField "currency" genericToSchema) -------------------------------------------------------------------------------- -- SCIM User Info @@ -1021,8 +1086,10 @@ instance ToSchema ScimUserInfo where schema = object "ScimUserInfo" $ ScimUserInfo - <$> suiUserId .= field "id" schema - <*> suiCreatedOn .= maybe_ (optField "created_on" schema) + <$> suiUserId + .= field "id" schema + <*> suiCreatedOn + .= maybe_ (optField "created_on" schema) newtype ScimUserInfos = ScimUserInfos {scimUserInfos :: [ScimUserInfo]} deriving stock (Eq, Show, Generic) @@ -1033,7 +1100,8 @@ instance ToSchema ScimUserInfos where schema = object "ScimUserInfos" $ ScimUserInfos - <$> scimUserInfos .= field "scim_user_infos" (array schema) + <$> scimUserInfos + .= field "scim_user_infos" (array schema) ------------------------------------------------------------------------------- -- UserSet @@ -1051,7 +1119,8 @@ instance ToSchema UserSet where schema = object "UserSet" $ UserSet - <$> usUsrs .= field "users" (set schema) + <$> usUsrs + .= field "users" (set schema) -------------------------------------------------------------------------------- -- Profile Updates @@ -1071,10 +1140,14 @@ instance ToSchema UserUpdate where schema = object "UserUpdate" $ UserUpdate - <$> uupName .= maybe_ (optField "name" schema) - <*> uupPict .= maybe_ (optField "picture" schema) - <*> uupAssets .= maybe_ (optField "assets" (array schema)) - <*> uupAccentId .= maybe_ (optField "accent_id" schema) + <$> uupName + .= maybe_ (optField "name" schema) + <*> uupPict + .= maybe_ (optField "picture" schema) + <*> uupAssets + .= maybe_ (optField "assets" (array schema)) + <*> uupAccentId + .= maybe_ (optField "accent_id" schema) data UpdateProfileError = DisplayNameManagedByScim @@ -1111,8 +1184,10 @@ instance ToSchema PasswordChange where ) . object "PasswordChange" $ PasswordChange - <$> cpOldPassword .= maybe_ (optField "old_password" schema) - <*> cpNewPassword .= field "new_password" schema + <$> cpOldPassword + .= maybe_ (optField "old_password" schema) + <*> cpNewPassword + .= field "new_password" schema data ChangePasswordError = InvalidCurrentPassword @@ -1145,7 +1220,8 @@ instance ToSchema LocaleUpdate where schema = object "LocaleUpdate" $ LocaleUpdate - <$> luLocale .= field "locale" schema + <$> luLocale + .= field "locale" schema newtype EmailUpdate = EmailUpdate {euEmail :: Email} deriving stock (Eq, Show, Generic) @@ -1156,7 +1232,8 @@ instance ToSchema EmailUpdate where schema = object "EmailUpdate" $ EmailUpdate - <$> euEmail .= field "email" schema + <$> euEmail + .= field "email" schema modelEmailUpdate :: Doc.Model modelEmailUpdate = Doc.defineModel "EmailUpdate" $ do @@ -1180,7 +1257,8 @@ instance ToSchema PhoneUpdate where schema = object "PhoneUpdate" $ PhoneUpdate - <$> puPhone .= field "phone" schema + <$> puPhone + .= field "phone" schema data ChangePhoneError = PhoneExists @@ -1301,7 +1379,8 @@ instance ToSchema DeleteUser where schema = object "DeleteUser" $ DeleteUser - <$> deleteUserPassword .= maybe_ (optField "password" schema) + <$> deleteUserPassword + .= maybe_ (optField "password" schema) mkDeleteUser :: Maybe PlainTextPassword -> DeleteUser mkDeleteUser = DeleteUser @@ -1316,7 +1395,8 @@ modelDelete = Doc.defineModel "Delete" $ do instance ToJSON DeleteUser where toJSON d = A.object $ - "password" A..= deleteUserPassword d + "password" + A..= deleteUserPassword d # [] instance FromJSON DeleteUser where @@ -1339,8 +1419,10 @@ instance ToSchema VerifyDeleteUser where schema = objectWithDocModifier "VerifyDeleteUser" (description ?~ "Data for verifying an account deletion.") $ VerifyDeleteUser - <$> verifyDeleteUserKey .= fieldWithDocModifier "key" (description ?~ "The identifying key of the account (i.e. user ID).") schema - <*> verifyDeleteUserCode .= fieldWithDocModifier "code" (description ?~ "The verification code.") schema + <$> verifyDeleteUserKey + .= fieldWithDocModifier "key" (description ?~ "The identifying key of the account (i.e. user ID).") schema + <*> verifyDeleteUserCode + .= fieldWithDocModifier "code" (description ?~ "The verification code.") schema -- | A response for a pending deletion code. newtype DeletionCodeTimeout = DeletionCodeTimeout @@ -1353,7 +1435,8 @@ instance ToSchema DeletionCodeTimeout where schema = object "DeletionCodeTimeout" $ DeletionCodeTimeout - <$> fromDeletionCodeTimeout .= field "expires_in" schema + <$> fromDeletionCodeTimeout + .= field "expires_in" schema instance ToJSON DeletionCodeTimeout where toJSON (DeletionCodeTimeout t) = A.object ["expires_in" A..= t] @@ -1466,5 +1549,7 @@ instance ToSchema SendVerificationCode where schema = object "SendVerificationCode" $ SendVerificationCode - <$> svcAction .= field "action" schema - <*> svcEmail .= field "email" schema + <$> svcAction + .= field "action" schema + <*> svcEmail + .= field "email" schema diff --git a/libs/wire-api/test/golden/Test/Wire/API/Golden/Manual.hs b/libs/wire-api/test/golden/Test/Wire/API/Golden/Manual.hs index e070ad4c3d1..5f230030ccd 100644 --- a/libs/wire-api/test/golden/Test/Wire/API/Golden/Manual.hs +++ b/libs/wire-api/test/golden/Test/Wire/API/Golden/Manual.hs @@ -33,6 +33,7 @@ import Test.Wire.API.Golden.Manual.GroupId import Test.Wire.API.Golden.Manual.ListConversations import Test.Wire.API.Golden.Manual.QualifiedUserClientPrekeyMap import Test.Wire.API.Golden.Manual.SearchResultContact +import Test.Wire.API.Golden.Manual.TeamSize import Test.Wire.API.Golden.Manual.Token import Test.Wire.API.Golden.Manual.UserClientPrekeyMap import Test.Wire.API.Golden.Manual.UserIdList @@ -126,5 +127,11 @@ tests = [(testObject_GroupId_1, "testObject_GroupId_1.json")], testGroup "PushToken" $ testObjects - [(testObject_Token_1, "testObject_Token_1.json")] + [(testObject_Token_1, "testObject_Token_1.json")], + testGroup "TeamSize" $ + testObjects + [ (testObject_TeamSize_1, "testObject_TeamSize_1.json"), + (testObject_TeamSize_2, "testObject_TeamSize_2.json"), + (testObject_TeamSize_3, "testObject_TeamSize_3.json") + ] ] diff --git a/libs/wire-api/test/golden/Test/Wire/API/Golden/Manual/TeamSize.hs b/libs/wire-api/test/golden/Test/Wire/API/Golden/Manual/TeamSize.hs new file mode 100644 index 00000000000..8686e290a49 --- /dev/null +++ b/libs/wire-api/test/golden/Test/Wire/API/Golden/Manual/TeamSize.hs @@ -0,0 +1,30 @@ +-- 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.Wire.API.Golden.Manual.TeamSize where + +import Imports +import Wire.API.Team.Size + +testObject_TeamSize_1 :: TeamSize +testObject_TeamSize_1 = TeamSize 0 + +testObject_TeamSize_2 :: TeamSize +testObject_TeamSize_2 = TeamSize 100 + +testObject_TeamSize_3 :: TeamSize +testObject_TeamSize_3 = TeamSize (fromIntegral $ maxBound @Word64) diff --git a/libs/wire-api/test/golden/testObject_TeamSize_1.json b/libs/wire-api/test/golden/testObject_TeamSize_1.json new file mode 100644 index 00000000000..c883020b742 --- /dev/null +++ b/libs/wire-api/test/golden/testObject_TeamSize_1.json @@ -0,0 +1,3 @@ +{ + "teamSize": 0 +} diff --git a/libs/wire-api/test/golden/testObject_TeamSize_2.json b/libs/wire-api/test/golden/testObject_TeamSize_2.json new file mode 100644 index 00000000000..b33bf1f3bd8 --- /dev/null +++ b/libs/wire-api/test/golden/testObject_TeamSize_2.json @@ -0,0 +1,3 @@ +{ + "teamSize": 100 +} diff --git a/libs/wire-api/test/golden/testObject_TeamSize_3.json b/libs/wire-api/test/golden/testObject_TeamSize_3.json new file mode 100644 index 00000000000..2e47b19f3e7 --- /dev/null +++ b/libs/wire-api/test/golden/testObject_TeamSize_3.json @@ -0,0 +1,3 @@ +{ + "teamSize": 1.8446744073709551615e19 +} diff --git a/libs/wire-api/test/unit/Main.hs b/libs/wire-api/test/unit/Main.hs index 74dcadd90ec..46178a1d7a5 100644 --- a/libs/wire-api/test/unit/Main.hs +++ b/libs/wire-api/test/unit/Main.hs @@ -28,6 +28,7 @@ import qualified Test.Wire.API.MLS as MLS import qualified Test.Wire.API.Roundtrip.Aeson as Roundtrip.Aeson import qualified Test.Wire.API.Roundtrip.ByteString as Roundtrip.ByteString import qualified Test.Wire.API.Roundtrip.CSV as Roundtrip.CSV +import qualified Test.Wire.API.Roundtrip.HttpApiData as Roundtrip.HttpApiData import qualified Test.Wire.API.Roundtrip.MLS as Roundtrip.MLS import qualified Test.Wire.API.Routes as Routes import qualified Test.Wire.API.Swagger as Swagger @@ -52,6 +53,7 @@ main = User.Auth.tests, Roundtrip.Aeson.tests, Roundtrip.ByteString.tests, + Roundtrip.HttpApiData.tests, Roundtrip.MLS.tests, Swagger.tests, Roundtrip.CSV.tests, diff --git a/libs/wire-api/test/unit/Test/Wire/API/Roundtrip/HttpApiData.hs b/libs/wire-api/test/unit/Test/Wire/API/Roundtrip/HttpApiData.hs new file mode 100644 index 00000000000..f910ad0a78d --- /dev/null +++ b/libs/wire-api/test/unit/Test/Wire/API/Roundtrip/HttpApiData.hs @@ -0,0 +1,43 @@ +-- 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.Wire.API.Roundtrip.HttpApiData (tests) where + +import Imports +import Servant.API +import qualified Test.Tasty as T +import Test.Tasty.QuickCheck (Arbitrary, counterexample, testProperty, (===)) +import Type.Reflection (typeRep) +import qualified Wire.API.User as User +import qualified Wire.Arbitrary as Arbitrary () + +tests :: T.TestTree +tests = + T.localOption (T.Timeout (60 * 1000000) "60s") . T.testGroup "HttpApiData roundtrip tests" $ + [ testRoundTrip @User.InvitationCode + ] + +testRoundTrip :: + forall a. + (Arbitrary a, Typeable a, ToHttpApiData a, FromHttpApiData a, Eq a, Show a) => + T.TestTree +testRoundTrip = testProperty msg trip + where + msg = show (typeRep @a) + trip (v :: a) = + counterexample (show $ v) $ + Right v === (parseQueryParam . toQueryParam) v diff --git a/libs/wire-api/wire-api.cabal b/libs/wire-api/wire-api.cabal index 866f26746c7..75e296c708a 100644 --- a/libs/wire-api/wire-api.cabal +++ b/libs/wire-api/wire-api.cabal @@ -527,6 +527,7 @@ test-suite wire-api-golden-tests Test.Wire.API.Golden.Manual.ListConversations Test.Wire.API.Golden.Manual.QualifiedUserClientPrekeyMap Test.Wire.API.Golden.Manual.SearchResultContact + Test.Wire.API.Golden.Manual.TeamSize Test.Wire.API.Golden.Manual.Token Test.Wire.API.Golden.Manual.UserClientPrekeyMap Test.Wire.API.Golden.Manual.UserIdList @@ -639,6 +640,7 @@ test-suite wire-api-tests Test.Wire.API.Roundtrip.Aeson Test.Wire.API.Roundtrip.ByteString Test.Wire.API.Roundtrip.CSV + Test.Wire.API.Roundtrip.HttpApiData Test.Wire.API.Roundtrip.MLS Test.Wire.API.Routes Test.Wire.API.Swagger diff --git a/services/brig/src/Brig/API/Error.hs b/services/brig/src/Brig/API/Error.hs index f90addbec29..d688373ebaf 100644 --- a/services/brig/src/Brig/API/Error.hs +++ b/services/brig/src/Brig/API/Error.hs @@ -258,9 +258,6 @@ propertyValueTooLarge = Wai.mkError status403 "property-value-too-large" "The pr clientCapabilitiesCannotBeRemoved :: Wai.Error clientCapabilitiesCannotBeRemoved = Wai.mkError status409 "client-capabilities-cannot-be-removed" "You can only add capabilities to a client, not remove them." -noEmail :: Wai.Error -noEmail = Wai.mkError status403 "no-email" "This operation requires the user to have a verified email address." - emailExists :: Wai.Error emailExists = Wai.mkError status409 "email-exists" "The given e-mail address is in use." diff --git a/services/brig/src/Brig/API/Public.hs b/services/brig/src/Brig/API/Public.hs index d9cd8b71d81..e45d35c529b 100644 --- a/services/brig/src/Brig/API/Public.hs +++ b/services/brig/src/Brig/API/Public.hs @@ -196,6 +196,7 @@ servantSitemap = :<|> searchAPI :<|> authAPI :<|> callingAPI + :<|> Team.servantAPI where userAPI :: ServerT UserAPI (Handler r) userAPI = @@ -338,7 +339,6 @@ sitemap :: Routes Doc.ApiBuilder (Handler r) () sitemap = do Provider.routesPublic - Team.routesPublic apiDocs :: forall r. diff --git a/services/brig/src/Brig/Team/API.hs b/services/brig/src/Brig/Team/API.hs index 7d64a9f9c98..64116264171 100644 --- a/services/brig/src/Brig/Team/API.hs +++ b/services/brig/src/Brig/Team/API.hs @@ -16,7 +16,7 @@ -- with this program. If not, see . module Brig.Team.API - ( routesPublic, + ( servantAPI, routesInternal, ) where @@ -47,12 +47,11 @@ import qualified Brig.User.Search.TeamSize as TeamSize import Control.Lens (view, (^.)) import Control.Monad.Trans.Except (mapExceptT) import Data.Aeson hiding (json) -import Data.ByteString.Conversion +import Data.ByteString.Conversion (toByteString') import Data.Id import qualified Data.List1 as List1 import Data.Range import Data.String.Conversions (cs) -import qualified Data.Swagger.Build.Api as Doc import qualified Galley.Types.Teams as Team import qualified Galley.Types.Teams.Intra as Team import Imports hiding (head) @@ -61,14 +60,15 @@ import Network.Wai (Response) import Network.Wai.Predicate hiding (and, result, setStatus) import Network.Wai.Routing import Network.Wai.Utilities hiding (code, message) -import Network.Wai.Utilities.Swagger (document) -import qualified Network.Wai.Utilities.Swagger as Doc import Polysemy (Members) +import Servant hiding (Handler, JSON, addHeader) import System.Logger (Msg) import qualified System.Logger.Class as Log import Util.Logging (logFunction, logTeam) import Wire.API.Error import qualified Wire.API.Error.Brig as E +import Wire.API.Routes.Named +import Wire.API.Routes.Public.Brig import Wire.API.Team import Wire.API.Team.Invitation import qualified Wire.API.Team.Invitation as Public @@ -77,125 +77,24 @@ import qualified Wire.API.Team.Member as Teams import Wire.API.Team.Permission (Perm (AddTeamMember)) import Wire.API.Team.Role import qualified Wire.API.Team.Role as Public -import qualified Wire.API.Team.Size as Public import Wire.API.User hiding (fromEmail) import qualified Wire.API.User as Public -routesPublic :: +servantAPI :: Members '[ BlacklistStore, GalleyProvider ] r => - Routes Doc.ApiBuilder (Handler r) () -routesPublic = do - post "/teams/:tid/invitations" (continue createInvitationPublicH) $ - accept "application" "json" - .&. header "Z-User" - .&. capture "tid" - .&. jsonRequest @Public.InvitationRequest - document "POST" "sendTeamInvitation" $ do - Doc.summary "Create and send a new team invitation." - Doc.notes - "Invitations are sent by email. The maximum allowed number of \ - \pending team invitations is equal to the team size." - Doc.parameter Doc.Path "tid" Doc.bytes' $ - Doc.description "Team ID" - Doc.body (Doc.ref Public.modelTeamInvitationRequest) $ - Doc.description "JSON body" - Doc.returns (Doc.ref Public.modelTeamInvitation) - Doc.response 201 "Invitation was created and sent." Doc.end - Doc.errorResponse noEmail - Doc.errorResponse (errorToWai @'E.NoIdentity) - Doc.errorResponse (errorToWai @'E.InvalidEmail) - Doc.errorResponse (errorToWai @'E.BlacklistedEmail) - Doc.errorResponse (errorToWai @'E.TooManyTeamInvitations) - - get "/teams/:tid/invitations" (continue listInvitationsH) $ - accept "application" "json" - .&. header "Z-User" - .&. capture "tid" - .&. opt (query "start") - .&. def (unsafeRange 100) (query "size") - document "GET" "listTeamInvitations" $ do - Doc.summary "List the sent team invitations" - Doc.parameter Doc.Path "tid" Doc.bytes' $ - Doc.description "Team ID" - Doc.parameter Doc.Query "start" Doc.string' $ do - Doc.description "Invitation id to start from (ascending)." - Doc.optional - Doc.parameter Doc.Query "size" Doc.int32' $ do - Doc.description "Number of results to return (default 100, max 500)." - Doc.optional - Doc.returns (Doc.ref Public.modelTeamInvitationList) - Doc.response 200 "List of sent invitations" Doc.end - - get "/teams/:tid/invitations/:iid" (continue getInvitationH) $ - accept "application" "json" - .&. header "Z-User" - .&. capture "tid" - .&. capture "iid" - document "GET" "getInvitation" $ do - Doc.summary "Get a pending team invitation by ID." - Doc.parameter Doc.Path "tid" Doc.bytes' $ - Doc.description "Team ID" - Doc.parameter Doc.Path "id" Doc.bytes' $ - Doc.description "Team Invitation ID" - Doc.returns (Doc.ref Public.modelTeamInvitation) - Doc.response 200 "Invitation" Doc.end - - delete "/teams/:tid/invitations/:iid" (continue deleteInvitationH) $ - accept "application" "json" - .&. header "Z-User" - .&. capture "tid" - .&. capture "iid" - document "DELETE" "deleteInvitation" $ do - Doc.summary "Delete a pending invitation by ID." - Doc.parameter Doc.Path "tid" Doc.bytes' $ - Doc.description "Team ID" - Doc.parameter Doc.Path "iid" Doc.bytes' $ - Doc.description "Team Invitation ID" - Doc.response 200 "Invitation deleted." Doc.end - - get "/teams/invitations/info" (continue getInvitationByCodeH) $ - accept "application" "json" - .&. query "code" - document "GET" "getInvitationInfo" $ do - Doc.summary "Get invitation info given a code." - Doc.parameter Doc.Query "code" Doc.bytes' $ - Doc.description "Invitation code" - Doc.returns (Doc.ref Public.modelTeamInvitation) - Doc.response 200 "Invitation successful." Doc.end - Doc.errorResponse (errorToWai @'E.InvalidInvitationCode) - - -- FUTUREWORK: Add another endpoint to allow resending of invitation codes - head "/teams/invitations/by-email" (continue headInvitationByEmailH) $ - accept "application" "json" - .&. query "email" - - document "HEAD" "headInvitationPending" $ do - Doc.summary "Check if there is an invitation pending given an email address." - Doc.parameter Doc.Query "email" Doc.bytes' $ - Doc.description "Email address" - Doc.response 200 "Pending invitation exists." Doc.end - Doc.response 404 "No pending invitations exists." Doc.end - Doc.response 409 "Multiple conflicting invitations to different teams exists." Doc.end - - get "/teams/:tid/size" (continue teamSizePublicH) $ - accept "application" "json" - .&. header "Z-User" - .&. capture "tid" - - document "GET" "teamSize" $ do - Doc.summary - "Returns the number of team members as an integer. \ - \Can be out of sync by roughly the `refresh_interval` \ - \of the ES index." - Doc.parameter Doc.Path "tid" Doc.bytes' $ - Doc.description "Team ID" - Doc.returns (Doc.ref Public.modelTeamSize) - Doc.response 200 "Invitation successful." Doc.end - Doc.response 403 "No permission (not admin or owner of this team)." Doc.end + ServerT TeamsAPI (Handler r) +servantAPI = + Named @"send-team-invitation" createInvitationPublicH + :<|> Named @"get-team-invitations" listInvitations + :<|> Named @"get-team-invitation" getInvitation + :<|> Named @"delete-team-invitation" deleteInvitation + :<|> Named @"get-team-invitation-info" getInvitationByCode + :<|> Named @"head-team-invitations" headInvitationByEmail + :<|> Named @"get-team-size" teamSizePublic routesInternal :: Members @@ -231,9 +130,6 @@ routesInternal = do accept "application" "json" .&. jsonRequest @NewUserScimInvitation -teamSizePublicH :: Members '[GalleyProvider] r => JSON ::: UserId ::: TeamId -> (Handler r) Response -teamSizePublicH (_ ::: uid ::: tid) = json <$> teamSizePublic uid tid - teamSizePublic :: Members '[GalleyProvider] 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 @@ -266,16 +162,17 @@ createInvitationPublicH :: GalleyProvider ] r => - JSON ::: UserId ::: TeamId ::: JsonRequest Public.InvitationRequest -> - (Handler r) Response -createInvitationPublicH (_ ::: uid ::: tid ::: req) = do - body <- parseJsonBody req - newInv <- createInvitationPublic uid tid body - pure . setStatus status201 . loc (inInvitation newInv) . json $ newInv + UserId -> + TeamId -> + Public.InvitationRequest -> + Handler r (Public.Invitation, Public.InvitationLocation) +createInvitationPublicH uid tid body = do + inv <- createInvitationPublic uid tid body + pure (inv, loc inv) where - loc iid = - addHeader "Location" $ - "/teams/" <> toByteString' tid <> "/invitations/" <> toByteString' iid + loc :: Invitation -> InvitationLocation + loc inv = + InvitationLocation $ "/teams/" <> toByteString' tid <> "/invitations/" <> toByteString' (inInvitation inv) data CreateInvitationInviter = CreateInvitationInviter { inviterUid :: UserId, @@ -298,7 +195,7 @@ createInvitationPublic uid tid body = do inviter <- do let inviteePerms = Team.rolePermissions inviteeRole idt <- maybe (throwStd (errorToWai @'E.NoIdentity)) pure =<< lift (fetchUserIdentity uid) - from <- maybe (throwStd noEmail) pure (emailIdentity idt) + from <- maybe (throwStd (errorToWai @'E.NoEmail)) pure (emailIdentity idt) ensurePermissionToAddUser uid tid inviteePerms pure $ CreateInvitationInviter uid from @@ -436,55 +333,37 @@ createInvitation' tid inviteeRole mbInviterUid fromEmail body = do timeout (newInv, code) <$ sendInvitationMail inviteeEmail tid fromEmail code locale -deleteInvitationH :: Members '[GalleyProvider] r => JSON ::: UserId ::: TeamId ::: InvitationId -> (Handler r) Response -deleteInvitationH (_ ::: uid ::: tid ::: iid) = do - empty <$ deleteInvitation uid tid iid - deleteInvitation :: Members '[GalleyProvider] r => UserId -> TeamId -> InvitationId -> (Handler r) () deleteInvitation uid tid iid = do ensurePermissions uid tid [AddTeamMember] lift $ wrapClient $ DB.deleteInvitation tid iid -listInvitationsH :: Members '[GalleyProvider] r => JSON ::: UserId ::: TeamId ::: Maybe InvitationId ::: Range 1 500 Int32 -> (Handler r) Response -listInvitationsH (_ ::: uid ::: tid ::: start ::: size) = do - json <$> listInvitations uid tid start size - -listInvitations :: Members '[GalleyProvider] r => UserId -> TeamId -> Maybe InvitationId -> Range 1 500 Int32 -> (Handler r) Public.InvitationList -listInvitations uid tid start size = do +listInvitations :: Members '[GalleyProvider] 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 $ GalleyProvider.getExposeInvitationURLsToTeamAdmin tid - rs <- lift $ wrapClient $ DB.lookupInvitations showInvitationUrl tid start size + rs <- lift $ wrapClient $ DB.lookupInvitations showInvitationUrl tid start (fromMaybe (unsafeRange 100) mSize) pure $! Public.InvitationList (DB.resultList rs) (DB.resultHasMore rs) -getInvitationH :: Members '[GalleyProvider] r => JSON ::: UserId ::: TeamId ::: InvitationId -> (Handler r) Response -getInvitationH (_ ::: uid ::: tid ::: iid) = do - inv <- getInvitation uid tid iid - pure $ case inv of - Just i -> json i - Nothing -> setStatus status404 empty - getInvitation :: Members '[GalleyProvider] r => UserId -> TeamId -> InvitationId -> (Handler r) (Maybe Public.Invitation) getInvitation uid tid iid = do ensurePermissions uid tid [AddTeamMember] showInvitationUrl <- lift $ liftSem $ GalleyProvider.getExposeInvitationURLsToTeamAdmin tid lift $ wrapClient $ DB.lookupInvitation showInvitationUrl tid iid -getInvitationByCodeH :: JSON ::: Public.InvitationCode -> (Handler r) Response -getInvitationByCodeH (_ ::: c) = do - json <$> getInvitationByCode c - getInvitationByCode :: Public.InvitationCode -> (Handler r) Public.Invitation getInvitationByCode c = do inv <- lift . wrapClient $ DB.lookupInvitationByCode HideInvitationUrl c maybe (throwStd $ errorToWai @'E.InvalidInvitationCode) pure inv -headInvitationByEmailH :: JSON ::: Email -> (Handler r) Response -headInvitationByEmailH (_ ::: e) = do - inv <- lift $ wrapClient $ DB.lookupInvitationInfoByEmail e - pure $ case inv of - DB.InvitationByEmail _ -> setStatus status200 empty - DB.InvitationByEmailNotFound -> setStatus status404 empty - DB.InvitationByEmailMoreThanOne -> setStatus status409 empty +headInvitationByEmail :: Email -> (Handler r) Public.HeadInvitationByEmailResult +headInvitationByEmail e = do + lift $ + wrapClient $ + DB.lookupInvitationInfoByEmail e <&> \case + DB.InvitationByEmail _ -> Public.InvitationByEmail + DB.InvitationByEmailNotFound -> Public.InvitationByEmailNotFound + DB.InvitationByEmailMoreThanOne -> Public.InvitationByEmailMoreThanOne -- | FUTUREWORK: This should also respond with status 409 in case of -- @DB.InvitationByEmailMoreThanOne@. Refactor so that 'headInvitationByEmailH' and diff --git a/services/brig/src/Brig/Team/DB.hs b/services/brig/src/Brig/Team/DB.hs index 4af2ad91ec1..f48a42534ae 100644 --- a/services/brig/src/Brig/Team/DB.hs +++ b/services/brig/src/Brig/Team/DB.hs @@ -32,8 +32,8 @@ module Brig.Team.DB lookupInvitationByEmail, mkInvitationCode, mkInvitationId, - InvitationInfo (..), InvitationByEmail (..), + InvitationInfo (..), ) where @@ -61,7 +61,7 @@ import OpenSSL.Random (randBytes) import qualified System.Logger.Class as Log import URI.ByteString import UnliftIO.Async (pooledMapConcurrentlyN_) -import Wire.API.Team.Invitation +import Wire.API.Team.Invitation hiding (HeadInvitationByEmailResult (..)) import Wire.API.Team.Role import Wire.API.User diff --git a/services/brig/test/integration/API/Team.hs b/services/brig/test/integration/API/Team.hs index 68f72811597..7df81805cf6 100644 --- a/services/brig/test/integration/API/Team.hs +++ b/services/brig/test/integration/API/Team.hs @@ -89,6 +89,8 @@ tests conf m n b c g aws = do "team" [ testGroup "invitation" $ [ test m "post /teams/:tid/invitations - 201" $ testInvitationEmail b, + test m "get /teams/:tid/invitations/:iid - 200" $ testGetInvitation b, + test m "delete /teams/:tid/invitations/:iid - 200" $ testDeleteInvitation b, test m "post /teams/:tid/invitations - invitation url" $ testInvitationUrl conf b, test m "post /teams/:tid/invitations - no invitation url" $ testNoInvitationUrl conf b, test m "post /teams/:tid/invitations - email lookup" $ testInvitationEmailLookup b, @@ -125,26 +127,37 @@ tests conf m n b c g aws = do test m "get /i/teams/:tid/is-team-owner/:uid" $ testSSOIsTeamOwner b g, test m "2FA disabled for SSO user" $ test2FaDisabledForSsoUser b g ], - testGroup "size" $ [test m "get /i/teams/:tid/size" $ testTeamSize b] + testGroup "size" $ + [ test m "get /i/teams/:tid/size" $ testTeamSizeInternal b, + test m "get /teams/:tid/size" $ testTeamSizePublic b + ] ] -testTeamSize :: Brig -> Http () -testTeamSize brig = do - (tid, _, _) <- createPopulatedBindingTeam brig 10 +testTeamSizeInternal :: Brig -> Http () +testTeamSizeInternal brig = do + testTeamSize brig (\tid _ -> brig . paths ["i", "teams", toByteString' tid, "size"]) + +testTeamSizePublic :: Brig -> Http () +testTeamSizePublic brig = do + testTeamSize brig (\tid uid -> brig . paths ["teams", toByteString' tid, "size"] . zUser uid) + +testTeamSize :: Brig -> (TeamId -> UserId -> Request -> Request) -> Http () +testTeamSize brig req = do + (tid, owner, _) <- createPopulatedBindingTeam brig 10 SearchUtil.refreshIndex brig -- 10 Team Members and an admin let expectedSize = 11 - assertSize tid expectedSize + assertSize tid owner expectedSize -- Even suspended teams should report correct size suspendTeam brig tid !!! const 200 === statusCode SearchUtil.refreshIndex brig - assertSize tid expectedSize + assertSize tid owner expectedSize where - assertSize :: HasCallStack => TeamId -> Natural -> Http () - assertSize tid expectedSize = + assertSize :: HasCallStack => TeamId -> UserId -> Natural -> Http () + assertSize tid uid expectedSize = void $ - get (brig . paths ["i", "teams", toByteString' tid, "size"]) toByteString' tid <> "/invitations/" <> toByteString' (inInvitation inv) liftIO $ do Just inviter @=? inCreatedBy inv tid @=? inTeam inv assertInvitationResponseInvariants invite inv (isNothing . inInviteeUrl) inv @? "No invitation url expected" + actualHeader @?= Just expectedHeader assertInvitationResponseInvariants :: InvitationRequest -> Invitation -> Assertion assertInvitationResponseInvariants invReq inv = do @@ -204,6 +220,22 @@ assertInvitationResponseInvariants invReq inv = do irInviteePhone invReq @=? inInviteePhone inv irInviteeEmail invReq @=? inInviteeEmail inv +testGetInvitation :: Brig -> Http () +testGetInvitation brig = do + (inviter, tid) <- createUserWithTeam brig + invite <- stdInvitationRequest <$> randomEmail + inv1 <- responseJsonError =<< postInvitation brig tid inviter invite Http () +testDeleteInvitation brig = do + (inviter, tid) <- createUserWithTeam brig + invite <- stdInvitationRequest <$> randomEmail + iid <- inInvitation <$> (responseJsonError =<< postInvitation brig tid inviter invite Brig -> Http () @@ -465,7 +497,7 @@ createAndVerifyInvitation' replacementBrigApp acceptFn invite brig galley = do inv <- responseJsonError =<< postInvitation brig tid inviter invite let invmeta = Just (inviter, inCreatedAt inv) Just inviteeCode <- getInvitationCode brig tid (inInvitation inv) - Just invitation <- getInvitation brig inviteeCode + Just invitation <- getInvitationInfo brig inviteeCode rsp2 <- post ( brig @@ -572,8 +604,7 @@ testTeamNoPassword brig = do ] ) ) - !!! const 400 - === statusCode + !!! const 400 === statusCode -- And so do any other binding team members code <- liftIO $ InvitationCode . Ascii.encodeBase64Url <$> randomBytes 24 post @@ -589,8 +620,7 @@ testTeamNoPassword brig = do ] ) ) - !!! const 400 - === statusCode + !!! const 400 === statusCode testInvitationCodeExists :: Brig -> Http () testInvitationCodeExists brig = do @@ -709,7 +739,8 @@ testInvitationPaging brig = do let range = queryRange (toByteString' <$> start) (Just step) r <- get (brig . paths ["teams", toByteString' tid, "invitations"] . zUser uid . range) - responseJsonMaybe r liftIO $ assertEqual "page size" actualPageLen (length invs) liftIO $ assertEqual "has more" (count' < total) more @@ -736,7 +767,7 @@ testInvitationInfo brig = do let invite = stdInvitationRequest email inv <- responseJsonError =<< postInvitation brig tid uid invite Just invCode <- getInvitationCode brig tid (inInvitation inv) - Just invitation <- getInvitation brig invCode + Just invitation <- getInvitationInfo brig invCode liftIO $ assertEqual "Invitations differ" inv invitation testInvitationInfoBadCode :: Brig -> Http () diff --git a/services/brig/test/integration/API/Team/Util.hs b/services/brig/test/integration/API/Team/Util.hs index 6fa61788ab3..bc55820c78a 100644 --- a/services/brig/test/integration/API/Team/Util.hs +++ b/services/brig/test/integration/API/Team/Util.hs @@ -350,8 +350,8 @@ register' e t c brig = ) ) -getInvitation :: Brig -> InvitationCode -> (MonadIO m, MonadHttp m) => m (Maybe Invitation) -getInvitation brig c = do +getInvitationInfo :: Brig -> InvitationCode -> (MonadIO m, MonadHttp m) => m (Maybe Invitation) +getInvitationInfo brig c = do r <- get $ brig @@ -359,6 +359,14 @@ getInvitation brig c = do . queryItem "code" (toByteString' c) pure . decode . fromMaybe "" $ responseBody r +getInvitation :: Brig -> TeamId -> InvitationId -> UserId -> Http ResponseLBS +getInvitation brig tid iid uid = + get (brig . paths ["teams", toByteString' tid, "invitations", toByteString' iid] . zUser uid) + +deleteInvitation :: Brig -> TeamId -> InvitationId -> UserId -> Http () +deleteInvitation brig tid iid uid = + delete (brig . paths ["teams", toByteString' tid, "invitations", toByteString' iid] . zUser uid) !!! const 200 === statusCode + postInvitation :: (MonadIO m, MonadHttp m, HasCallStack) => Brig -> From dea19993444fe49be06c1e066bb0682a3a23e1ab Mon Sep 17 00:00:00 2001 From: Lucendio Date: Mon, 14 Nov 2022 13:58:36 +0100 Subject: [PATCH 37/76] [charts:sftd,restund,coturn] Fix case when hostname is not node name (#2837) * [charts] Fix case when hostname is not node name Kubernetes might be installed in a way where the machine hostname is not used as node name. Using the statefulset's spec to determine the node name would allow for such deviation. * add changelog Co-authored-by: Florian Klink --- .../3-bug-fixes/sftd-restund-coturn-hostname-nodename | 1 + charts/coturn/templates/statefulset.yaml | 9 +++++++-- charts/restund/templates/statefulset.yaml | 9 +++++++-- charts/sftd/templates/statefulset.yaml | 9 +++++++-- 4 files changed, 22 insertions(+), 6 deletions(-) create mode 100644 changelog.d/3-bug-fixes/sftd-restund-coturn-hostname-nodename diff --git a/changelog.d/3-bug-fixes/sftd-restund-coturn-hostname-nodename b/changelog.d/3-bug-fixes/sftd-restund-coturn-hostname-nodename new file mode 100644 index 00000000000..fdf9bddc062 --- /dev/null +++ b/changelog.d/3-bug-fixes/sftd-restund-coturn-hostname-nodename @@ -0,0 +1 @@ +For sftd/coturn/restund, fixed a bug in external ip address lookup, in case Kubernetes Node Name doesn't equal hostname. diff --git a/charts/coturn/templates/statefulset.yaml b/charts/coturn/templates/statefulset.yaml index 8ab28192b5d..37ce6aef3e3 100644 --- a/charts/coturn/templates/statefulset.yaml +++ b/charts/coturn/templates/statefulset.yaml @@ -60,6 +60,11 @@ spec: volumeMounts: - name: external-ip mountPath: /external-ip + env: + - name: NODE_NAME + valueFrom: + fieldRef: + fieldPath: spec.nodeName command: - /bin/sh - -c @@ -67,10 +72,10 @@ spec: set -e # In the cloud, this setting is available to indicate the true IP address - addr=$(kubectl get node $HOSTNAME -ojsonpath='{.status.addresses[?(@.type=="ExternalIP")].address}') + addr=$(kubectl get node $NODE_NAME -ojsonpath='{.status.addresses[?(@.type=="ExternalIP")].address}') # On on-prem we allow people to set "wire.com/external-ip" to override this if [ -z "$addr" ]; then - addr=$(kubectl get node $HOSTNAME -ojsonpath='{.metadata.annotations.wire\.com/external-ip}') + addr=$(kubectl get node $NODE_NAME -ojsonpath='{.metadata.annotations.wire\.com/external-ip}') fi echo -n "$addr" | tee /dev/stderr > /external-ip/ip containers: diff --git a/charts/restund/templates/statefulset.yaml b/charts/restund/templates/statefulset.yaml index 6063b38d60a..da29825c4d7 100644 --- a/charts/restund/templates/statefulset.yaml +++ b/charts/restund/templates/statefulset.yaml @@ -53,6 +53,11 @@ spec: volumeMounts: - name: external-ip mountPath: /external-ip + env: + - name: NODE_NAME + valueFrom: + fieldRef: + fieldPath: spec.nodeName command: - /bin/sh - -c @@ -60,11 +65,11 @@ spec: set -e # In the cloud, this setting is available to indicate the true IP address - addr=$(kubectl get node $HOSTNAME -ojsonpath='{.status.addresses[?(@.type=="ExternalIP")].address}') + addr=$(kubectl get node $NODE_NAME -ojsonpath='{.status.addresses[?(@.type=="ExternalIP")].address}') # On on-prem we allow people to set "wire.com/external-ip" to override this if [ -z "$addr" ]; then - addr=$(kubectl get node $HOSTNAME -ojsonpath='{.metadata.annotations.wire\.com/external-ip}') + addr=$(kubectl get node $NODE_NAME -ojsonpath='{.metadata.annotations.wire\.com/external-ip}') fi echo -n "$addr" | tee /dev/stderr > /external-ip/ip containers: diff --git a/charts/sftd/templates/statefulset.yaml b/charts/sftd/templates/statefulset.yaml index 3027ccf601d..e9329922bff 100644 --- a/charts/sftd/templates/statefulset.yaml +++ b/charts/sftd/templates/statefulset.yaml @@ -43,6 +43,11 @@ spec: volumeMounts: - name: external-ip mountPath: /external-ip + env: + - name: NODE_NAME + valueFrom: + fieldRef: + fieldPath: spec.nodeName command: - /bin/sh - -c @@ -50,11 +55,11 @@ spec: set -e # In the cloud, this setting is available to indicate the true IP address - addr=$(kubectl get node $HOSTNAME -ojsonpath='{.status.addresses[?(@.type=="ExternalIP")].address}') + addr=$(kubectl get node $NODE_NAME -ojsonpath='{.status.addresses[?(@.type=="ExternalIP")].address}') # On on-prem we allow people to set "wire.com/external-ip" to override this if [ -z "$addr" ]; then - addr=$(kubectl get node $HOSTNAME -ojsonpath='{.metadata.annotations.wire\.com/external-ip}') + addr=$(kubectl get node $NODE_NAME -ojsonpath='{.metadata.annotations.wire\.com/external-ip}') fi echo -n "$addr" | tee /dev/stderr > /external-ip/ip - name: get-multi-sft-config From caf7a86105ad29a714cb78ca510843926c308b5a Mon Sep 17 00:00:00 2001 From: Arthur Wolf Date: Tue, 15 Nov 2022 10:56:12 +0100 Subject: [PATCH 38/76] add note about direnv allow --- docs/README.md | 8 ++++++++ 1 file changed, 8 insertions(+) diff --git a/docs/README.md b/docs/README.md index dbcbe4e9302..4dcfc99fb86 100644 --- a/docs/README.md +++ b/docs/README.md @@ -69,6 +69,14 @@ and Direnv installed. This folder contains another `.envrc` file that adds all the binaries needed to build the docs to `$PATH`. +In short, when you `cd` into this folder, you should see this message: + +```sh +direnv: error wire-server/docs/.envrc is blocked. Run `direnv allow` to approve its content +``` + +Run `direnv allow` to allow the `.envrc` file to modify your environment, and you should then have all the binaries/correct environment needed to build the docs. + ### Generating html output (one-off) ``` From 815cbbd0730a39f0fd04a00af023b5a1bcf9c7a5 Mon Sep 17 00:00:00 2001 From: Paolo Capriotti Date: Tue, 15 Nov 2022 14:32:21 +0100 Subject: [PATCH 39/76] Simplify and cleanup MLS message handling (#2844) * Store group info outside commit processing * Extract external commit logic * Avoid multiple pattern matches on sender * Remove redundand epoch check * Add ClientId to MLS messaging API * Add CHANGELOG entry * Store group info bundle after processing commit --- changelog.d/5-internal/refactor-mls-message | 1 + libs/wire-api/src/Wire/API/Routes/Public.hs | 3 + .../src/Wire/API/Routes/Public/Galley/MLS.hs | 3 + services/galley/src/Galley/API/Federation.hs | 4 +- services/galley/src/Galley/API/MLS/Message.hs | 349 +++++++++++------- 5 files changed, 228 insertions(+), 132 deletions(-) create mode 100644 changelog.d/5-internal/refactor-mls-message diff --git a/changelog.d/5-internal/refactor-mls-message b/changelog.d/5-internal/refactor-mls-message new file mode 100644 index 00000000000..6cbf9538d59 --- /dev/null +++ b/changelog.d/5-internal/refactor-mls-message @@ -0,0 +1 @@ +Refactor and simplify MLS message handling logic diff --git a/libs/wire-api/src/Wire/API/Routes/Public.hs b/libs/wire-api/src/Wire/API/Routes/Public.hs index c616d1f49c8..deff0d727c5 100644 --- a/libs/wire-api/src/Wire/API/Routes/Public.hs +++ b/libs/wire-api/src/Wire/API/Routes/Public.hs @@ -25,6 +25,7 @@ module Wire.API.Routes.Public ZLocalUser, ZConn, ZOptUser, + ZOptClient, ZOptConn, ZBot, ZConversation, @@ -179,6 +180,8 @@ type ZProvider = ZAuthServant 'ZAuthProvider InternalAuthDefOpts type ZOptUser = ZAuthServant 'ZAuthUser '[Servant.Optional, Servant.Strict] +type ZOptClient = ZAuthServant 'ZAuthClient '[Servant.Optional, Servant.Strict] + type ZOptConn = ZAuthServant 'ZAuthConn '[Servant.Optional, Servant.Strict] instance HasSwagger api => HasSwagger (ZAuthServant 'ZAuthUser _opts :> api) where diff --git a/libs/wire-api/src/Wire/API/Routes/Public/Galley/MLS.hs b/libs/wire-api/src/Wire/API/Routes/Public/Galley/MLS.hs index 5a2c51997ea..961668ec826 100644 --- a/libs/wire-api/src/Wire/API/Routes/Public/Galley/MLS.hs +++ b/libs/wire-api/src/Wire/API/Routes/Public/Galley/MLS.hs @@ -65,6 +65,7 @@ type MLSMessagingAPI = :> CanThrow 'MissingLegalholdConsent :> CanThrow MLSProposalFailure :> "messages" + :> ZOptClient :> ZConn :> ReqBody '[MLS] (RawMLS SomeMessage) :> MultiVerb1 'POST '[JSON] (Respond 201 "Message sent" [Event]) @@ -91,6 +92,7 @@ type MLSMessagingAPI = :> CanThrow 'MissingLegalholdConsent :> CanThrow MLSProposalFailure :> "messages" + :> ZOptClient :> ZConn :> ReqBody '[MLS] (RawMLS SomeMessage) :> MultiVerb1 'POST '[JSON] (Respond 201 "Message sent" MLSMessageSendingStatus) @@ -118,6 +120,7 @@ type MLSMessagingAPI = :> CanThrow 'MissingLegalholdConsent :> CanThrow MLSProposalFailure :> "commit-bundles" + :> ZOptClient :> ZConn :> ReqBody '[CommitBundleMimeType] CommitBundle :> MultiVerb1 'POST '[JSON] (Respond 201 "Commit accepted and forwarded" MLSMessageSendingStatus) diff --git a/services/galley/src/Galley/API/Federation.hs b/services/galley/src/Galley/API/Federation.hs index 00f6fb2a33e..06f461f9112 100644 --- a/services/galley/src/Galley/API/Federation.hs +++ b/services/galley/src/Galley/API/Federation.hs @@ -636,7 +636,7 @@ sendMLSCommitBundle remoteDomain msr = qcnv <- E.getConversationIdByGroupId (msgGroupId msg) >>= noteS @'ConvNotFound when (qUnqualified qcnv /= F.msrConvId msr) $ throwS @'MLSGroupConversationMismatch F.MLSMessageResponseUpdates . map lcuUpdate - <$> postMLSCommitBundle loc (qUntagged sender) qcnv Nothing bundle + <$> postMLSCommitBundle loc (qUntagged sender) Nothing qcnv Nothing bundle sendMLSMessage :: ( Members @@ -680,7 +680,7 @@ sendMLSMessage remoteDomain msr = qcnv <- E.getConversationIdByGroupId (msgGroupId msg) >>= noteS @'ConvNotFound when (qUnqualified qcnv /= F.msrConvId msr) $ throwS @'MLSGroupConversationMismatch F.MLSMessageResponseUpdates . map lcuUpdate - <$> postMLSMessage loc (qUntagged sender) qcnv Nothing raw + <$> postMLSMessage loc (qUntagged sender) Nothing qcnv Nothing raw class ToGalleyRuntimeError (effs :: EffectRow) r where mapToGalleyError :: diff --git a/services/galley/src/Galley/API/MLS/Message.hs b/services/galley/src/Galley/API/MLS/Message.hs index f5bd3d7a5c9..170c53e1b73 100644 --- a/services/galley/src/Galley/API/MLS/Message.hs +++ b/services/galley/src/Galley/API/MLS/Message.hs @@ -136,14 +136,15 @@ postMLSMessageFromLocalUserV1 :: r ) => Local UserId -> + Maybe ClientId -> ConnId -> RawMLS SomeMessage -> Sem r [Event] -postMLSMessageFromLocalUserV1 lusr conn smsg = case rmValue smsg of +postMLSMessageFromLocalUserV1 lusr mc conn smsg = case rmValue smsg of SomeMessage _ msg -> do qcnv <- getConversationIdByGroupId (msgGroupId msg) >>= noteS @'ConvNotFound map lcuEvent - <$> postMLSMessage lusr (qUntagged lusr) qcnv (Just conn) smsg + <$> postMLSMessage lusr (qUntagged lusr) mc qcnv (Just conn) smsg postMLSMessageFromLocalUser :: ( HasProposalEffects r, @@ -169,13 +170,14 @@ postMLSMessageFromLocalUser :: r ) => Local UserId -> + Maybe ClientId -> ConnId -> RawMLS SomeMessage -> Sem r MLSMessageSendingStatus -postMLSMessageFromLocalUser lusr conn msg = do +postMLSMessageFromLocalUser lusr mc conn msg = do -- FUTUREWORK: Inline the body of 'postMLSMessageFromLocalUserV1' once version -- V1 is dropped - events <- postMLSMessageFromLocalUserV1 lusr conn msg + events <- postMLSMessageFromLocalUserV1 lusr mc conn msg t <- toUTCTimeMillis <$> input pure $ MLSMessageSendingStatus events t @@ -199,14 +201,15 @@ postMLSCommitBundle :: ) => Local x -> Qualified UserId -> + Maybe ClientId -> Qualified ConvId -> Maybe ConnId -> CommitBundle -> Sem r [LocalConversationUpdate] -postMLSCommitBundle loc qusr qcnv conn rawBundle = +postMLSCommitBundle loc qusr mc qcnv conn rawBundle = foldQualified loc - (postMLSCommitBundleToLocalConv qusr conn rawBundle) + (postMLSCommitBundleToLocalConv qusr mc conn rawBundle) (postMLSCommitBundleToRemoteConv loc qusr conn rawBundle) qcnv @@ -228,15 +231,16 @@ postMLSCommitBundleFromLocalUser :: r ) => Local UserId -> + Maybe ClientId -> ConnId -> CommitBundle -> Sem r MLSMessageSendingStatus -postMLSCommitBundleFromLocalUser lusr conn bundle = do +postMLSCommitBundleFromLocalUser lusr mc conn bundle = do let msg = rmValue (cbCommitMsg bundle) qcnv <- getConversationIdByGroupId (msgGroupId msg) >>= noteS @'ConvNotFound events <- map lcuEvent - <$> postMLSCommitBundle lusr (qUntagged lusr) qcnv (Just conn) bundle + <$> postMLSCommitBundle lusr (qUntagged lusr) mc qcnv (Just conn) bundle t <- toUTCTimeMillis <$> input pure $ MLSMessageSendingStatus events t @@ -258,17 +262,18 @@ postMLSCommitBundleToLocalConv :: r ) => Qualified UserId -> + Maybe ClientId -> Maybe ConnId -> CommitBundle -> Local ConvId -> Sem r [LocalConversationUpdate] -postMLSCommitBundleToLocalConv qusr conn bundle lcnv = do +postMLSCommitBundleToLocalConv qusr mc conn bundle lcnv = do let msg = rmValue (cbCommitMsg bundle) conv <- getLocalConvForUser qusr lcnv let lconv = qualifyAs lcnv conv cm <- lookupMLSClients lcnv - senderClient <- fmap ciClient <$> getSenderClient qusr SMLSPlainText msg + senderClient <- fmap ciClient <$> getSenderIdentity qusr mc SMLSPlainText msg events <- case msgPayload msg of CommitMessage commit -> @@ -281,18 +286,20 @@ postMLSCommitBundleToLocalConv qusr conn bundle lcnv = do /= Set.fromList (map (snd . snd) (cmAssocs (paAdd action))) ) $ throwS @'MLSWelcomeMismatch - processCommitWithAction - qusr - senderClient - conn - lconv - cm - (msgEpoch msg) - groupId - action - (msgSender msg) - (Just . cbGroupInfoBundle $ bundle) - commit + updates <- + processCommitWithAction + qusr + senderClient + conn + lconv + cm + (msgEpoch msg) + groupId + action + (msgSender msg) + commit + storeGroupInfoBundle lconv (cbGroupInfoBundle bundle) + pure updates ApplicationMessage _ -> throwS @'MLSUnsupportedMessage ProposalMessage _ -> throwS @'MLSUnsupportedMessage @@ -372,17 +379,18 @@ postMLSMessage :: ) => Local x -> Qualified UserId -> + Maybe ClientId -> Qualified ConvId -> Maybe ConnId -> RawMLS SomeMessage -> Sem r [LocalConversationUpdate] -postMLSMessage loc qusr qcnv con smsg = case rmValue smsg of +postMLSMessage loc qusr mc qcnv con smsg = case rmValue smsg of SomeMessage tag msg -> do - mcid <- fmap ciClient <$> getSenderClient qusr tag msg + mSender <- fmap ciClient <$> getSenderIdentity qusr mc tag msg foldQualified loc - (postMLSMessageToLocalConv qusr mcid con smsg) - (postMLSMessageToRemoteConv loc qusr mcid con smsg) + (postMLSMessageToLocalConv qusr mSender con smsg) + (postMLSMessageToRemoteConv loc qusr mSender con smsg) qcnv -- Check that the MLS client who created the message belongs to the user who @@ -400,7 +408,7 @@ getSenderClient :: Qualified UserId -> SWireFormatTag tag -> Message tag -> - Sem r (Maybe ClientIdentity) + Sem r (Maybe ClientId) getSenderClient _ SMLSCipherText _ = pure Nothing getSenderClient _ _ msg | msgEpoch msg == Epoch 0 = pure Nothing getSenderClient qusr SMLSPlainText msg = case msgSender msg of @@ -410,7 +418,30 @@ getSenderClient qusr SMLSPlainText msg = case msgSender msg of cid <- derefKeyPackage ref when (fmap fst (cidQualifiedClient cid) /= qusr) $ throwS @'MLSClientSenderUserMismatch - pure (Just cid) + pure (Just (ciClient cid)) + +-- FUTUREWORK: once we can assume that the Z-Client header is present (i.e. +-- when v2 is dropped), remove the Maybe in the return type. +getSenderIdentity :: + ( Members + '[ ErrorS 'MLSKeyPackageRefNotFound, + ErrorS 'MLSClientSenderUserMismatch, + BrigAccess + ] + r + ) => + Qualified UserId -> + Maybe ClientId -> + SWireFormatTag tag -> + Message tag -> + Sem r (Maybe ClientIdentity) +getSenderIdentity qusr mc fmt msg = do + mSender <- getSenderClient qusr fmt msg + -- At this point, mc is the client ID of the request, while mSender is the + -- one contained in the message. We throw an error if the two don't match. + when (((==) <$> mc <*> mSender) == Just False) $ + throwS @'MLSClientSenderUserMismatch + pure (mkClientIdentity qusr <$> mSender) postMLSMessageToLocalConv :: ( HasProposalEffects r, @@ -608,7 +639,93 @@ processCommit :: Sem r [LocalConversationUpdate] processCommit qusr senderClient con lconv cm epoch sender commit = do (groupId, action) <- getCommitData lconv epoch commit - processCommitWithAction qusr senderClient con lconv cm epoch groupId action sender Nothing commit + processCommitWithAction qusr senderClient con lconv cm epoch groupId action sender commit + +processExternalCommit :: + forall r. + Members + '[ BrigAccess, + ConversationStore, + Error MLSProtocolError, + ErrorS 'MLSStaleMessage, + ErrorS 'MLSClientSenderUserMismatch, + ErrorS 'MLSKeyPackageRefNotFound, + MemberStore, + Resource + ] + r => + Qualified UserId -> + Local Data.Conversation -> + Epoch -> + GroupId -> + ProposalAction -> + Maybe UpdatePath -> + Sem r () +processExternalCommit qusr lconv epoch groupId action updatePath = withCommitLock groupId epoch $ do + newKeyPackage <- + upLeaf + <$> note + (mlsProtocolError "External commits need an update path") + updatePath + when (paExternalInit action == mempty) $ + throw . mlsProtocolError $ + "The external commit is missing an external init proposal" + unless (paAdd action == mempty) $ + throw . mlsProtocolError $ + "The external commit must not have add proposals" + + cid <- case kpIdentity (rmValue newKeyPackage) of + Left e -> throw (mlsProtocolError $ "Failed to parse the client identity: " <> e) + Right v -> pure v + newRef <- + kpRef' newKeyPackage + & note (mlsProtocolError "An invalid key package in the update path") + + -- check if there is a key package ref in the remove proposal + remRef <- + if Map.null (paRemove action) + then pure Nothing + else do + (remCid, r) <- derefUser (paRemove action) qusr + unless (cidQualifiedUser cid == cidQualifiedUser remCid) + . throw + . mlsProtocolError + $ "The external commit attempts to remove a client from a user other than themselves" + pure (Just r) + + -- first perform checks and map the key package if valid + addKeyPackageRef + newRef + (cidQualifiedUser cid) + (ciClient cid) + (Data.convId <$> qUntagged lconv) + -- now it is safe to update the mapping without further checks + updateKeyPackageMapping lconv qusr (ciClient cid) remRef newRef + + -- FUTUREWORK: Resubmit backend-provided proposals when processing an + -- external commit. + + -- increment epoch number + setConversationEpoch (Data.convId (tUnqualified lconv)) (succ epoch) + where + derefUser :: ClientMap -> Qualified UserId -> Sem r (ClientIdentity, KeyPackageRef) + derefUser (Map.toList -> l) user = case l of + [(u, s)] -> do + unless (user == u) $ + throwS @'MLSClientSenderUserMismatch + ref <- snd <$> ensureSingleton s + ci <- derefKeyPackage ref + unless (cidQualifiedUser ci == user) $ + throwS @'MLSClientSenderUserMismatch + pure (ci, ref) + _ -> throwRemProposal + ensureSingleton :: Set a -> Sem r a + ensureSingleton (Set.toList -> l) = case l of + [e] -> pure e + _ -> throwRemProposal + throwRemProposal = + throw . mlsProtocolError $ + "The external commit must have at most one remove proposal" processCommitWithAction :: forall r. @@ -636,136 +753,95 @@ processCommitWithAction :: GroupId -> ProposalAction -> Sender 'MLSPlainText -> - Maybe GroupInfoBundle -> Commit -> Sem r [LocalConversationUpdate] -processCommitWithAction qusr senderClient con lconv cm epoch groupId action sender mGIBundle commit = do +processCommitWithAction qusr senderClient con lconv cm epoch groupId action sender commit = + case sender of + MemberSender ref -> processInternalCommit qusr senderClient con lconv cm epoch groupId action ref commit + NewMemberSender -> processExternalCommit qusr lconv epoch groupId action (cPath commit) $> [] + _ -> throw (mlsProtocolError "Unexpected sender") + +processInternalCommit :: + forall r. + ( HasProposalEffects r, + Member (Error FederationError) r, + Member (Error InternalError) r, + Member (ErrorS 'ConvNotFound) r, + Member (ErrorS 'MLSClientSenderUserMismatch) r, + Member (ErrorS 'MLSCommitMissingReferences) r, + Member (ErrorS 'MLSProposalNotFound) r, + Member (ErrorS 'MLSSelfRemovalNotAllowed) r, + Member (ErrorS 'MLSStaleMessage) r, + Member (ErrorS 'MissingLegalholdConsent) r, + Member (Input (Local ())) r, + Member ProposalStore r, + Member BrigAccess r, + Member Resource r + ) => + Qualified UserId -> + Maybe ClientId -> + Maybe ConnId -> + Local Data.Conversation -> + ClientMap -> + Epoch -> + GroupId -> + ProposalAction -> + KeyPackageRef -> + Commit -> + Sem r [LocalConversationUpdate] +processInternalCommit qusr senderClient con lconv cm epoch groupId action senderRef commit = do self <- noteS @'ConvNotFound $ getConvMember lconv (tUnqualified lconv) qusr - let ttlSeconds :: Int = 600 -- 10 minutes - withCommitLock groupId epoch (fromIntegral ttlSeconds) $ do - checkEpoch epoch (tUnqualified lconv) - (postponedKeyPackageRefUpdate, actionWithUpdate) <- + withCommitLock groupId epoch $ do + postponedKeyPackageRefUpdate <- if epoch == Epoch 0 then do -- this is a newly created conversation, and it should contain exactly one -- client (the creator) - case (sender, self, cmAssocs cm) of - (MemberSender currentRef, Left lm, [(qu, (creatorClient, _))]) + case (self, cmAssocs cm) of + (Left lm, [(qu, (creatorClient, _))]) | qu == qUntagged (qualifyAs lconv (lmId lm)) -> do -- use update path as sender reference and if not existing fall back to sender - senderRef <- + senderRef' <- maybe - (pure currentRef) + (pure senderRef) ( note (mlsProtocolError "Could not compute key package ref") . kpRef' . upLeaf ) $ cPath commit -- register the creator client - updateKeyPackageMapping lconv qusr creatorClient Nothing senderRef + updateKeyPackageMapping lconv qusr creatorClient Nothing senderRef' -- remote clients cannot send the first commit - (_, Right _, _) -> throwS @'MLSStaleMessage + (Right _, _) -> throwS @'MLSStaleMessage -- uninitialised conversations should contain exactly one client - (MemberSender _, _, _) -> + (_, _) -> throw (InternalErrorWithDescription "Unexpected creator client set") - -- the sender of the first commit must be a member - _ -> throw (mlsProtocolError "Unexpected sender") - pure $ (pure (), action) -- no key package ref update necessary - else case (sender, upLeaf <$> cPath commit) of - (MemberSender senderRef, Just updatedKeyPackage) -> do + pure $ pure () -- no key package ref update necessary + else case upLeaf <$> cPath commit of + Just updatedKeyPackage -> do updatedRef <- kpRef' updatedKeyPackage & note (mlsProtocolError "Could not compute key package ref") -- postpone key package ref update until other checks/processing passed case senderClient of - Just cli -> pure (updateKeyPackageMapping lconv qusr cli (Just senderRef) updatedRef, action) - Nothing -> pure (pure (), action) - (_, Nothing) -> pure (pure (), action) -- ignore commits without update path - (NewMemberSender, Just newKeyPackage) -> do - -- this is an external commit - when (paExternalInit action == mempty) - . throw - . mlsProtocolError - $ "The external commit is missing an external init proposal" - unless (paAdd action == mempty) - . throw - . mlsProtocolError - $ "The external commit must not have add proposals" - - cid <- case kpIdentity (rmValue newKeyPackage) of - Left e -> throw (mlsProtocolError $ "Failed to parse the client identity: " <> e) - Right v -> pure v - newRef <- - kpRef' newKeyPackage - & note (mlsProtocolError "An invalid key package in the update path") - - -- check if there is a key package ref in the remove proposal - remRef <- - if Map.null (paRemove action) - then pure Nothing - else do - (remCid, r) <- derefUser (paRemove action) qusr - unless (cidQualifiedUser cid == cidQualifiedUser remCid) - . throw - . mlsProtocolError - $ "The external commit attempts to remove a client from a user other than themselves" - pure (Just r) - - -- first perform checks and map the key package if valid - addKeyPackageRef - newRef - (cidQualifiedUser cid) - (ciClient cid) - (Data.convId <$> qUntagged lconv) - -- now it is safe to update the mapping without further checks - updateKeyPackageMapping lconv qusr (ciClient cid) remRef newRef - - pure (pure (), action {paRemove = mempty}) - _ -> throw (mlsProtocolError "Unexpected sender") - - -- FUTUREWORK: Resubmit backend-provided proposals when processing an - -- external commit. - -- - -- check all pending proposals are referenced in the commit. Skip the check - -- if this is an external commit. - when (sender /= NewMemberSender) $ do - allPendingProposals <- getAllPendingProposals groupId epoch - let referencedProposals = Set.fromList $ mapMaybe (\x -> preview Proposal._Ref x) (cProposals commit) - unless (all (`Set.member` referencedProposals) allPendingProposals) $ - throwS @'MLSCommitMissingReferences + Just cli -> pure (updateKeyPackageMapping lconv qusr cli (Just senderRef) updatedRef) + Nothing -> pure (pure ()) + Nothing -> pure (pure ()) -- ignore commits without update path + + -- check all pending proposals are referenced in the commit + allPendingProposals <- getAllPendingProposals groupId epoch + let referencedProposals = Set.fromList $ mapMaybe (\x -> preview Proposal._Ref x) (cProposals commit) + unless (all (`Set.member` referencedProposals) allPendingProposals) $ + throwS @'MLSCommitMissingReferences -- process and execute proposals - updates <- executeProposalAction qusr con lconv cm actionWithUpdate + updates <- executeProposalAction qusr con lconv cm action -- update key package ref if necessary postponedKeyPackageRefUpdate -- increment epoch number setConversationEpoch (Data.convId (tUnqualified lconv)) (succ epoch) - -- set the group info - for_ mGIBundle $ - setPublicGroupState (Data.convId (tUnqualified lconv)) - . toOpaquePublicGroupState - . gipGroupState pure updates - where - throwRemProposal = - throw . mlsProtocolError $ - "The external commit must have at most one remove proposal" - derefUser :: ClientMap -> Qualified UserId -> Sem r (ClientIdentity, KeyPackageRef) - derefUser (Map.toList -> l) user = case l of - [(u, s)] -> do - unless (user == u) $ - throwS @'MLSClientSenderUserMismatch - ref <- snd <$> ensureSingleton s - ci <- derefKeyPackage ref - unless (cidQualifiedUser ci == user) $ - throwS @'MLSClientSenderUserMismatch - pure (ci, ref) - _ -> throwRemProposal - ensureSingleton :: Set a -> Sem r a - ensureSingleton (Set.toList -> l) = case l of - [e] -> pure e - _ -> throwRemProposal -- | Note: Use this only for KeyPackage that are already validated updateKeyPackageMapping :: @@ -1256,14 +1332,27 @@ withCommitLock :: ) => GroupId -> Epoch -> - NominalDiffTime -> Sem r a -> Sem r a -withCommitLock gid epoch ttl action = +withCommitLock gid epoch action = bracket ( acquireCommitLock gid epoch ttl >>= \lockAcquired -> when (lockAcquired == NotAcquired) $ throwS @'MLSStaleMessage ) (const $ releaseCommitLock gid epoch) - (const action) + $ \_ -> do + -- FUTUREWORK: fetch epoch again and check that is matches + action + where + ttl = fromIntegral (600 :: Int) -- 10 minutes + +storeGroupInfoBundle :: + Member ConversationStore r => + Local Data.Conversation -> + GroupInfoBundle -> + Sem r () +storeGroupInfoBundle lconv = + setPublicGroupState (Data.convId (tUnqualified lconv)) + . toOpaquePublicGroupState + . gipGroupState From f01844aaf82717af7c6a094eb4854eb30d7a39e9 Mon Sep 17 00:00:00 2001 From: jschaul Date: Tue, 15 Nov 2022 19:10:48 +0100 Subject: [PATCH 40/76] allow configuring intra-listing in galley, make default=true (#2847) --- changelog.d/5-internal/intra-listing | 1 + charts/galley/templates/configmap.yaml | 2 +- charts/galley/values.yaml | 1 + 3 files changed, 3 insertions(+), 1 deletion(-) create mode 100644 changelog.d/5-internal/intra-listing diff --git a/changelog.d/5-internal/intra-listing b/changelog.d/5-internal/intra-listing new file mode 100644 index 00000000000..b5e726d22ac --- /dev/null +++ b/changelog.d/5-internal/intra-listing @@ -0,0 +1 @@ +Default intraListing to true. This means that the list of clients, so far saved in both brig's and galley's databases, will still be written to both, but only read from brig's database. This avoids cases where these two tables go out of sync. Brig becomes the source of truth for clients. In the future, if this holds, code and data for galley's clients table can be removed. diff --git a/charts/galley/templates/configmap.yaml b/charts/galley/templates/configmap.yaml index c5ce757acee..e5a4f7864a6 100644 --- a/charts/galley/templates/configmap.yaml +++ b/charts/galley/templates/configmap.yaml @@ -48,7 +48,7 @@ data: settings: httpPoolSize: {{ .settings.httpPoolSize }} - intraListing: false + intraListing: {{ .settings.intraListing }} maxTeamSize: {{ .settings.maxTeamSize }} maxConvSize: {{ .settings.maxConvSize }} {{- if .settings.maxFanoutSize }} diff --git a/charts/galley/values.yaml b/charts/galley/values.yaml index a044931d76f..15276dc945d 100644 --- a/charts/galley/values.yaml +++ b/charts/galley/values.yaml @@ -28,6 +28,7 @@ config: maxTeamSize: 10000 exposeInvitationURLsTeamAllowlist: [] maxConvSize: 500 + intraListing: true # Before making indexedBillingTeamMember true while upgrading, please # refer to notes here: https://github.com/wireapp/wire-server-deploy/releases/tag/v2020-05-15 indexedBillingTeamMember: false From e408210361e9fec385db1039bbda79760764662b Mon Sep 17 00:00:00 2001 From: Leif Battermann Date: Thu, 17 Nov 2022 08:36:55 +0100 Subject: [PATCH 41/76] [SQSERVICES-1787] fix backoffice swagger-ui (#2846) --- changelog.d/5-internal/pr-2846 | 1 + charts/backoffice/templates/configmap.yaml | 153 +--- charts/backoffice/templates/deployment.yaml | 12 +- charts/backoffice/values.yaml | 14 +- hack/bin/set-chart-image-version.sh | 3 - hack/bin/set-wire-server-image-version.sh | 6 +- .../integration-test/conf/nginz/nginx.conf | 20 +- .../backoffice/api-docs/resources.json | 13 - .../conf/nginz/zwagger-ui/index.html | 4 - .../backoffice/api-docs/resources.json | 13 - services/nginz/zwagger-ui/index.html | 4 - tools/stern/README.md | 20 +- tools/stern/screenshots/legacy/1.png | Bin 163054 -> 0 bytes tools/stern/screenshots/legacy/2.png | Bin 137064 -> 0 bytes tools/stern/src/Stern/API.hs | 42 +- tools/stern/src/Stern/API/Routes.hs | 21 +- tools/stern/src/Stern/API/RoutesLegacy.hs | 700 ------------------ tools/stern/stern.cabal | 1 - 18 files changed, 39 insertions(+), 988 deletions(-) create mode 100644 changelog.d/5-internal/pr-2846 delete mode 100644 services/nginz/integration-test/conf/nginz/zwagger-ui/backoffice/api-docs/resources.json delete mode 100644 services/nginz/zwagger-ui/backoffice/api-docs/resources.json delete mode 100644 tools/stern/screenshots/legacy/1.png delete mode 100644 tools/stern/screenshots/legacy/2.png delete mode 100644 tools/stern/src/Stern/API/RoutesLegacy.hs diff --git a/changelog.d/5-internal/pr-2846 b/changelog.d/5-internal/pr-2846 new file mode 100644 index 00000000000..700a8a5d8dd --- /dev/null +++ b/changelog.d/5-internal/pr-2846 @@ -0,0 +1 @@ +Backoffice Swagger 2.x docs is exposed on `/` and the old Swagger has been removed. Backoffice helm chart only runs stern without an extra nginx. diff --git a/charts/backoffice/templates/configmap.yaml b/charts/backoffice/templates/configmap.yaml index a0a2b09e825..e43214497f4 100644 --- a/charts/backoffice/templates/configmap.yaml +++ b/charts/backoffice/templates/configmap.yaml @@ -7,10 +7,10 @@ data: logNetStrings: True # log using netstrings encoding: # http://cr.yp.to/proto/netstrings.txt logLevel: {{ .Values.config.logLevel }} + logFormat: {{ .Values.config.logFormat }} stern: host: 0.0.0.0 - port: 8081 - # Cannot listen on the same port as the frontend + port: 8080 brig: host: brig port: 8080 @@ -28,152 +28,3 @@ data: ibis: host: {{ .Values.config.ibisHost }} port: 8080 - nginx.conf: | - worker_processes 1; - worker_rlimit_nofile 1024; - pid /tmp/nginx.pid; - - events { - worker_connections 1024; - multi_accept off; - } - - http { - # - # Sockets - # - - sendfile on; - tcp_nopush on; - tcp_nodelay on; - - # - # Timeouts - # - - client_body_timeout 60s; - client_header_timeout 60s; - keepalive_timeout 30s; - send_timeout 60s; - - # - # Mapping for websocket connections - # - - map $http_upgrade $connection_upgrade { - websocket upgrade; - default ''; - } - - # - # Body - # - - client_max_body_size 16M; - - # - # Headers - # - - ignore_invalid_headers off; - - server_tokens off; - server_names_hash_bucket_size 64; - server_name_in_redirect off; - types_hash_max_size 2048; - - large_client_header_buffers 4 8k; - - # - # MIME - # - - include /etc/nginx/mime.types; - default_type application/octet-stream; - - # - # Logging - # - - access_log /dev/stdout; - error_log stderr; - - # - # Gzip - # - - gzip on; - gzip_disable msie6; - gzip_vary on; - gzip_proxied any; - gzip_comp_level 6; - gzip_buffers 16 8k; - gzip_http_version 1.1; - gzip_min_length 1024; - gzip_types text/plain text/css application/json application/x-javascript text/xml application/xml application/xml+rss text/javascript; - - # - # SSL - # - - add_header Strict-Transport-Security max-age=31536000; - - map $scheme $server_https { - default off; - https on; - } - - ssl_session_cache builtin:1000 shared:SSL:10m; - ssl_session_timeout 5m; - ssl_prefer_server_ciphers on; - ssl_protocols TLSv1.2 TLSv1.3; - # NOTE: These are some sane defaults (compliant to TR-02102-2), you may want to overrride them on your own installation - # For TR-02102-2 see https://www.bsi.bund.de/SharedDocs/Downloads/EN/BSI/Publications/TechGuidelines/TG02102/BSI-TR-02102-2.html - # As a Wire employee, for Wire-internal discussions and context see - # * https://wearezeta.atlassian.net/browse/FS-33 - # * https://wearezeta.atlassian.net/browse/FS-444 - ssl_ciphers 'ECDHE-ECDSA-AES256-GCM-SHA384:ECDHE-RSA-AES256-GCM-SHA384'; # for TLS 1.2 - # FUTUREWORK: upgrade nginx used for the backoffice to support ssl_conf_command (i.e. build a new backoffice-frontend), then uncomment below - # ssl_conf_command Ciphersuites TLS_AES_128_GCM_SHA256:TLS_AES_256_GCM_SHA384; # for TLS 1.3 - server { - listen {{ .Values.service.internalPort }}; - - # Backoffice code at /var/www - location / { - # NOTE: nginx's root is defined at compile time! This means that these roots - # depend on the values at the time of compilation for nginx, namely --conf-path - # and --prefix. If you don't use _full_ paths as root, they get resolved depending - # those prefixes... they really need to fix this! So we just assume that these - # paths can be created on any filesystem... - root /var/www/swagger-ui; - index index.html; - } - - # resources.json is needed by the backoffice app - location /api-docs { - # This asssumes the default location for the backoffice! - root /var/www/swagger-ui; - index resources.json; - } - - # The liveness/healthiness depends on stern - location /i/status { - proxy_pass http://localhost:8081; - proxy_http_version 1.1; - } - - rewrite ^/api-docs/stern /stern/api-docs?base_url={{ .Values.baseUrl }}/api break; - - # This path is used by swagger to fetch the docs from the service - location /stern { - proxy_pass http://localhost:8081; - proxy_http_version 1.1; - } - - # All others requests get proxied to stern, without the api prefix (which was added in the base_url above) - location ~ ^/api/(.*)$ { - proxy_pass http://localhost:8081/$1$is_args$query_string; - proxy_http_version 1.1; - } - } - } diff --git a/charts/backoffice/templates/deployment.yaml b/charts/backoffice/templates/deployment.yaml index 172e3fc1357..6cc5c2df661 100644 --- a/charts/backoffice/templates/deployment.yaml +++ b/charts/backoffice/templates/deployment.yaml @@ -32,20 +32,12 @@ spec: name: "backoffice" containers: - name: stern - image: "{{ .Values.images.stern.repository }}:{{ .Values.images.stern.tag }}" - imagePullPolicy: {{ default "" .Values.images.stern.pullPolicy | quote }} + image: "{{ .Values.image.repository }}:{{ .Values.image.tag }}" + imagePullPolicy: {{ default "" .Values.image.pullPolicy | quote }} volumeMounts: - name: "backoffice-config" mountPath: /etc/wire/stern/conf/stern.yaml subPath: stern.yaml - - name: backoffice-frontend - image: "{{ .Values.images.frontend.repository }}:{{ .Values.images.frontend.tag }}" - imagePullPolicy: {{ default "" .Values.images.frontend.pullPolicy | quote }} - volumeMounts: - - name: "backoffice-config" - # We don't want to override existing files under /etc/nginx except for nginx.conf - mountPath: "/etc/nginx/nginx.conf" - subPath: nginx.conf ports: - containerPort: {{ .Values.service.internalPort }} livenessProbe: diff --git a/charts/backoffice/values.yaml b/charts/backoffice/values.yaml index bbdb1e881e3..02c190d1bb0 100644 --- a/charts/backoffice/values.yaml +++ b/charts/backoffice/values.yaml @@ -1,13 +1,8 @@ replicaCount: 1 -images: - frontend: - repository: quay.io/wire/backoffice-frontend - tag: 2.87.0 - pullPolicy: IfNotPresent - stern: - repository: quay.io/wire/stern - tag: do-not-use - pullPolicy: IfNotPresent +image: + repository: quay.io/wire/stern + tag: do-not-use + pullPolicy: IfNotPresent service: internalPort: 8080 externalPort: 8080 @@ -19,6 +14,7 @@ resources: memory: 50Mi config: logLevel: Info + logFormat: StructuredJSON galebHost: galeb.integrations ibisHost: ibis.integrations baseUrl: http://localhost:8080 diff --git a/hack/bin/set-chart-image-version.sh b/hack/bin/set-chart-image-version.sh index 64c2cf0293c..d133007e4a9 100755 --- a/hack/bin/set-chart-image-version.sh +++ b/hack/bin/set-chart-image-version.sh @@ -12,9 +12,6 @@ do if [[ "$chart" == "nginz" ]]; then # nginz has a different docker tag indentation sed -i "s/^ tag: .*/ tag: $docker_tag/g" "$CHARTS_DIR/$chart/values.yaml" -elif [[ "$chart" == "backoffice" ]]; then - # There are two images at the same level and we want update only stern. - sed -i "s/tag: do-not-use/tag: $docker_tag/g" "$CHARTS_DIR/$chart/values.yaml" else sed -i "s/^ tag: .*/ tag: $docker_tag/g" "$CHARTS_DIR/$chart/values.yaml" fi diff --git a/hack/bin/set-wire-server-image-version.sh b/hack/bin/set-wire-server-image-version.sh index f439d42514b..212ceed7709 100755 --- a/hack/bin/set-wire-server-image-version.sh +++ b/hack/bin/set-wire-server-image-version.sh @@ -6,7 +6,7 @@ target_version=${1?$USAGE} TOP_LEVEL="$( cd "$( dirname "${BASH_SOURCE[0]}" )/../.." && pwd )" CHARTS_DIR="$TOP_LEVEL/.local/charts" -charts=(brig cannon galley gundeck spar cargohold proxy cassandra-migrations elasticsearch-index federator) +charts=(brig cannon galley gundeck spar cargohold proxy cassandra-migrations elasticsearch-index federator backoffice) for chart in "${charts[@]}"; do sed -i "s/^ tag: .*/ tag: $target_version/g" "$CHARTS_DIR/$chart/values.yaml" @@ -14,7 +14,3 @@ done # special case nginz sed -i "s/^ tag: .*/ tag: $target_version/g" "$CHARTS_DIR/nginz/values.yaml" - -# special case backoffice as there are two images at the same level and we want -# update only one. -sed -i "s/tag: do-not-use/tag: $target_version/g" "$CHARTS_DIR/backoffice/values.yaml" diff --git a/services/nginz/integration-test/conf/nginz/nginx.conf b/services/nginz/integration-test/conf/nginz/nginx.conf index 10e7a546ab4..24155e2bbd8 100644 --- a/services/nginz/integration-test/conf/nginz/nginx.conf +++ b/services/nginz/integration-test/conf/nginz/nginx.conf @@ -497,25 +497,7 @@ http { include common_response_with_zauth.conf; proxy_pass http://spar; } - - # Stern Endpoints - - # We add a `/stern` suffix to the URL to resolve clashes with non-Stern endpoints. - rewrite ^/backoffice/api-docs/stern /stern/api-docs?base_url=http://127.0.0.1:8080/stern/ break; - - location /stern/api-docs { - include common_response_no_zauth.conf; - # We don't use an `upstream` for stern, since running stern is optional. - proxy_pass http://127.0.0.1:8091; - } - - location /stern { - include common_response_no_zauth.conf; - # We don't use an `upstream` for stern, since running stern is optional. - # The trailing slash matters, as it makes sure the `/stern` prefix is removed. - proxy_pass http://127.0.0.1:8091/; - } - + # # Swagger Resource Listing # diff --git a/services/nginz/integration-test/conf/nginz/zwagger-ui/backoffice/api-docs/resources.json b/services/nginz/integration-test/conf/nginz/zwagger-ui/backoffice/api-docs/resources.json deleted file mode 100644 index db64e091275..00000000000 --- a/services/nginz/integration-test/conf/nginz/zwagger-ui/backoffice/api-docs/resources.json +++ /dev/null @@ -1,13 +0,0 @@ -{ - "Version": "1.0", - "swaggerVersion": "1.2", - "apis": [ - { - "path": "/stern", - "description": "Back Office" - } - ], - "info": { - "description": "The Back Office can only be used if Stern is running. It usually shouldn't be running, and if it is, make sure it can only be reached by admins, as it allows unauthorized access to endpoints. For more details see `tools/stern/README.md` in the `wire-server` repository." - } -} diff --git a/services/nginz/integration-test/conf/nginz/zwagger-ui/index.html b/services/nginz/integration-test/conf/nginz/zwagger-ui/index.html index 921da15b8cb..2409c261802 100644 --- a/services/nginz/integration-test/conf/nginz/zwagger-ui/index.html +++ b/services/nginz/integration-test/conf/nginz/zwagger-ui/index.html @@ -43,7 +43,6 @@
-
@@ -54,9 +53,6 @@ - -