From 837962d50369d8084a3b19d77cbbd695f76b9a0d Mon Sep 17 00:00:00 2001 From: Stefan Matting Date: Tue, 27 Oct 2020 15:00:02 +0100 Subject: [PATCH 01/34] Use SHA512 hashed tokens in place of token_. Convert automatically --- services/spar/package.yaml | 2 + services/spar/spar.cabal | 12 +- services/spar/src/Spar/Data.hs | 111 +++++++++++------- services/spar/src/Spar/Data/Instances.hs | 16 +++ services/spar/src/Spar/Types.hs | 23 ++++ .../Test/Spar/Scim/AuthSpec.hs | 82 ++++++++++++- 6 files changed, 201 insertions(+), 45 deletions(-) diff --git a/services/spar/package.yaml b/services/spar/package.yaml index d641be5ff25..2f6ab38c02c 100644 --- a/services/spar/package.yaml +++ b/services/spar/package.yaml @@ -20,6 +20,7 @@ dependencies: - aeson - aeson-pretty - aeson-qq + - attoparsec - base - base64-bytestring - bilge @@ -51,6 +52,7 @@ dependencies: - insert-ordered-containers - interpolate - lens + - memory - metrics-core - metrics-wai - mtl diff --git a/services/spar/spar.cabal b/services/spar/spar.cabal index 60acb86e102..d2716efb4ff 100644 --- a/services/spar/spar.cabal +++ b/services/spar/spar.cabal @@ -4,7 +4,7 @@ cabal-version: 1.12 -- -- see: https://github.com/sol/hpack -- --- hash: 54710b4d4da7f1d6f621e0c28ded0702090f208db2f230715c129480502db771 +-- hash: f5759b67f405a520b79f87b6f477e9e7ff7f2837ff7bb47c92d6d49eecf78c40 name: spar version: 0.1 @@ -50,6 +50,7 @@ library , aeson , aeson-pretty , aeson-qq + , attoparsec , base , base64-bytestring , bilge @@ -80,6 +81,7 @@ library , insert-ordered-containers , interpolate , lens + , memory , metrics-core , metrics-wai , mtl @@ -128,6 +130,7 @@ executable spar , aeson , aeson-pretty , aeson-qq + , attoparsec , base , base64-bytestring , bilge @@ -158,6 +161,7 @@ executable spar , insert-ordered-containers , interpolate , lens + , memory , metrics-core , metrics-wai , mtl @@ -224,6 +228,7 @@ executable spar-integration , aeson-pretty , aeson-qq , async + , attoparsec , base , base64-bytestring , bilge @@ -258,6 +263,7 @@ executable spar-integration , interpolate , lens , lens-aeson + , memory , metrics-core , metrics-wai , mtl @@ -329,6 +335,7 @@ executable spar-schema , aeson , aeson-pretty , aeson-qq + , attoparsec , base , base64-bytestring , bilge @@ -359,6 +366,7 @@ executable spar-schema , insert-ordered-containers , interpolate , lens + , memory , metrics-core , metrics-wai , mtl @@ -416,6 +424,7 @@ test-suite spec , aeson , aeson-pretty , aeson-qq + , attoparsec , base , base64-bytestring , bilge @@ -449,6 +458,7 @@ test-suite spec , interpolate , lens , lens-aeson + , memory , metrics-core , metrics-wai , mtl diff --git a/services/spar/src/Spar/Data.hs b/services/spar/src/Spar/Data.hs index da6aac4b551..e8503c37196 100644 --- a/services/spar/src/Spar/Data.hs +++ b/services/spar/src/Spar/Data.hs @@ -579,12 +579,15 @@ deleteDefaultSsoCode = retry x5 . write del $ params Quorum () -- -- docs/developer/scim/storage.md {#DevScimStorageTokens} -type ScimTokenRow = (ScimToken, TeamId, ScimTokenId, UTCTime, Maybe SAML.IdPId, Text) +type ScimTokenRow = (ScimTokenLookupKey, TeamId, ScimTokenId, UTCTime, Maybe SAML.IdPId, Text) fromScimTokenRow :: ScimTokenRow -> ScimTokenInfo fromScimTokenRow (_, stiTeam, stiId, stiCreatedAt, stiIdP, stiDescr) = ScimTokenInfo {..} +scimTokenLookupKey :: ScimTokenRow -> ScimTokenLookupKey +scimTokenLookupKey (key, _, _, _, _, _) = key + -- | Add a new SCIM provisioning token. The token should be random and -- generated by the backend, not by the user. insertScimToken :: @@ -595,22 +598,23 @@ insertScimToken :: insertScimToken token ScimTokenInfo {..} = retry x5 . batch $ do setType BatchLogged setConsistency Quorum - addPrepQuery insByToken (token, stiTeam, stiId, stiCreatedAt, stiIdP, stiDescr) - addPrepQuery insByTeam (token, stiTeam, stiId, stiCreatedAt, stiIdP, stiDescr) - where - insByToken, insByTeam :: PrepQuery W ScimTokenRow () - insByToken = - [r| - INSERT INTO team_provisioning_by_token - (token_, team, id, created_at, idp, descr) - VALUES (?, ?, ?, ?, ?, ?) - |] - insByTeam = - [r| - INSERT INTO team_provisioning_by_team - (token_, team, id, created_at, idp, descr) - VALUES (?, ?, ?, ?, ?, ?) - |] + let tokenHash = hashScimToken token + addPrepQuery insByToken (ScimTokenLookupKeyHashed tokenHash, stiTeam, stiId, stiCreatedAt, stiIdP, stiDescr) + addPrepQuery insByTeam (ScimTokenLookupKeyHashed tokenHash, stiTeam, stiId, stiCreatedAt, stiIdP, stiDescr) + +insByToken, insByTeam :: PrepQuery W ScimTokenRow () +insByToken = + [r| + INSERT INTO team_provisioning_by_token + (token_, team, id, created_at, idp, descr) + VALUES (?, ?, ?, ?, ?, ?) + |] +insByTeam = + [r| + INSERT INTO team_provisioning_by_team + (token_, team, id, created_at, idp, descr) + VALUES (?, ?, ?, ?, ?, ?) + |] -- | Check whether a token exists and if yes, what team and IdP are -- associated with it. @@ -619,15 +623,36 @@ lookupScimToken :: ScimToken -> m (Maybe ScimTokenInfo) lookupScimToken token = do - mbRow <- retry x1 . query1 sel $ params Quorum (Identity token) - pure $ fmap fromScimTokenRow mbRow - where - sel :: PrepQuery R (Identity ScimToken) ScimTokenRow + let tokenHash = hashScimToken token + mbRow <- retry x1 . query1 sel $ params Quorum (tokenHash, token) + for mbRow $ \row -> do + let tokenInfo = fromScimTokenRow row + case scimTokenLookupKey row of + ScimTokenLookupKeyHashed _ -> pure () + ScimTokenLookupKeyPlaintext token' -> + hashPlaintextToken token' tokenInfo + pure tokenInfo + where + sel :: PrepQuery R (ScimTokenHash, ScimToken) ScimTokenRow sel = [r| SELECT token_, team, id, created_at, idp, descr - FROM team_provisioning_by_token WHERE token_ = ? - |] + FROM team_provisioning_by_token WHERE token_ in (?, ?) + |] + +hashPlaintextToken :: + (HasCallStack, MonadClient m) => + ScimToken -> + ScimTokenInfo -> + m () +hashPlaintextToken token ScimTokenInfo {..} = retry x5 . batch $ do + setType BatchLogged + setConsistency Quorum + addPrepQuery delById (stiTeam, stiId) + addPrepQuery delByTokenLookup (Identity (ScimTokenLookupKeyPlaintext token)) + let tokenHash = hashScimToken token + addPrepQuery insByToken (ScimTokenLookupKeyHashed tokenHash, stiTeam, stiId, stiCreatedAt, stiIdP, stiDescr) + addPrepQuery insByTeam (ScimTokenLookupKeyHashed tokenHash, stiTeam, stiId, stiCreatedAt, stiIdP, stiDescr) -- | List all tokens associated with a team, in the order of their creation. getScimTokens :: @@ -645,7 +670,7 @@ getScimTokens team = do [r| SELECT token_, team, id, created_at, idp, descr FROM team_provisioning_by_team WHERE team = ? - |] + |] -- | Delete a token. deleteScimToken :: @@ -659,27 +684,29 @@ deleteScimToken team tokenid = do setType BatchLogged setConsistency Quorum addPrepQuery delById (team, tokenid) - for_ mbToken $ \(Identity token) -> - addPrepQuery delByToken (Identity token) + for_ mbToken $ \(Identity key) -> + addPrepQuery delByTokenLookup (Identity key) where - selById :: PrepQuery R (TeamId, ScimTokenId) (Identity ScimToken) + selById :: PrepQuery R (TeamId, ScimTokenId) (Identity ScimTokenLookupKey) selById = [r| SELECT token_ FROM team_provisioning_by_team WHERE team = ? AND id = ? |] - delById :: PrepQuery W (TeamId, ScimTokenId) () - delById = - [r| - DELETE FROM team_provisioning_by_team - WHERE team = ? AND id = ? - |] - delByToken :: PrepQuery W (Identity ScimToken) () - delByToken = - [r| - DELETE FROM team_provisioning_by_token - WHERE token_ = ? - |] + +delById :: PrepQuery W (TeamId, ScimTokenId) () +delById = + [r| + DELETE FROM team_provisioning_by_team + WHERE team = ? AND id = ? + |] + +delByTokenLookup :: PrepQuery W (Identity ScimTokenLookupKey) () +delByTokenLookup = + [r| + DELETE FROM team_provisioning_by_token + WHERE token_ = ? +|] -- | Delete all tokens belonging to a team. deleteTeamScimTokens :: @@ -692,14 +719,12 @@ deleteTeamScimTokens team = do setType BatchLogged setConsistency Quorum addPrepQuery delByTeam (Identity team) - mapM_ (addPrepQuery delByToken) tokens + mapM_ (addPrepQuery delByTokenLookup) tokens where - sel :: PrepQuery R (Identity TeamId) (Identity ScimToken) + sel :: PrepQuery R (Identity TeamId) (Identity ScimTokenLookupKey) sel = "SELECT token_ FROM team_provisioning_by_team WHERE team = ?" delByTeam :: PrepQuery W (Identity TeamId) () delByTeam = "DELETE FROM team_provisioning_by_team WHERE team = ?" - delByToken :: PrepQuery W (Identity ScimToken) () - delByToken = "DELETE FROM team_provisioning_by_token WHERE token_ = ?" ---------------------------------------------------------------------- -- SCIM user records diff --git a/services/spar/src/Spar/Data/Instances.hs b/services/spar/src/Spar/Data/Instances.hs index 28f7623b267..19996909314 100644 --- a/services/spar/src/Spar/Data/Instances.hs +++ b/services/spar/src/Spar/Data/Instances.hs @@ -32,6 +32,7 @@ module Spar.Data.Instances where import Cassandra as Cas +import Data.ByteString.Conversion (fromByteString, toByteString) import Data.String.Conversions import Data.X509 (SignedCertificate) import Imports @@ -101,3 +102,18 @@ toVerdictFormat (VerdictFormatConMobile, Just succredir, Just errredir) = Just $ toVerdictFormat _ = Nothing deriving instance Cql ScimToken + +instance Cql ScimTokenHash where + ctype = Tagged TextColumn + toCql = CqlText . cs . toByteString + fromCql (CqlText t) = maybe (Left "ScimTokenHash: parse error") Right (fromByteString . cs $ t) + fromCql _ = Left "ScimTokenHash: expected CqlText" + +instance Cql ScimTokenLookupKey where + ctype = Tagged TextColumn + toCql = \case + ScimTokenLookupKeyHashed h -> toCql h + ScimTokenLookupKeyPlaintext t -> toCql t + fromCql s@(CqlText _) = + ScimTokenLookupKeyHashed <$> fromCql s <|> ScimTokenLookupKeyPlaintext <$> fromCql s + fromCql _ = Left "ScimTokenLookupKey: expected CqlText" diff --git a/services/spar/src/Spar/Types.hs b/services/spar/src/Spar/Types.hs index 2fc47398a19..58c5da88e9b 100644 --- a/services/spar/src/Spar/Types.hs +++ b/services/spar/src/Spar/Types.hs @@ -24,8 +24,12 @@ module Spar.Types where import Control.Lens (makeLenses) import Control.Monad.Except +import Crypto.Hash (SHA512 (..), hash) import Data.Aeson import Data.Aeson.TH +import Data.Attoparsec.ByteString (string) +import qualified Data.Binary.Builder as BB (fromByteString) +import Data.ByteArray.Encoding (Base (..), convertToBase) import qualified Data.ByteString.Builder as Builder import Data.ByteString.Conversion import Data.Id (ScimTokenId, TeamId, UserId) @@ -143,6 +147,25 @@ instance ToJSON IdPMetadataInfo where newtype ScimToken = ScimToken {fromScimToken :: Text} deriving (Eq, Show, FromJSON, ToJSON, FromByteString, ToByteString) +newtype ScimTokenHash = ScimTokenHash {fromScimTokenHash :: Text} + deriving (Eq, Show) + +instance FromByteString ScimTokenHash where + parser = string "sha512:" *> (ScimTokenHash <$> parser) + +instance ToByteString ScimTokenHash where + builder (ScimTokenHash t) = BB.fromByteString "sha512:" <> builder t + +data ScimTokenLookupKey + = ScimTokenLookupKeyHashed ScimTokenHash + | ScimTokenLookupKeyPlaintext ScimToken + deriving (Eq, Show) + +hashScimToken :: ScimToken -> ScimTokenHash +hashScimToken token = + let digest = hash @ByteString @SHA512 (encodeUtf8 (fromScimToken token)) + in ScimTokenHash (cs @ByteString @Text (convertToBase Base64 digest)) + -- | Metadata that we store about each token. data ScimTokenInfo = ScimTokenInfo { -- | Which team can be managed with the token diff --git a/services/spar/test-integration/Test/Spar/Scim/AuthSpec.hs b/services/spar/test-integration/Test/Spar/Scim/AuthSpec.hs index 9052e34ff84..15a84018b1e 100644 --- a/services/spar/test-integration/Test/Spar/Scim/AuthSpec.hs +++ b/services/spar/test-integration/Test/Spar/Scim/AuthSpec.hs @@ -1,4 +1,5 @@ {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} -- This file is part of the Wire Server implementation. -- @@ -27,13 +28,22 @@ where import Bilge import Bilge.Assert +import Cassandra as Cas import Control.Lens +import qualified Data.ByteString.Base64 as ES +import Data.Id (ScimTokenId, TeamId, randomId) import Data.Misc (PlainTextPassword (..)) +import Data.String.Conversions (cs) +import Data.Time (UTCTime) +import Data.Time.Clock (getCurrentTime) import qualified Galley.Types.Teams as Galley import Imports +import OpenSSL.Random (randBytes) +import qualified SAML2.WebSSO as SAML import qualified SAML2.WebSSO.Test.Util as SAML import Spar.Scim -import Spar.Types (ScimTokenInfo (..)) +import Spar.Types (ScimToken (..), ScimTokenInfo (..), ScimTokenLookupKey (..), hashScimToken) +import Text.RawString.QQ (r) import Util -- | Tests for authentication and operations with provisioning tokens ('ScimToken's). @@ -193,6 +203,7 @@ testCreateTokenRequiresPassword = do specListTokens :: SpecWith TestEnv specListTokens = describe "GET /auth-tokens" $ do it "works" $ testListTokens + it "converts legacy plaintext tokens" $ testPlaintextTokensAreConverted -- | Test that existing tokens can be listed. testListTokens :: TestSpar () @@ -219,6 +230,75 @@ testListTokens = do map stiDescr list `shouldBe` ["testListTokens / #1", "testListTokens / #2"] +testPlaintextTokensAreConverted :: TestSpar () +testPlaintextTokensAreConverted = do + (_, teamId, _) <- registerTestIdP + + -- create a legacy plaintext token in the DB + token <- createLegacyPlaintextToken teamId + countTokensInDB (ScimTokenLookupKeyPlaintext token) >>= liftIO . (`shouldBe` 1) + + -- scim token can be used. + -- This use causes the plaintext token to be converted to a hashed version + void $ listUsers token (Just (filterBy "userName" $ "foo")) + + -- The previous use of the token causes its DB entry to be hashed + -- The plaintext entry is gone + countTokensInDB (ScimTokenLookupKeyPlaintext token) >>= liftIO . (`shouldBe` 0) + + -- The hashed entry can be found + let hashedToken = hashScimToken token + countTokensInDB (ScimTokenLookupKeyHashed hashedToken) >>= liftIO . (`shouldBe` 1) + + -- token can still be used + void $ listUsers token (Just (filterBy "userName" $ "foo")) + where + wrapMonadClient :: Cas.Client a -> TestSpar a + wrapMonadClient action = do + env <- ask + let clientState = env ^. teCql + runClient clientState action + + createLegacyPlaintextToken :: TeamId -> TestSpar ScimToken + createLegacyPlaintextToken teamId = do + token <- ScimToken . cs . ES.encode <$> liftIO (randBytes 32) + tokenId <- randomId + now <- liftIO $ getCurrentTime + let descr = "legacy test token" + wrapMonadClient $ do + retry x5 . batch $ do + setType BatchLogged + setConsistency Quorum + addPrepQuery insByToken (ScimTokenLookupKeyPlaintext token, teamId, tokenId, now, Nothing, descr) + addPrepQuery insByTeam (ScimTokenLookupKeyPlaintext token, teamId, tokenId, now, Nothing, descr) + pure token + + insByToken, insByTeam :: PrepQuery W (ScimTokenLookupKey, TeamId, ScimTokenId, UTCTime, Maybe SAML.IdPId, Text) () + insByToken = + [r| + INSERT INTO team_provisioning_by_token + (token_, team, id, created_at, idp, descr) + VALUES (?, ?, ?, ?, ?, ?) + |] + insByTeam = + [r| + INSERT INTO team_provisioning_by_team + (token_, team, id, created_at, idp, descr) + VALUES (?, ?, ?, ?, ?, ?) + |] + + countTokensInDB :: ScimTokenLookupKey -> TestSpar Int64 + countTokensInDB key = + wrapMonadClient $ do + count <- runIdentity <$$> (retry x1 . query1 selByKey $ params Quorum (Identity key)) + pure $ fromMaybe 0 count + + selByKey :: PrepQuery R (Identity ScimTokenLookupKey) (Identity Int64) + selByKey = + [r| + SELECT COUNT(*) FROM team_provisioning_by_token WHERE token_ = ? + |] + ---------------------------------------------------------------------------- -- Token deletion From f374253d04f8816e0ef86e1fae78d0590b082c82 Mon Sep 17 00:00:00 2001 From: Stefan Matting Date: Thu, 29 Oct 2020 10:40:25 +0100 Subject: [PATCH 02/34] rename hashPlaintextToken -> convertPlaintextToken --- services/spar/src/Spar/Data.hs | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/services/spar/src/Spar/Data.hs b/services/spar/src/Spar/Data.hs index e8503c37196..c6e48e489d3 100644 --- a/services/spar/src/Spar/Data.hs +++ b/services/spar/src/Spar/Data.hs @@ -630,7 +630,7 @@ lookupScimToken token = do case scimTokenLookupKey row of ScimTokenLookupKeyHashed _ -> pure () ScimTokenLookupKeyPlaintext token' -> - hashPlaintextToken token' tokenInfo + connvertPlaintextToken token' tokenInfo pure tokenInfo where sel :: PrepQuery R (ScimTokenHash, ScimToken) ScimTokenRow @@ -640,12 +640,12 @@ lookupScimToken token = do FROM team_provisioning_by_token WHERE token_ in (?, ?) |] -hashPlaintextToken :: +connvertPlaintextToken :: (HasCallStack, MonadClient m) => ScimToken -> ScimTokenInfo -> m () -hashPlaintextToken token ScimTokenInfo {..} = retry x5 . batch $ do +connvertPlaintextToken token ScimTokenInfo {..} = retry x5 . batch $ do setType BatchLogged setConsistency Quorum addPrepQuery delById (stiTeam, stiId) From 0b3cfb6f3d532b2ac42a6dba3ce02c7d5a829078 Mon Sep 17 00:00:00 2001 From: Matthias Fischmann Date: Fri, 30 Oct 2020 13:55:59 +0100 Subject: [PATCH 03/34] hi ci From f6825dd7c73b82c31b866a90dbbcdee6b35812b4 Mon Sep 17 00:00:00 2001 From: Stefan Matting Date: Mon, 2 Nov 2020 17:17:05 +0100 Subject: [PATCH 04/34] connvertPlaintextToken: reorder queries for better state after crash Co-authored-by: fisx --- services/spar/src/Spar/Data.hs | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/services/spar/src/Spar/Data.hs b/services/spar/src/Spar/Data.hs index c6e48e489d3..c3f82f70b9f 100644 --- a/services/spar/src/Spar/Data.hs +++ b/services/spar/src/Spar/Data.hs @@ -648,11 +648,14 @@ connvertPlaintextToken :: connvertPlaintextToken token ScimTokenInfo {..} = retry x5 . batch $ do setType BatchLogged setConsistency Quorum - addPrepQuery delById (stiTeam, stiId) addPrepQuery delByTokenLookup (Identity (ScimTokenLookupKeyPlaintext token)) let tokenHash = hashScimToken token + -- enter by new lookup key addPrepQuery insByToken (ScimTokenLookupKeyHashed tokenHash, stiTeam, stiId, stiCreatedAt, stiIdP, stiDescr) + -- update info table addPrepQuery insByTeam (ScimTokenLookupKeyHashed tokenHash, stiTeam, stiId, stiCreatedAt, stiIdP, stiDescr) + -- remove old lookup key + addPrepQuery delByTokenLookup (Identity (ScimTokenLookupKeyPlaintext token)) -- | List all tokens associated with a team, in the order of their creation. getScimTokens :: From 0e4e417872abce61b44d38b499bb482ff3cfca64 Mon Sep 17 00:00:00 2001 From: Stefan Matting Date: Mon, 2 Nov 2020 14:32:26 +0100 Subject: [PATCH 05/34] Add rountrip test for ScimTokenHash --- services/spar/spar.cabal | 3 +- services/spar/test/Arbitrary.hs | 3 ++ .../test/Test/Spar/Roundtrip/ByteString.hs | 36 +++++++++++++++++++ services/spar/test/Test/Spar/TypesSpec.hs | 3 ++ 4 files changed, 44 insertions(+), 1 deletion(-) create mode 100644 services/spar/test/Test/Spar/Roundtrip/ByteString.hs diff --git a/services/spar/spar.cabal b/services/spar/spar.cabal index d2716efb4ff..a70744794be 100644 --- a/services/spar/spar.cabal +++ b/services/spar/spar.cabal @@ -4,7 +4,7 @@ cabal-version: 1.12 -- -- see: https://github.com/sol/hpack -- --- hash: f5759b67f405a520b79f87b6f477e9e7ff7f2837ff7bb47c92d6d49eecf78c40 +-- hash: 7a433aaa30026803e763166dffe8888607987a8374c359e18186353fbf7136b6 name: spar version: 0.1 @@ -411,6 +411,7 @@ test-suite spec Test.Spar.APISpec Test.Spar.DataSpec Test.Spar.Intra.BrigSpec + Test.Spar.Roundtrip.ByteString Test.Spar.ScimSpec Test.Spar.TypesSpec Paths_spar diff --git a/services/spar/test/Arbitrary.hs b/services/spar/test/Arbitrary.hs index 0b049c2a7cb..75e1598c9d8 100644 --- a/services/spar/test/Arbitrary.hs +++ b/services/spar/test/Arbitrary.hs @@ -44,6 +44,9 @@ instance Arbitrary WireIdP where deriving instance Arbitrary ScimToken +instance Arbitrary ScimTokenHash where + arbitrary = hashScimToken <$> arbitrary + instance Arbitrary ScimTokenInfo where arbitrary = ScimTokenInfo diff --git a/services/spar/test/Test/Spar/Roundtrip/ByteString.hs b/services/spar/test/Test/Spar/Roundtrip/ByteString.hs new file mode 100644 index 00000000000..12faed91183 --- /dev/null +++ b/services/spar/test/Test/Spar/Roundtrip/ByteString.hs @@ -0,0 +1,36 @@ +-- This file is part of the Wire Server implementation. +-- +-- Copyright (C) 2020 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.Spar.Roundtrip.ByteString where + +import Arbitrary () +import Data.ByteString.Conversion +import Imports +import Test.Hspec +import Test.QuickCheck +import Type.Reflection (typeRep) + +testRoundTrip :: + forall a. + (Arbitrary a, Typeable a, ToByteString a, FromByteString a, Eq a, Show a) => + Spec +testRoundTrip = it msg $ property trip + where + msg = show (typeRep @a) + trip (v :: a) = + counterexample (show $ toByteString' v) $ + Just v === (fromByteString . toByteString') v diff --git a/services/spar/test/Test/Spar/TypesSpec.hs b/services/spar/test/Test/Spar/TypesSpec.hs index fbff3756f4f..95f3765015a 100644 --- a/services/spar/test/Test/Spar/TypesSpec.hs +++ b/services/spar/test/Test/Spar/TypesSpec.hs @@ -24,6 +24,7 @@ import Data.UUID import Imports import Spar.Types import Test.Hspec +import Test.Spar.Roundtrip.ByteString (testRoundTrip) import URI.ByteString import URI.ByteString.QQ import Web.Cookie @@ -44,3 +45,5 @@ spec = do it "2" $ do mkVerdictDeniedFormatMobile [uri|http://bad/?label=$label|] "forbidden" `shouldBe` Right [uri|http://bad/?label=forbidden|] + describe "(To/From)Bytestring Roundtrips" $ do + testRoundTrip @ScimTokenHash From a4f29a7805f3301713ab5c728bfac25b2739a2ec Mon Sep 17 00:00:00 2001 From: Stefan Matting Date: Mon, 2 Nov 2020 18:32:53 +0100 Subject: [PATCH 06/34] Handle case when both versions of tokens are found in db --- services/spar/src/Spar/Data.hs | 27 +++++++++++++++++++-------- 1 file changed, 19 insertions(+), 8 deletions(-) diff --git a/services/spar/src/Spar/Data.hs b/services/spar/src/Spar/Data.hs index c3f82f70b9f..1a84fff41a5 100644 --- a/services/spar/src/Spar/Data.hs +++ b/services/spar/src/Spar/Data.hs @@ -87,6 +87,7 @@ where import Brig.Types.Common (Email, fromEmail) import Cassandra as Cas +import Control.Arrow (Arrow ((&&&))) import Control.Lens import Control.Monad.Except import Data.Id @@ -105,6 +106,7 @@ import URI.ByteString import qualified Web.Cookie as Cky import Web.Scim.Schema.Common (WithId (..)) import Web.Scim.Schema.Meta (Meta (..), WithMeta (..)) +import qualified Prelude -- | A lower bound: @schemaVersion <= whatWeFoundOnCassandra@, not @==@. schemaVersion :: Int32 @@ -624,14 +626,17 @@ lookupScimToken :: m (Maybe ScimTokenInfo) lookupScimToken token = do let tokenHash = hashScimToken token - mbRow <- retry x1 . query1 sel $ params Quorum (tokenHash, token) - for mbRow $ \row -> do - let tokenInfo = fromScimTokenRow row - case scimTokenLookupKey row of - ScimTokenLookupKeyHashed _ -> pure () - ScimTokenLookupKeyPlaintext token' -> - connvertPlaintextToken token' tokenInfo - pure tokenInfo + rows <- retry x1 . query sel $ params Quorum (tokenHash, token) + case fmap (scimTokenLookupKey &&& Prelude.id) rows of + [(ScimTokenLookupKeyHashed _, row)] -> + pure (Just (fromScimTokenRow row)) + [(ScimTokenLookupKeyPlaintext plain, row)] -> + convert plain row + [(ScimTokenLookupKeyHashed _, _), (ScimTokenLookupKeyPlaintext plain, row)] -> + convert plain row + [(ScimTokenLookupKeyPlaintext plain, row), (ScimTokenLookupKeyHashed _', _)] -> + convert plain row + _ -> pure Nothing where sel :: PrepQuery R (ScimTokenHash, ScimToken) ScimTokenRow sel = @@ -640,6 +645,12 @@ lookupScimToken token = do FROM team_provisioning_by_token WHERE token_ in (?, ?) |] + convert :: MonadClient m => ScimToken -> ScimTokenRow -> m (Maybe ScimTokenInfo) + convert plain row = do + let tokenInfo = fromScimTokenRow row + connvertPlaintextToken plain tokenInfo + pure (Just tokenInfo) + connvertPlaintextToken :: (HasCallStack, MonadClient m) => ScimToken -> From af0589cc21446a36084e0d99631e78610136973f Mon Sep 17 00:00:00 2001 From: Matthias Fischmann Date: Wed, 4 Nov 2020 16:15:10 +0100 Subject: [PATCH 07/34] Fix content-type headers in saml responses. --- services/spar/src/Spar/App.hs | 9 +++++++-- 1 file changed, 7 insertions(+), 2 deletions(-) diff --git a/services/spar/src/Spar/App.hs b/services/spar/src/Spar/App.hs index 88a2baa9117..521f665e275 100644 --- a/services/spar/src/Spar/App.hs +++ b/services/spar/src/Spar/App.hs @@ -465,7 +465,9 @@ verdictHandlerWeb = <> ", receiverOrigin);" <> " " <> "", - errHeaders = [("Content-Type", "text/html")] + errHeaders = + [ ("Content-Type", "text/html;charset=utf-8") + ] } where errval = @@ -491,7 +493,10 @@ verdictHandlerWeb = <> " window.opener.postMessage({type: 'AUTH_SUCCESS'}, receiverOrigin);" <> " " <> "", - errHeaders = [("Set-Cookie", cs . Builder.toLazyByteString . renderSetCookie $ cky)] + errHeaders = + [ ("Content-Type", "text/html;charset=utf-8"), + ("Set-Cookie", cs . Builder.toLazyByteString . renderSetCookie $ cky) + ] } easyHtml :: LBS -> LBS From a5aecdebdbac50f812e16b373341c1228d4fb3d9 Mon Sep 17 00:00:00 2001 From: Stefan Matting Date: Thu, 5 Nov 2020 09:16:36 +0100 Subject: [PATCH 08/34] hello ci From 700763a2fa85db3fe7f604ead87870e2e70f0143 Mon Sep 17 00:00:00 2001 From: Stefan Matting Date: Thu, 5 Nov 2020 12:47:39 +0100 Subject: [PATCH 09/34] easyHTML :: Text -> LBS --- services/spar/src/Spar/App.hs | 22 ++++++++++++---------- 1 file changed, 12 insertions(+), 10 deletions(-) diff --git a/services/spar/src/Spar/App.hs b/services/spar/src/Spar/App.hs index 521f665e275..7bd4e8cec17 100644 --- a/services/spar/src/Spar/App.hs +++ b/services/spar/src/Spar/App.hs @@ -45,11 +45,12 @@ import Control.Lens hiding ((.=)) import qualified Control.Monad.Catch as Catch import Control.Monad.Except import Data.Aeson as Aeson (encode, object, (.=)) +import Data.Aeson.Text as Aeson (encodeToLazyText) import qualified Data.ByteString.Builder as Builder -import qualified Data.ByteString.Lazy.Char8 as LBS import Data.Id import Data.String.Conversions import Data.Text.Ascii (encodeBase64, toText) +import qualified Data.Text.Lazy as TL import qualified Data.UUID.V4 as UUID import Imports hiding (log) import qualified Network.HTTP.Types.Status as Http @@ -461,7 +462,7 @@ verdictHandlerWeb = <> " " <> "", @@ -499,13 +500,14 @@ verdictHandlerWeb = ] } -easyHtml :: LBS -> LBS +easyHtml :: LT -> LBS easyHtml doc = - "" - <> "" - <> "" - <> doc - <> "" + cs $ + "" + <> "" + <> "" + <> doc + <> "" -- | If the client is mobile, it has picked error and success redirect urls (see -- 'mkVerdictGrantedFormatMobile', 'mkVerdictDeniedFormatMobile'); variables in these URLs are here @@ -555,13 +557,13 @@ errorPage err inputs mcky = ServerError { errHTTPCode = Http.statusCode $ Wai.code werr, errReasonPhrase = cs $ Wai.label werr, - errBody = easyHtml $ LBS.intercalate "\n" errbody, + errBody = easyHtml $ TL.intercalate "\n" errbody, errHeaders = [("Content-Type", "text/html")] } where werr = either forceWai id $ renderSparError err forceWai ServerError {..} = Wai.Error (Http.Status errHTTPCode "") (cs errReasonPhrase) (cs errBody) - errbody :: [LByteString] + errbody :: [LT] errbody = [ "", " wire:sso:error:" <> cs (Wai.label werr) <> "", From 8baea23c695cd0dbe2eb81c8d95b3d457a8e6141 Mon Sep 17 00:00:00 2001 From: Matthias Fischmann Date: Thu, 5 Nov 2020 19:59:05 +0100 Subject: [PATCH 10/34] nit-picks. --- services/spar/src/Spar/App.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/services/spar/src/Spar/App.hs b/services/spar/src/Spar/App.hs index 7bd4e8cec17..fdfd31e7390 100644 --- a/services/spar/src/Spar/App.hs +++ b/services/spar/src/Spar/App.hs @@ -50,7 +50,7 @@ import qualified Data.ByteString.Builder as Builder import Data.Id import Data.String.Conversions import Data.Text.Ascii (encodeBase64, toText) -import qualified Data.Text.Lazy as TL +import qualified Data.Text.Lazy as LT import qualified Data.UUID.V4 as UUID import Imports hiding (log) import qualified Network.HTTP.Types.Status as Http @@ -557,7 +557,7 @@ errorPage err inputs mcky = ServerError { errHTTPCode = Http.statusCode $ Wai.code werr, errReasonPhrase = cs $ Wai.label werr, - errBody = easyHtml $ TL.intercalate "\n" errbody, + errBody = easyHtml $ LT.intercalate "\n" errbody, errHeaders = [("Content-Type", "text/html")] } where From d3b622156b7f3083a960d25b681966a96cd541fe Mon Sep 17 00:00:00 2001 From: Stefan Matting Date: Fri, 6 Nov 2020 10:32:42 +0100 Subject: [PATCH 11/34] Update services/spar/src/Spar/Data.hs Co-authored-by: fisx --- services/spar/src/Spar/Data.hs | 1 - 1 file changed, 1 deletion(-) diff --git a/services/spar/src/Spar/Data.hs b/services/spar/src/Spar/Data.hs index 1a84fff41a5..9a7d4772a34 100644 --- a/services/spar/src/Spar/Data.hs +++ b/services/spar/src/Spar/Data.hs @@ -659,7 +659,6 @@ connvertPlaintextToken :: connvertPlaintextToken token ScimTokenInfo {..} = retry x5 . batch $ do setType BatchLogged setConsistency Quorum - addPrepQuery delByTokenLookup (Identity (ScimTokenLookupKeyPlaintext token)) let tokenHash = hashScimToken token -- enter by new lookup key addPrepQuery insByToken (ScimTokenLookupKeyHashed tokenHash, stiTeam, stiId, stiCreatedAt, stiIdP, stiDescr) From 11ad534881e443b7de6728a6801d386796150106 Mon Sep 17 00:00:00 2001 From: Stefan Matting Date: Fri, 6 Nov 2020 10:32:48 +0100 Subject: [PATCH 12/34] Update services/spar/src/Spar/Data.hs Co-authored-by: fisx --- services/spar/src/Spar/Data.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/services/spar/src/Spar/Data.hs b/services/spar/src/Spar/Data.hs index 9a7d4772a34..f5b938b0ed3 100644 --- a/services/spar/src/Spar/Data.hs +++ b/services/spar/src/Spar/Data.hs @@ -634,7 +634,7 @@ lookupScimToken token = do convert plain row [(ScimTokenLookupKeyHashed _, _), (ScimTokenLookupKeyPlaintext plain, row)] -> convert plain row - [(ScimTokenLookupKeyPlaintext plain, row), (ScimTokenLookupKeyHashed _', _)] -> + [(ScimTokenLookupKeyPlaintext plain, row), (ScimTokenLookupKeyHashed _, _)] -> convert plain row _ -> pure Nothing where From cf67d879d041ecc984edb7e5653786778a72f616 Mon Sep 17 00:00:00 2001 From: Matthias Fischmann Date: Sat, 7 Nov 2020 14:56:07 +0100 Subject: [PATCH 13/34] Correct outdated docs. --- docs/reference/provisioning/scim-token.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/docs/reference/provisioning/scim-token.md b/docs/reference/provisioning/scim-token.md index db1d2fe7771..b7ae891de53 100644 --- a/docs/reference/provisioning/scim-token.md +++ b/docs/reference/provisioning/scim-token.md @@ -67,7 +67,7 @@ POST /scim/auth-tokens } ``` -Note that SCIM can only be used with teams that use single sign-on. If a team does not have an identity provider associated with it, `POST /scim/auth-tokens` will return status code 400 with error label `"no-single-idp"`. +Note that SCIM can only be used with teams that have either no or exactly one SAML IdP ([internal issue](https://github.com/zinfra/backend-issues/issues/1377)). ### Listing existing tokens {#RefScimTokenList} From fdfcf447191afb2e427014d0c58aa930650e6c31 Mon Sep 17 00:00:00 2001 From: Stefan Matting Date: Wed, 11 Nov 2020 09:24:58 +0100 Subject: [PATCH 14/34] hello ci From ab49e1f095f6399daaa62335cd9effd82527c262 Mon Sep 17 00:00:00 2001 From: Stefan Matting Date: Wed, 11 Nov 2020 09:59:30 +0100 Subject: [PATCH 15/34] update web-saml2-sso to feature branch --- stack.yaml | 3 ++- stack.yaml.lock | 6 +++--- 2 files changed, 5 insertions(+), 4 deletions(-) diff --git a/stack.yaml b/stack.yaml index 9c7e71b01e6..085e87978ef 100644 --- a/stack.yaml +++ b/stack.yaml @@ -64,7 +64,8 @@ extra-deps: # a version > 1.0.0 of wai-middleware-prometheus is available # (required: https://github.com/fimad/prometheus-haskell/pull/45) - git: https://github.com/wireapp/saml2-web-sso - commit: 43c74bd44698e062abaa090c56de5272e66cee27 # master (Sep 24, 2020) + # TODO(stefan): change this as soon as is it's merged to master + commit: 73fa88c13f96db8ede150b518624c7ee51a49190 - git: https://github.com/kim/hs-collectd commit: 885da222be2375f78c7be36127620ed772b677c9 diff --git a/stack.yaml.lock b/stack.yaml.lock index bac01408873..43a793bf203 100644 --- a/stack.yaml.lock +++ b/stack.yaml.lock @@ -23,11 +23,11 @@ packages: git: https://github.com/wireapp/saml2-web-sso pantry-tree: size: 4657 - sha256: c1c5ff18a9c8996aa33dd571662033928cda4ae4ebcda98b6777f8ebd0cc7102 - commit: 43c74bd44698e062abaa090c56de5272e66cee27 + sha256: 1e2e75b602379f564f1feb170a338109d7c19dae89b98d414d83eabda1f6fdb7 + commit: 73fa88c13f96db8ede150b518624c7ee51a49190 original: git: https://github.com/wireapp/saml2-web-sso - commit: 43c74bd44698e062abaa090c56de5272e66cee27 + commit: 73fa88c13f96db8ede150b518624c7ee51a49190 - completed: name: collectd version: 0.0.0.2 From 8e26f7d3d1eb2534832e292982ade365a140930f Mon Sep 17 00:00:00 2001 From: Stefan Matting Date: Wed, 11 Nov 2020 18:24:25 +0100 Subject: [PATCH 16/34] Update saml2-web-sso to current master --- stack.yaml | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/stack.yaml b/stack.yaml index 085e87978ef..ae3dc7da77b 100644 --- a/stack.yaml +++ b/stack.yaml @@ -64,8 +64,7 @@ extra-deps: # a version > 1.0.0 of wai-middleware-prometheus is available # (required: https://github.com/fimad/prometheus-haskell/pull/45) - git: https://github.com/wireapp/saml2-web-sso - # TODO(stefan): change this as soon as is it's merged to master - commit: 73fa88c13f96db8ede150b518624c7ee51a49190 + commit: dcbadb18f8ba6ca0e6245bf804405685d3e1cfce - git: https://github.com/kim/hs-collectd commit: 885da222be2375f78c7be36127620ed772b677c9 From 3e9448ff4b2fc05cc48a2eba490322b7ab3870b7 Mon Sep 17 00:00:00 2001 From: Stefan Matting Date: Wed, 11 Nov 2020 18:26:30 +0100 Subject: [PATCH 17/34] hi ci From a40129d64115050c7b4039d62c49656e240f118c Mon Sep 17 00:00:00 2001 From: Stefan Matting Date: Thu, 12 Nov 2020 09:58:36 +0100 Subject: [PATCH 18/34] hi ci From 24a469da9f2f4be7f6e0f61b529ca6df5fb76c8c Mon Sep 17 00:00:00 2001 From: Stefan Matting Date: Thu, 12 Nov 2020 10:39:49 +0100 Subject: [PATCH 19/34] Update stack.yaml Co-authored-by: Akshay Mankar --- stack.yaml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/stack.yaml b/stack.yaml index ae3dc7da77b..613522c3698 100644 --- a/stack.yaml +++ b/stack.yaml @@ -64,7 +64,7 @@ extra-deps: # a version > 1.0.0 of wai-middleware-prometheus is available # (required: https://github.com/fimad/prometheus-haskell/pull/45) - git: https://github.com/wireapp/saml2-web-sso - commit: dcbadb18f8ba6ca0e6245bf804405685d3e1cfce + commit: dcbadb18f8ba6ca0e6245bf804405685d3e1cfce # master (Nov 12, 2020) - git: https://github.com/kim/hs-collectd commit: 885da222be2375f78c7be36127620ed772b677c9 From dc26aec9150266b2f8b9dc615a845fdd9dabc2a6 Mon Sep 17 00:00:00 2001 From: jschaul Date: Thu, 12 Nov 2020 11:29:18 +0100 Subject: [PATCH 20/34] [bonanza] also parse 'tracestate' nginx log (#1244) See also https://github.com/zinfra/backend-issues/issues/1863 and https://github.com/wireapp/wire-server-deploy/pull/376 --- tools/bonanza/src/Bonanza/Parser/Nginz.hs | 3 ++- tools/bonanza/test/unit/Test/Bonanza/Arbitrary.hs | 3 ++- 2 files changed, 4 insertions(+), 2 deletions(-) diff --git a/tools/bonanza/src/Bonanza/Parser/Nginz.hs b/tools/bonanza/src/Bonanza/Parser/Nginz.hs index 9711aacc46a..3d219fcf2c4 100644 --- a/tools/bonanza/src/Bonanza/Parser/Nginz.hs +++ b/tools/bonanza/src/Bonanza/Parser/Nginz.hs @@ -52,7 +52,8 @@ fieldParsers = ("user", stringField), ("zconn", stringField), ("request", stringField), - ("proxy_protocol_addr", ipv4Field) + ("proxy_protocol_addr", ipv4Field), + ("tracestate", stringField) ] nginzLogRecord :: Parser NginzLogRecord diff --git a/tools/bonanza/test/unit/Test/Bonanza/Arbitrary.hs b/tools/bonanza/test/unit/Test/Bonanza/Arbitrary.hs index 9401e30261c..71d321f74ca 100644 --- a/tools/bonanza/test/unit/Test/Bonanza/Arbitrary.hs +++ b/tools/bonanza/test/unit/Test/Bonanza/Arbitrary.hs @@ -392,7 +392,8 @@ instance Arbitrary (ParseInput (NginzLogRecord)) where ("user", genStringField), ("zconn", genStringField), ("request", genStringField), - ("proxy_protocol_addr", genIPv4Field) + ("proxy_protocol_addr", genIPv4Field), + ("tracestate", genStringField) ] genIntField :: Gen CommonLogField genIntField = From e2331d548af19a9dced232bf27cc5630ca168ce3 Mon Sep 17 00:00:00 2001 From: jschaul Date: Fri, 13 Nov 2020 14:03:46 +0100 Subject: [PATCH 21/34] stack yaml lock change (#1246) forgotten to commit in previous PR --- stack.yaml.lock | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/stack.yaml.lock b/stack.yaml.lock index 43a793bf203..825932327bf 100644 --- a/stack.yaml.lock +++ b/stack.yaml.lock @@ -24,10 +24,10 @@ packages: pantry-tree: size: 4657 sha256: 1e2e75b602379f564f1feb170a338109d7c19dae89b98d414d83eabda1f6fdb7 - commit: 73fa88c13f96db8ede150b518624c7ee51a49190 + commit: dcbadb18f8ba6ca0e6245bf804405685d3e1cfce original: git: https://github.com/wireapp/saml2-web-sso - commit: 73fa88c13f96db8ede150b518624c7ee51a49190 + commit: dcbadb18f8ba6ca0e6245bf804405685d3e1cfce - completed: name: collectd version: 0.0.0.2 From 66f69a0a88181a7daa6bfd2157ecd222fabc540e Mon Sep 17 00:00:00 2001 From: Matthias Heinzel Date: Mon, 16 Nov 2020 12:34:51 +0100 Subject: [PATCH 22/34] remove Content-MD5 header for asset upload (#1247) --- libs/wire-api/src/Wire/API/Asset/V3.hs | 16 ++++------------ services/cargohold/src/CargoHold/API/V3.hs | 15 +++------------ services/cargohold/src/CargoHold/S3.hs | 5 +---- 3 files changed, 8 insertions(+), 28 deletions(-) diff --git a/libs/wire-api/src/Wire/API/Asset/V3.hs b/libs/wire-api/src/Wire/API/Asset/V3.hs index fea687bc4a0..7f05d4cb8a0 100644 --- a/libs/wire-api/src/Wire/API/Asset/V3.hs +++ b/libs/wire-api/src/Wire/API/Asset/V3.hs @@ -59,11 +59,8 @@ where import qualified Codec.MIME.Type as MIME import Control.Lens (makeLenses) -import Crypto.Hash (Digest, MD5, hashlazy) import Data.Aeson import Data.Attoparsec.ByteString.Char8 -import qualified Data.ByteArray as B -import qualified Data.ByteString.Base64 as B64 import Data.ByteString.Builder import Data.ByteString.Conversion import qualified Data.ByteString.Lazy as LBS @@ -185,7 +182,7 @@ buildMultipartBody sets typ bs = -- | Begin building a @multipart/mixed@ request body for a non-resumable upload. -- The returned 'Builder' can be immediately followed by the actual asset bytes. beginMultipartBody :: AssetSettings -> AssetHeaders -> Builder -beginMultipartBody sets (AssetHeaders t l d) = +beginMultipartBody sets (AssetHeaders t l) = byteString "--frontier\r\n\ \Content-Type: application/json\r\n\ @@ -205,11 +202,7 @@ beginMultipartBody sets (AssetHeaders t l d) = \Content-Length: " <> wordDec l <> "\r\n\ - \Content-MD5: " - <> byteString (B64.encode (B.convert d)) - <> byteString - "\r\n\ - \\r\n" + \\r\n" where settingsJson = encode sets @@ -224,12 +217,11 @@ endMultipartBody = byteString "\r\n--frontier--\r\n" -- | Headers provided during upload. data AssetHeaders = AssetHeaders { hdrType :: MIME.Type, - hdrLength :: Word, - hdrMD5 :: Digest MD5 + hdrLength :: Word } mkHeaders :: MIME.Type -> LByteString -> AssetHeaders -mkHeaders t b = AssetHeaders t (fromIntegral (LBS.length b)) (hashlazy b) +mkHeaders t b = AssetHeaders t (fromIntegral (LBS.length b)) -------------------------------------------------------------------------------- -- AssetSettings diff --git a/services/cargohold/src/CargoHold/API/V3.hs b/services/cargohold/src/CargoHold/API/V3.hs index bbee56c0cd7..f020c8e5c03 100644 --- a/services/cargohold/src/CargoHold/API/V3.hs +++ b/services/cargohold/src/CargoHold/API/V3.hs @@ -40,11 +40,9 @@ import Control.Applicative (optional) import Control.Error import Control.Lens (set, view, (^.)) import Control.Monad.Trans.Resource -import Crypto.Hash import Crypto.Random (getRandomBytes) import Data.Aeson (eitherDecodeStrict') import Data.Attoparsec.ByteString.Char8 -import qualified Data.ByteString.Base64 as B64 import qualified Data.CaseInsensitive as CI import Data.Conduit import qualified Data.Conduit.Attoparsec as Conduit @@ -171,13 +169,13 @@ assetHeaders :: Parser AssetHeaders assetHeaders = eol *> boundary - *> (headers [hContentType, hContentLength, hContentMD5] >>= go) + *> (headers [hContentType, hContentLength] >>= go) <* eol where go hdrs = - AssetHeaders <$> contentType hdrs + AssetHeaders + <$> contentType hdrs <*> contentLength hdrs - <*> contentMD5 hdrs contentType :: [(HeaderName, ByteString)] -> Parser MIME.Type contentType hdrs = @@ -193,13 +191,6 @@ contentLength hdrs = (either fail return . parseOnly decimal) (lookup (CI.mk "Content-Length") hdrs) -contentMD5 :: [(HeaderName, ByteString)] -> Parser (Digest MD5) -contentMD5 hdrs = - maybe - (fail "Missing Content-MD5") - (maybe (fail "Invalid Content-MD5") return . digestFromByteString . B64.decodeLenient) - (lookup (CI.mk "Content-MD5") hdrs) - boundary :: Parser () boundary = char '-' diff --git a/services/cargohold/src/CargoHold/S3.hs b/services/cargohold/src/CargoHold/S3.hs index 8d5e05aabe7..176672fe979 100644 --- a/services/cargohold/src/CargoHold/S3.hs +++ b/services/cargohold/src/CargoHold/S3.hs @@ -80,7 +80,6 @@ import qualified Data.UUID as UUID import Imports import Network.AWS hiding (Error) import Network.AWS.Data.Body -import Network.AWS.Data.Crypto import Network.AWS.S3 import Network.Wai.Utilities.Error (Error (..)) import Safe (readMay) @@ -106,7 +105,7 @@ uploadV3 :: Maybe V3.AssetToken -> Conduit.ConduitM () ByteString (ResourceT IO) () -> ExceptT Error App () -uploadV3 prc (s3Key . mkKey -> key) (V3.AssetHeaders ct cl md5) tok src = do +uploadV3 prc (s3Key . mkKey -> key) (V3.AssetHeaders ct cl) tok src = do Log.info $ "remote" .= val "S3" ~~ "asset.owner" .= toByteString prc @@ -124,11 +123,9 @@ uploadV3 prc (s3Key . mkKey -> key) (V3.AssetHeaders ct cl md5) tok src = do -- Ignore any 'junk' after the content; take only 'cl' bytes. .| Conduit.isolate (fromIntegral cl) reqBdy = ChunkedBody defaultChunkSize (fromIntegral cl) stream - md5Res = Text.decodeLatin1 $ digestToBase Base64 md5 req b = putObject (BucketName b) (ObjectKey key) (toBody reqBdy) & poContentType ?~ MIME.showType ct - & poContentMD5 ?~ md5Res & poMetadata .~ metaHeaders tok prc getMetadataV3 :: V3.AssetKey -> ExceptT Error App (Maybe S3AssetMeta) From e1cbc2e549269adf6ffdd75689f9aa252e33650f Mon Sep 17 00:00:00 2001 From: Stefan Matting Date: Tue, 17 Nov 2020 12:45:45 +0100 Subject: [PATCH 23/34] Introduce config & use in teset: brigSettingsTeamInvitationTimeout --- services/spar/spar.integration.yaml | 2 ++ services/spar/src/Spar/Types.hs | 2 ++ .../spar/test-integration/Test/Spar/Scim/UserSpec.hs | 11 ++++------- 3 files changed, 8 insertions(+), 7 deletions(-) diff --git a/services/spar/spar.integration.yaml b/services/spar/spar.integration.yaml index 6b40d809505..51ef6c8a3f9 100644 --- a/services/spar/spar.integration.yaml +++ b/services/spar/spar.integration.yaml @@ -38,3 +38,5 @@ maxScimTokens: 2 # Token limit {#RefScimToken} richInfoLimit: 5000 # should be in sync with Brig logNetStrings: False # log using netstrings encoding (see http://cr.yp.to/proto/netstrings.txt) + +brigSettingsTeamInvitationTimeout: 5 # Keep this in sync with optSettings.setTeamInvitationTimeout from brig diff --git a/services/spar/src/Spar/Types.hs b/services/spar/src/Spar/Types.hs index 58c5da88e9b..92e2035b98c 100644 --- a/services/spar/src/Spar/Types.hs +++ b/services/spar/src/Spar/Types.hs @@ -266,6 +266,8 @@ data Opts' a = Opts discoUrl :: !(Maybe Text), logNetStrings :: !(Maybe (Last Bool)), logFormat :: !(Maybe (Last LogFormat)), + -- | Keep this in sync with optSettings.setTeamInvitationTimeout from brig + brigSettingsTeamInvitationTimeout :: !(Maybe Int), -- , optSettings :: !Settings -- (nothing yet; see other services for what belongs in here.) derivedOpts :: !a } diff --git a/services/spar/test-integration/Test/Spar/Scim/UserSpec.hs b/services/spar/test-integration/Test/Spar/Scim/UserSpec.hs index 5a6bb7996c6..6c90d943607 100644 --- a/services/spar/test-integration/Test/Spar/Scim/UserSpec.hs +++ b/services/spar/test-integration/Test/Spar/Scim/UserSpec.hs @@ -53,7 +53,7 @@ import qualified Spar.Data as Data import qualified Spar.Intra.Brig as Intra import Spar.Scim import qualified Spar.Scim.User as SU -import Spar.Types (IdP) +import Spar.Types (IdP, Opts' (..)) import qualified Spar.Types import qualified Text.XML.DSig as SAML import Util @@ -673,12 +673,9 @@ testCreateUserTimeout = do tryquery (filterBy "externalId" $ fromEmail email) waitUserExpiration = do - -- this should be something like @round . Brig.Options.setTeamInvitationTimeout . Brig.Options.optSettings . - -- view teBrigOpts $ env@, but if this goes out of sync with the brig config, we will only get benign false - -- negatives, and importing brig options into spar integration tests is just too awkward. - let setTeamInvitationTimeout = 5 - Control.Exception.assert (setTeamInvitationTimeout < 30) $ do - threadDelay $ (setTeamInvitationTimeout + 1) * 1_000_000 + timeoutSecs <- asks $ fromMaybe 5 . brigSettingsTeamInvitationTimeout . _teOpts + Control.Exception.assert (timeoutSecs < 30) $ do + threadDelay $ (timeoutSecs + 1) * 1_000_000 ---------------------------------------------------------------------------- -- Listing users From bb94f4cd8f56c08d3f445cf91ea974138feb9b04 Mon Sep 17 00:00:00 2001 From: Akshay Mankar Date: Tue, 17 Nov 2020 14:45:57 +0100 Subject: [PATCH 24/34] Revert "remove Content-MD5 header for asset upload (#1247)" (#1249) This reverts commit 66f69a0a88181a7daa6bfd2157ecd222fabc540e. This change expected clients to stop sending the Content-MD5 header, which breaks all the clients. --- libs/wire-api/src/Wire/API/Asset/V3.hs | 16 ++++++++++++---- services/cargohold/src/CargoHold/API/V3.hs | 15 ++++++++++++--- services/cargohold/src/CargoHold/S3.hs | 5 ++++- 3 files changed, 28 insertions(+), 8 deletions(-) diff --git a/libs/wire-api/src/Wire/API/Asset/V3.hs b/libs/wire-api/src/Wire/API/Asset/V3.hs index 7f05d4cb8a0..fea687bc4a0 100644 --- a/libs/wire-api/src/Wire/API/Asset/V3.hs +++ b/libs/wire-api/src/Wire/API/Asset/V3.hs @@ -59,8 +59,11 @@ where import qualified Codec.MIME.Type as MIME import Control.Lens (makeLenses) +import Crypto.Hash (Digest, MD5, hashlazy) import Data.Aeson import Data.Attoparsec.ByteString.Char8 +import qualified Data.ByteArray as B +import qualified Data.ByteString.Base64 as B64 import Data.ByteString.Builder import Data.ByteString.Conversion import qualified Data.ByteString.Lazy as LBS @@ -182,7 +185,7 @@ buildMultipartBody sets typ bs = -- | Begin building a @multipart/mixed@ request body for a non-resumable upload. -- The returned 'Builder' can be immediately followed by the actual asset bytes. beginMultipartBody :: AssetSettings -> AssetHeaders -> Builder -beginMultipartBody sets (AssetHeaders t l) = +beginMultipartBody sets (AssetHeaders t l d) = byteString "--frontier\r\n\ \Content-Type: application/json\r\n\ @@ -202,7 +205,11 @@ beginMultipartBody sets (AssetHeaders t l) = \Content-Length: " <> wordDec l <> "\r\n\ - \\r\n" + \Content-MD5: " + <> byteString (B64.encode (B.convert d)) + <> byteString + "\r\n\ + \\r\n" where settingsJson = encode sets @@ -217,11 +224,12 @@ endMultipartBody = byteString "\r\n--frontier--\r\n" -- | Headers provided during upload. data AssetHeaders = AssetHeaders { hdrType :: MIME.Type, - hdrLength :: Word + hdrLength :: Word, + hdrMD5 :: Digest MD5 } mkHeaders :: MIME.Type -> LByteString -> AssetHeaders -mkHeaders t b = AssetHeaders t (fromIntegral (LBS.length b)) +mkHeaders t b = AssetHeaders t (fromIntegral (LBS.length b)) (hashlazy b) -------------------------------------------------------------------------------- -- AssetSettings diff --git a/services/cargohold/src/CargoHold/API/V3.hs b/services/cargohold/src/CargoHold/API/V3.hs index f020c8e5c03..bbee56c0cd7 100644 --- a/services/cargohold/src/CargoHold/API/V3.hs +++ b/services/cargohold/src/CargoHold/API/V3.hs @@ -40,9 +40,11 @@ import Control.Applicative (optional) import Control.Error import Control.Lens (set, view, (^.)) import Control.Monad.Trans.Resource +import Crypto.Hash import Crypto.Random (getRandomBytes) import Data.Aeson (eitherDecodeStrict') import Data.Attoparsec.ByteString.Char8 +import qualified Data.ByteString.Base64 as B64 import qualified Data.CaseInsensitive as CI import Data.Conduit import qualified Data.Conduit.Attoparsec as Conduit @@ -169,13 +171,13 @@ assetHeaders :: Parser AssetHeaders assetHeaders = eol *> boundary - *> (headers [hContentType, hContentLength] >>= go) + *> (headers [hContentType, hContentLength, hContentMD5] >>= go) <* eol where go hdrs = - AssetHeaders - <$> contentType hdrs + AssetHeaders <$> contentType hdrs <*> contentLength hdrs + <*> contentMD5 hdrs contentType :: [(HeaderName, ByteString)] -> Parser MIME.Type contentType hdrs = @@ -191,6 +193,13 @@ contentLength hdrs = (either fail return . parseOnly decimal) (lookup (CI.mk "Content-Length") hdrs) +contentMD5 :: [(HeaderName, ByteString)] -> Parser (Digest MD5) +contentMD5 hdrs = + maybe + (fail "Missing Content-MD5") + (maybe (fail "Invalid Content-MD5") return . digestFromByteString . B64.decodeLenient) + (lookup (CI.mk "Content-MD5") hdrs) + boundary :: Parser () boundary = char '-' diff --git a/services/cargohold/src/CargoHold/S3.hs b/services/cargohold/src/CargoHold/S3.hs index 176672fe979..8d5e05aabe7 100644 --- a/services/cargohold/src/CargoHold/S3.hs +++ b/services/cargohold/src/CargoHold/S3.hs @@ -80,6 +80,7 @@ import qualified Data.UUID as UUID import Imports import Network.AWS hiding (Error) import Network.AWS.Data.Body +import Network.AWS.Data.Crypto import Network.AWS.S3 import Network.Wai.Utilities.Error (Error (..)) import Safe (readMay) @@ -105,7 +106,7 @@ uploadV3 :: Maybe V3.AssetToken -> Conduit.ConduitM () ByteString (ResourceT IO) () -> ExceptT Error App () -uploadV3 prc (s3Key . mkKey -> key) (V3.AssetHeaders ct cl) tok src = do +uploadV3 prc (s3Key . mkKey -> key) (V3.AssetHeaders ct cl md5) tok src = do Log.info $ "remote" .= val "S3" ~~ "asset.owner" .= toByteString prc @@ -123,9 +124,11 @@ uploadV3 prc (s3Key . mkKey -> key) (V3.AssetHeaders ct cl) tok src = do -- Ignore any 'junk' after the content; take only 'cl' bytes. .| Conduit.isolate (fromIntegral cl) reqBdy = ChunkedBody defaultChunkSize (fromIntegral cl) stream + md5Res = Text.decodeLatin1 $ digestToBase Base64 md5 req b = putObject (BucketName b) (ObjectKey key) (toBody reqBdy) & poContentType ?~ MIME.showType ct + & poContentMD5 ?~ md5Res & poMetadata .~ metaHeaders tok prc getMetadataV3 :: V3.AssetKey -> ExceptT Error App (Maybe S3AssetMeta) From 55f5399c82a31311b3757dd03edd995922ad02cd Mon Sep 17 00:00:00 2001 From: Matthias Heinzel Date: Wed, 18 Nov 2020 17:53:38 +0100 Subject: [PATCH 25/34] Make Content-MD5 header optional for asset upload (#1252) To avoid undetected API breakage as in #1247, this contains a testcase that uses a hardcoded multipart request as it is currently sent by clients.The test fails on #1247, but passes now. Ideally we would not have our own multipart parser in the first place, but the change in `headers` was relatively straight-forward. * add cargohold integration test for client compatibility * make Content-MD5 header optional for asset upload --- libs/wire-api/src/Wire/API/Asset/V3.hs | 16 +--- services/cargohold/src/CargoHold/API/V3.hs | 47 ++++++------ services/cargohold/src/CargoHold/S3.hs | 5 +- services/cargohold/test/integration/API/V3.hs | 73 +++++++++++++++++-- 4 files changed, 93 insertions(+), 48 deletions(-) diff --git a/libs/wire-api/src/Wire/API/Asset/V3.hs b/libs/wire-api/src/Wire/API/Asset/V3.hs index fea687bc4a0..7f05d4cb8a0 100644 --- a/libs/wire-api/src/Wire/API/Asset/V3.hs +++ b/libs/wire-api/src/Wire/API/Asset/V3.hs @@ -59,11 +59,8 @@ where import qualified Codec.MIME.Type as MIME import Control.Lens (makeLenses) -import Crypto.Hash (Digest, MD5, hashlazy) import Data.Aeson import Data.Attoparsec.ByteString.Char8 -import qualified Data.ByteArray as B -import qualified Data.ByteString.Base64 as B64 import Data.ByteString.Builder import Data.ByteString.Conversion import qualified Data.ByteString.Lazy as LBS @@ -185,7 +182,7 @@ buildMultipartBody sets typ bs = -- | Begin building a @multipart/mixed@ request body for a non-resumable upload. -- The returned 'Builder' can be immediately followed by the actual asset bytes. beginMultipartBody :: AssetSettings -> AssetHeaders -> Builder -beginMultipartBody sets (AssetHeaders t l d) = +beginMultipartBody sets (AssetHeaders t l) = byteString "--frontier\r\n\ \Content-Type: application/json\r\n\ @@ -205,11 +202,7 @@ beginMultipartBody sets (AssetHeaders t l d) = \Content-Length: " <> wordDec l <> "\r\n\ - \Content-MD5: " - <> byteString (B64.encode (B.convert d)) - <> byteString - "\r\n\ - \\r\n" + \\r\n" where settingsJson = encode sets @@ -224,12 +217,11 @@ endMultipartBody = byteString "\r\n--frontier--\r\n" -- | Headers provided during upload. data AssetHeaders = AssetHeaders { hdrType :: MIME.Type, - hdrLength :: Word, - hdrMD5 :: Digest MD5 + hdrLength :: Word } mkHeaders :: MIME.Type -> LByteString -> AssetHeaders -mkHeaders t b = AssetHeaders t (fromIntegral (LBS.length b)) (hashlazy b) +mkHeaders t b = AssetHeaders t (fromIntegral (LBS.length b)) -------------------------------------------------------------------------------- -- AssetSettings diff --git a/services/cargohold/src/CargoHold/API/V3.hs b/services/cargohold/src/CargoHold/API/V3.hs index bbee56c0cd7..fcbe55d5530 100644 --- a/services/cargohold/src/CargoHold/API/V3.hs +++ b/services/cargohold/src/CargoHold/API/V3.hs @@ -40,15 +40,14 @@ import Control.Applicative (optional) import Control.Error import Control.Lens (set, view, (^.)) import Control.Monad.Trans.Resource -import Crypto.Hash import Crypto.Random (getRandomBytes) import Data.Aeson (eitherDecodeStrict') import Data.Attoparsec.ByteString.Char8 -import qualified Data.ByteString.Base64 as B64 import qualified Data.CaseInsensitive as CI import Data.Conduit import qualified Data.Conduit.Attoparsec as Conduit import Data.Id +import qualified Data.List as List import qualified Data.Text.Ascii as Ascii import Data.Text.Encoding (decodeLatin1) import qualified Data.Text.Lazy as LT @@ -175,9 +174,9 @@ assetHeaders = <* eol where go hdrs = - AssetHeaders <$> contentType hdrs + AssetHeaders + <$> contentType hdrs <*> contentLength hdrs - <*> contentMD5 hdrs contentType :: [(HeaderName, ByteString)] -> Parser MIME.Type contentType hdrs = @@ -193,13 +192,6 @@ contentLength hdrs = (either fail return . parseOnly decimal) (lookup (CI.mk "Content-Length") hdrs) -contentMD5 :: [(HeaderName, ByteString)] -> Parser (Digest MD5) -contentMD5 hdrs = - maybe - (fail "Missing Content-MD5") - (maybe (fail "Invalid Content-MD5") return . digestFromByteString . B64.decodeLenient) - (lookup (CI.mk "Content-MD5") hdrs) - boundary :: Parser () boundary = char '-' @@ -208,20 +200,27 @@ boundary = *> eol "MIME boundary" +-- | Always parses until the end of headers is reached +-- (a line not starting with a char that's valid in header names, usually an empty line), +-- or fails. +-- Not all listed headers must be found, but other headers (or duplicates) raise an error. headers :: [HeaderName] -> Parser [(HeaderName, ByteString)] -headers names = count (length names) (header names) - -header :: [HeaderName] -> Parser (HeaderName, ByteString) -header names = do - name <- CI.mk <$> takeTill (== ':') "header name" - unless (name `elem` names) $ - fail $ - "Unexpected header: " ++ show (CI.original name) - _ <- char ':' - skipSpace - value <- takeTill isEOL "header value" - eol - return (name, value) +headers allowed = do + -- optional in case there is no header left to parse + optional (CI.mk <$> takeWhile1 (\c -> isAlphaNum c || c == '-') "header name") >>= \case + Nothing -> + pure [] + Just name + | name `notElem` allowed -> + -- might also be a duplicate + fail $ "Unexpected header: " ++ show (CI.original name) + | otherwise -> do + _ <- char ':' + skipSpace + value <- takeTill isEOL "header value" + eol + -- we don't want to parse it again (this also ensures quick termination) + ((name, value) :) <$> headers (List.delete name allowed) eol :: Parser () eol = endOfLine "\r\n" diff --git a/services/cargohold/src/CargoHold/S3.hs b/services/cargohold/src/CargoHold/S3.hs index 8d5e05aabe7..176672fe979 100644 --- a/services/cargohold/src/CargoHold/S3.hs +++ b/services/cargohold/src/CargoHold/S3.hs @@ -80,7 +80,6 @@ import qualified Data.UUID as UUID import Imports import Network.AWS hiding (Error) import Network.AWS.Data.Body -import Network.AWS.Data.Crypto import Network.AWS.S3 import Network.Wai.Utilities.Error (Error (..)) import Safe (readMay) @@ -106,7 +105,7 @@ uploadV3 :: Maybe V3.AssetToken -> Conduit.ConduitM () ByteString (ResourceT IO) () -> ExceptT Error App () -uploadV3 prc (s3Key . mkKey -> key) (V3.AssetHeaders ct cl md5) tok src = do +uploadV3 prc (s3Key . mkKey -> key) (V3.AssetHeaders ct cl) tok src = do Log.info $ "remote" .= val "S3" ~~ "asset.owner" .= toByteString prc @@ -124,11 +123,9 @@ uploadV3 prc (s3Key . mkKey -> key) (V3.AssetHeaders ct cl md5) tok src = do -- Ignore any 'junk' after the content; take only 'cl' bytes. .| Conduit.isolate (fromIntegral cl) reqBdy = ChunkedBody defaultChunkSize (fromIntegral cl) stream - md5Res = Text.decodeLatin1 $ digestToBase Base64 md5 req b = putObject (BucketName b) (ObjectKey key) (toBody reqBdy) & poContentType ?~ MIME.showType ct - & poContentMD5 ?~ md5Res & poMetadata .~ metaHeaders tok prc getMetadataV3 :: V3.AssetKey -> ExceptT Error App (Maybe S3AssetMeta) diff --git a/services/cargohold/test/integration/API/V3.hs b/services/cargohold/test/integration/API/V3.hs index be66969654a..8855819eea6 100644 --- a/services/cargohold/test/integration/API/V3.hs +++ b/services/cargohold/test/integration/API/V3.hs @@ -55,7 +55,8 @@ tests s = "simple" [ test s "roundtrip" testSimpleRoundtrip, test s "tokens" testSimpleTokens, - test s "s3-upstream-closed" testSimpleS3ClosedConnectionReuse + test s "s3-upstream-closed" testSimpleS3ClosedConnectionReuse, + test s "client-compatibility" testUploadCompatibility ], testGroup "RealAWS" @@ -195,6 +196,51 @@ testSimpleS3ClosedConnectionReuse c = go >> wait >> go uploadSimple (c . path "/assets/v3") uid sets part2 !!! const 201 === statusCode +-------------------------------------------------------------------------------- +-- Client compatibility tests + +-- Since the other tests use functions from the server code, it can happen that +-- an API change also changes the requests made here in the tests. +-- This test tries to prevent us from breaking the API without noticing. +-- +-- The body is taken directly from a request made by the web app +-- (just replaced the content with a shorter one and updated the MD5 header). +testUploadCompatibility :: TestSignature () +testUploadCompatibility c = do + uid <- liftIO $ Id <$> nextRandom + -- Initial upload + r1 <- + uploadRaw (c . path "/assets/v3") uid exampleMultipart + + UserId -> + Lazy.ByteString -> + Http (Response (Maybe Lazy.ByteString)) +uploadRaw c usr bs = + post $ + c + . method POST + . zUser usr + . zConn "conn" + . content "multipart/mixed" + . lbytes bs createResumable :: HasCallStack => @@ -378,6 +432,9 @@ getContentType = MIME.parseContentType . decodeLatin1 . getHeader' "Content-Type applicationText :: MIME.Type applicationText = MIME.Type (MIME.Application "text") [] +applicationOctetStream :: MIME.Type +applicationOctetStream = MIME.Type (MIME.Application "octet-stream") [] + textPlain :: MIME.Type textPlain = MIME.Type (MIME.Text "plain") [] From b1094b93464e7460025bc200484224e3fce28800 Mon Sep 17 00:00:00 2001 From: Matthias Fischmann Date: Fri, 6 Nov 2020 11:16:36 +0100 Subject: [PATCH 26/34] Add applock team feautre & return 200 for PUT features (#1242) --- libs/galley-types/src/Galley/Types/Teams.hs | 5 +- libs/wire-api/package.yaml | 1 + libs/wire-api/src/Wire/API/Swagger.hs | 7 +- libs/wire-api/src/Wire/API/Team/Feature.hs | 172 +++++++++++++-- .../unit/Test/Wire/API/Roundtrip/Aeson.hs | 7 +- libs/wire-api/wire-api.cabal | 3 +- services/brig/src/Brig/IO/Intra.hs | 2 +- services/brig/src/Brig/User/Auth.hs | 4 +- .../brig/test/integration/API/Team/Util.hs | 9 +- services/galley/galley.cabal | 5 +- services/galley/schema/src/Main.hs | 4 +- .../schema/src/V46_TeamFeatureAppLock.hs | 36 ++++ services/galley/src/Galley/API/Error.hs | 3 + services/galley/src/Galley/API/Internal.hs | 54 +++-- services/galley/src/Galley/API/LegalHold.hs | 4 +- services/galley/src/Galley/API/Public.hs | 72 +++++-- services/galley/src/Galley/API/Swagger.hs | 44 +++- services/galley/src/Galley/API/Teams.hs | 202 ++++++++++-------- services/galley/src/Galley/Data.hs | 2 +- services/galley/src/Galley/Data/Instances.hs | 10 + .../galley/src/Galley/Data/TeamFeatures.hs | 103 +++++++-- services/galley/test/integration/API/Teams.hs | 19 +- .../test/integration/API/Teams/Feature.hs | 86 +++++--- .../test/integration/API/Teams/LegalHold.hs | 27 ++- .../test/integration/API/Util/TeamFeature.hs | 83 +++++-- services/spar/src/Spar/Intra/Galley.hs | 11 +- .../Test/Spar/Scim/UserSpec.hs | 4 +- services/spar/test-integration/Util/Core.hs | 5 +- tools/stern/src/Stern/API.hs | 96 ++++++--- tools/stern/src/Stern/Intra.hs | 32 ++- tools/stern/src/Stern/Swagger.hs | 2 + 31 files changed, 807 insertions(+), 307 deletions(-) create mode 100644 services/galley/schema/src/V46_TeamFeatureAppLock.hs diff --git a/libs/galley-types/src/Galley/Types/Teams.hs b/libs/galley-types/src/Galley/Types/Teams.hs index 7d77246b7f0..3ebeb0d14e5 100644 --- a/libs/galley-types/src/Galley/Types/Teams.hs +++ b/libs/galley-types/src/Galley/Types/Teams.hs @@ -299,6 +299,7 @@ data HiddenPerm | ChangeLegalHoldUserSettings | ViewLegalHoldUserSettings | ViewTeamFeature TeamFeatureName + | ChangeTeamFeature TeamFeatureName | ChangeTeamSearchVisibility | ViewTeamSearchVisibility | ViewSameTeamEmails @@ -324,7 +325,8 @@ roleHiddenPermissions role = HiddenPermissions p p Set.fromList [ ChangeLegalHoldTeamSettings, ChangeLegalHoldUserSettings, - ChangeTeamSearchVisibility + ChangeTeamSearchVisibility, + ChangeTeamFeature TeamFeatureAppLock ] roleHiddenPerms RoleMember = (roleHiddenPerms RoleExternalPartner <>) $ @@ -336,6 +338,7 @@ roleHiddenPermissions role = HiddenPermissions p p ViewTeamFeature TeamFeatureSearchVisibility, ViewTeamFeature TeamFeatureValidateSAMLEmails, ViewTeamFeature TeamFeatureDigitalSignatures, + ViewTeamFeature TeamFeatureAppLock, ViewLegalHoldUserSettings, ViewTeamSearchVisibility ] diff --git a/libs/wire-api/package.yaml b/libs/wire-api/package.yaml index 7cb775cf62a..62fb69bbb87 100644 --- a/libs/wire-api/package.yaml +++ b/libs/wire-api/package.yaml @@ -26,6 +26,7 @@ library: - cassandra-util - cryptonite >=0.11 - currency-codes >=2.0 + - deriving-aeson >=0.2 - email-validate >=2.0 - errors - exceptions >=0.10.0 diff --git a/libs/wire-api/src/Wire/API/Swagger.hs b/libs/wire-api/src/Wire/API/Swagger.hs index 32e0f205732..0478b64b3fc 100644 --- a/libs/wire-api/src/Wire/API/Swagger.hs +++ b/libs/wire-api/src/Wire/API/Swagger.hs @@ -120,7 +120,12 @@ models = Team.modelTeamDelete, Team.Conversation.modelTeamConversation, Team.Conversation.modelTeamConversationList, - Team.Feature.modelTeamFeatureStatus, + Team.Feature.modelForTeamFeature Team.Feature.TeamFeatureLegalHold, + Team.Feature.modelForTeamFeature Team.Feature.TeamFeatureSSO, + Team.Feature.modelForTeamFeature Team.Feature.TeamFeatureSearchVisibility, + Team.Feature.modelForTeamFeature Team.Feature.TeamFeatureValidateSAMLEmails, + Team.Feature.modelForTeamFeature Team.Feature.TeamFeatureDigitalSignatures, + Team.Feature.modelForTeamFeature Team.Feature.TeamFeatureAppLock, Team.Invitation.modelTeamInvitation, Team.Invitation.modelTeamInvitationList, Team.Invitation.modelTeamInvitationRequest, diff --git a/libs/wire-api/src/Wire/API/Team/Feature.hs b/libs/wire-api/src/Wire/API/Team/Feature.hs index 23ea0ae9874..e9af1051138 100644 --- a/libs/wire-api/src/Wire/API/Team/Feature.hs +++ b/libs/wire-api/src/Wire/API/Team/Feature.hs @@ -21,35 +21,67 @@ module Wire.API.Team.Feature ( TeamFeatureName (..), - TeamFeatureStatus (..), + TeamFeatureStatus, + TeamFeatureAppLockConfig (..), TeamFeatureStatusValue (..), + FeatureHasNoConfig, + EnforceAppLock (..), + KnownTeamFeatureName (..), + TeamFeatureStatusNoConfig (..), + TeamFeatureStatusWithConfig (..), -- * Swagger typeTeamFeatureName, - modelTeamFeatureStatus, typeTeamFeatureStatusValue, + modelTeamFeatureStatusNoConfig, + modelTeamFeatureStatusWithConfig, + modelTeamFeatureAppLockConfig, + modelForTeamFeature, ) where import Data.Aeson import qualified Data.Attoparsec.ByteString as Parser import Data.ByteString.Conversion (FromByteString (..), ToByteString (..), toByteString') +import Data.Kind (Constraint) import Data.String.Conversions (cs) +import Data.Swagger.Build.Api import qualified Data.Swagger.Build.Api as Doc import qualified Data.Text as T import qualified Data.Text.Encoding as T +import Deriving.Aeson import Imports +import Test.QuickCheck.Arbitrary (arbitrary) import Wire.API.Arbitrary (Arbitrary, GenericUniform (..)) +---------------------------------------------------------------------- +-- TeamFeatureName + data TeamFeatureName = TeamFeatureLegalHold | TeamFeatureSSO | TeamFeatureSearchVisibility | TeamFeatureValidateSAMLEmails | TeamFeatureDigitalSignatures - deriving stock (Eq, Show, Ord, Generic, Enum, Bounded) + | TeamFeatureAppLock + deriving stock (Eq, Show, Ord, Generic, Enum, Bounded, Typeable) deriving (Arbitrary) via (GenericUniform TeamFeatureName) +class KnownTeamFeatureName (a :: TeamFeatureName) where + knownTeamFeatureName :: TeamFeatureName + +instance KnownTeamFeatureName 'TeamFeatureLegalHold where knownTeamFeatureName = TeamFeatureLegalHold + +instance KnownTeamFeatureName 'TeamFeatureSSO where knownTeamFeatureName = TeamFeatureSSO + +instance KnownTeamFeatureName 'TeamFeatureSearchVisibility where knownTeamFeatureName = TeamFeatureSearchVisibility + +instance KnownTeamFeatureName 'TeamFeatureValidateSAMLEmails where knownTeamFeatureName = TeamFeatureValidateSAMLEmails + +instance KnownTeamFeatureName 'TeamFeatureDigitalSignatures where knownTeamFeatureName = TeamFeatureDigitalSignatures + +instance KnownTeamFeatureName 'TeamFeatureAppLock where knownTeamFeatureName = TeamFeatureAppLock + instance FromByteString TeamFeatureName where parser = Parser.takeByteString >>= \b -> @@ -60,6 +92,7 @@ instance FromByteString TeamFeatureName where Right "search-visibility" -> pure TeamFeatureSearchVisibility Right "validate-saml-emails" -> pure TeamFeatureValidateSAMLEmails Right "digital-signatures" -> pure TeamFeatureDigitalSignatures + Right "app-lock" -> pure TeamFeatureAppLock Right t -> fail $ "Invalid TeamFeatureName: " <> T.unpack t instance ToByteString TeamFeatureName where @@ -68,29 +101,13 @@ instance ToByteString TeamFeatureName where builder TeamFeatureSearchVisibility = "search-visibility" builder TeamFeatureValidateSAMLEmails = "validate-saml-emails" builder TeamFeatureDigitalSignatures = "digital-signatures" + builder TeamFeatureAppLock = "app-lock" typeTeamFeatureName :: Doc.DataType typeTeamFeatureName = Doc.string . Doc.enum $ cs . toByteString' <$> [(minBound :: TeamFeatureName) ..] -newtype TeamFeatureStatus = TeamFeatureStatus - {teamFeatureStatusValue :: TeamFeatureStatusValue} - deriving stock (Eq, Show) - deriving newtype (Arbitrary) - -modelTeamFeatureStatus :: Doc.Model -modelTeamFeatureStatus = Doc.defineModel "TeamFeatureStatus" $ do - Doc.description "Configuration of a feature for a team" - Doc.property "status" typeTeamFeatureStatusValue $ Doc.description "status" - -instance ToJSON TeamFeatureStatus where - toJSON (TeamFeatureStatus status) = - object - [ "status" .= status - ] - -instance FromJSON TeamFeatureStatus where - parseJSON = withObject "TeamFeatureStatus" $ \o -> - TeamFeatureStatus <$> o .: "status" +---------------------------------------------------------------------- +-- TeamFeatureStatusValue data TeamFeatureStatusValue = TeamFeatureEnabled @@ -129,3 +146,114 @@ instance FromByteString TeamFeatureStatusValue where Right "disabled" -> pure TeamFeatureDisabled Right t -> fail $ "Invalid TeamFeatureStatusValue: " <> T.unpack t Left e -> fail $ "Invalid TeamFeatureStatusValue: " <> show e + +---------------------------------------------------------------------- +-- TeamFeatureStatus + +type family TeamFeatureStatus (a :: TeamFeatureName) :: * where + TeamFeatureStatus 'TeamFeatureLegalHold = TeamFeatureStatusNoConfig + TeamFeatureStatus 'TeamFeatureSSO = TeamFeatureStatusNoConfig + TeamFeatureStatus 'TeamFeatureSearchVisibility = TeamFeatureStatusNoConfig + TeamFeatureStatus 'TeamFeatureValidateSAMLEmails = TeamFeatureStatusNoConfig + TeamFeatureStatus 'TeamFeatureDigitalSignatures = TeamFeatureStatusNoConfig + TeamFeatureStatus 'TeamFeatureAppLock = TeamFeatureStatusWithConfig TeamFeatureAppLockConfig + +type FeatureHasNoConfig (a :: TeamFeatureName) = (TeamFeatureStatus a ~ TeamFeatureStatusNoConfig) :: Constraint + +-- if you add a new constructor here, don't forget to add it to the swagger (1.2) docs in "Wire.API.Swagger"! +modelForTeamFeature :: TeamFeatureName -> Doc.Model +modelForTeamFeature name@TeamFeatureLegalHold = modelTeamFeatureStatusNoConfig name +modelForTeamFeature name@TeamFeatureSSO = modelTeamFeatureStatusNoConfig name +modelForTeamFeature name@TeamFeatureSearchVisibility = modelTeamFeatureStatusNoConfig name +modelForTeamFeature name@TeamFeatureValidateSAMLEmails = modelTeamFeatureStatusNoConfig name +modelForTeamFeature name@TeamFeatureDigitalSignatures = modelTeamFeatureStatusNoConfig name +modelForTeamFeature name@TeamFeatureAppLock = modelTeamFeatureStatusWithConfig name modelTeamFeatureAppLockConfig + +---------------------------------------------------------------------- +-- TeamFeatureStatusNoConfig + +newtype TeamFeatureStatusNoConfig = TeamFeatureStatusNoConfig + { tfwoStatus :: TeamFeatureStatusValue + } + deriving newtype (Eq, Show, Generic, Typeable, Arbitrary) + +modelTeamFeatureStatusNoConfig :: TeamFeatureName -> Doc.Model +modelTeamFeatureStatusNoConfig name = Doc.defineModel (cs $ show name) $ do + Doc.description $ "Configuration for a team feature that has no configuration" + Doc.property "status" typeTeamFeatureStatusValue $ Doc.description "status" + +instance FromJSON TeamFeatureStatusNoConfig where + parseJSON = withObject "TeamFeatureStatus" $ \ob -> + TeamFeatureStatusNoConfig <$> ob .: "status" + +instance ToJSON TeamFeatureStatusNoConfig where + toJSON (TeamFeatureStatusNoConfig status) = object ["status" .= status] + +---------------------------------------------------------------------- +-- TeamFeatureStatusWithConfig + +data TeamFeatureStatusWithConfig (cfg :: *) = TeamFeatureStatusWithConfig + { tfwcStatus :: TeamFeatureStatusValue, + tfwcConfig :: cfg + } + deriving stock (Eq, Show, Generic, Typeable) + +instance Arbitrary cfg => Arbitrary (TeamFeatureStatusWithConfig cfg) where + arbitrary = TeamFeatureStatusWithConfig <$> arbitrary <*> arbitrary + +modelTeamFeatureStatusWithConfig :: TeamFeatureName -> Doc.Model -> Doc.Model +modelTeamFeatureStatusWithConfig name cfgModel = Doc.defineModel (cs $ show name) $ do + Doc.description $ "Status and config of " <> (cs $ show name) + Doc.property "status" typeTeamFeatureStatusValue $ Doc.description "status" + Doc.property "config" (Doc.ref cfgModel) $ Doc.description "config" + +instance FromJSON cfg => FromJSON (TeamFeatureStatusWithConfig cfg) where + parseJSON = withObject "TeamFeatureStatus" $ \ob -> + TeamFeatureStatusWithConfig <$> ob .: "status" <*> ob .: "config" + +instance ToJSON cfg => ToJSON (TeamFeatureStatusWithConfig cfg) where + toJSON (TeamFeatureStatusWithConfig status config) = object ["status" .= status, "config" .= config] + +---------------------------------------------------------------------- +-- TeamFeatureAppLockConfig + +data TeamFeatureAppLockConfig = TeamFeatureAppLockConfig + { applockEnforceAppLock :: EnforceAppLock, + applockInactivityTimeoutSecs :: Int32 + } + deriving stock (Eq, Show, Generic) + +deriving via (GenericUniform TeamFeatureAppLockConfig) instance Arbitrary TeamFeatureAppLockConfig + +newtype EnforceAppLock = EnforceAppLock Bool + deriving stock (Eq, Show, Ord, Generic) + deriving newtype (FromJSON, ToJSON, Arbitrary) + +modelTeamFeatureAppLockConfig :: Doc.Model +modelTeamFeatureAppLockConfig = + Doc.defineModel "TeamFeatureAppLockConfig" $ do + Doc.property "enforceAppLock" bool' $ Doc.description "enforceAppLock" + Doc.property "inactivityTimeoutSecs" int32' $ Doc.description "" + +deriving via + (StripCamel "applock" TeamFeatureAppLockConfig) + instance + ToJSON TeamFeatureAppLockConfig + +deriving via + (StripCamel "applock" TeamFeatureAppLockConfig) + instance + FromJSON TeamFeatureAppLockConfig + +---------------------------------------------------------------------- +-- internal + +data LowerCaseFirst + +instance StringModifier LowerCaseFirst where + getStringModifier (x : xs) = toLower x : xs + getStringModifier [] = [] + +type StripCamel str = + CustomJSON + '[FieldLabelModifier (StripPrefix str, LowerCaseFirst)] diff --git a/libs/wire-api/test/unit/Test/Wire/API/Roundtrip/Aeson.hs b/libs/wire-api/test/unit/Test/Wire/API/Roundtrip/Aeson.hs index d6268514913..a0aa1ce6e94 100644 --- a/libs/wire-api/test/unit/Test/Wire/API/Roundtrip/Aeson.hs +++ b/libs/wire-api/test/unit/Test/Wire/API/Roundtrip/Aeson.hs @@ -194,7 +194,12 @@ tests = testRoundTrip @Team.TeamDeleteData, testRoundTrip @Team.Conversation.TeamConversation, testRoundTrip @Team.Conversation.TeamConversationList, - testRoundTrip @Team.Feature.TeamFeatureStatus, + testRoundTrip @(Team.Feature.TeamFeatureStatus 'Team.Feature.TeamFeatureLegalHold), + testRoundTrip @(Team.Feature.TeamFeatureStatus 'Team.Feature.TeamFeatureSSO), + testRoundTrip @(Team.Feature.TeamFeatureStatus 'Team.Feature.TeamFeatureSearchVisibility), + testRoundTrip @(Team.Feature.TeamFeatureStatus 'Team.Feature.TeamFeatureValidateSAMLEmails), + testRoundTrip @(Team.Feature.TeamFeatureStatus 'Team.Feature.TeamFeatureDigitalSignatures), + testRoundTrip @(Team.Feature.TeamFeatureStatus 'Team.Feature.TeamFeatureAppLock), testRoundTrip @Team.Feature.TeamFeatureStatusValue, testRoundTrip @Team.Invitation.InvitationRequest, testRoundTrip @Team.Invitation.Invitation, diff --git a/libs/wire-api/wire-api.cabal b/libs/wire-api/wire-api.cabal index fb28ea708cc..2fe8b45ce3c 100644 --- a/libs/wire-api/wire-api.cabal +++ b/libs/wire-api/wire-api.cabal @@ -4,7 +4,7 @@ cabal-version: 1.12 -- -- see: https://github.com/sol/hpack -- --- hash: 806e7ef5feb03ce2ead26b199aff52dd62cdd2126aa4930b74ae089c40b15d84 +-- hash: 6e69fab14f1d237ddf7fcfd62e1480fa64a2ece784432e730525309a8453540e name: wire-api version: 0.1.0 @@ -86,6 +86,7 @@ library , containers >=0.5 , cryptonite >=0.11 , currency-codes >=2.0 + , deriving-aeson >=0.2 , email-validate >=2.0 , errors , exceptions >=0.10.0 diff --git a/services/brig/src/Brig/IO/Intra.hs b/services/brig/src/Brig/IO/Intra.hs index 3f41449e971..7e42c2a8eb9 100644 --- a/services/brig/src/Brig/IO/Intra.hs +++ b/services/brig/src/Brig/IO/Intra.hs @@ -828,7 +828,7 @@ getTeamName tid = do . expect2xx -- | Calls 'Galley.API.getTeamFeatureStatusH'. -getTeamLegalHoldStatus :: TeamId -> AppIO TeamFeatureStatus +getTeamLegalHoldStatus :: TeamId -> AppIO (TeamFeatureStatus 'TeamFeatureLegalHold) getTeamLegalHoldStatus tid = do debug $ remote "galley" . msg (val "Get legalhold settings") galleyRequest GET req >>= decodeBody "galley" diff --git a/services/brig/src/Brig/User/Auth.hs b/services/brig/src/Brig/User/Auth.hs index 4b0eca679cb..0d69400cc54 100644 --- a/services/brig/src/Brig/User/Auth.hs +++ b/services/brig/src/Brig/User/Auth.hs @@ -69,7 +69,7 @@ import Imports import Network.Wai.Utilities.Error ((!>>)) import System.Logger (field, msg, val, (~~)) import qualified System.Logger.Class as Log -import Wire.API.Team.Feature (TeamFeatureStatus (..), TeamFeatureStatusValue (..)) +import Wire.API.Team.Feature (TeamFeatureStatusNoConfig (..), TeamFeatureStatusValue (..)) data Access u = Access { accessToken :: !AccessToken, @@ -327,6 +327,6 @@ legalHoldLogin (LegalHoldLogin uid plainTextPassword label) typ = do assertLegalHoldEnabled :: TeamId -> ExceptT LegalHoldLoginError AppIO () assertLegalHoldEnabled tid = do stat <- lift $ Intra.getTeamLegalHoldStatus tid - case teamFeatureStatusValue stat of + case tfwoStatus stat of TeamFeatureDisabled -> throwE LegalHoldLoginLegalHoldNotEnabled TeamFeatureEnabled -> pure () diff --git a/services/brig/test/integration/API/Team/Util.hs b/services/brig/test/integration/API/Team/Util.hs index 0293e682fb7..1e5d2fda92c 100644 --- a/services/brig/test/integration/API/Team/Util.hs +++ b/services/brig/test/integration/API/Team/Util.hs @@ -46,7 +46,8 @@ import qualified Network.Wai.Utilities.Error as Error import Test.Tasty.HUnit import Util import Web.Cookie (parseSetCookie, setCookieName) -import Wire.API.Team.Feature (TeamFeatureStatus (..), TeamFeatureStatusValue (..)) +import Wire.API.Team.Feature (TeamFeatureStatusValue (..)) +import qualified Wire.API.Team.Feature as Public -- | FUTUREWORK: Remove 'createPopulatedBindingTeam', 'createPopulatedBindingTeamWithNames', -- and rename 'createPopulatedBindingTeamWithNamesAndHandles' to 'createPopulatedBindingTeam'. @@ -289,7 +290,7 @@ putLegalHoldEnabled tid enabled g = do g . paths ["i", "teams", toByteString' tid, "features", "legalhold"] . contentJson - . lbytes (encode (TeamFeatureStatus enabled)) + . lbytes (encode (Public.TeamFeatureStatusNoConfig enabled)) . expect2xx accept :: Email -> InvitationCode -> RequestBody @@ -449,10 +450,10 @@ setTeamTeamSearchVisibilityAvailable galley tid status = ( galley . paths ["i/teams", toByteString' tid, "features/search-visibility"] . contentJson - . body (RequestBodyLBS . encode $ TeamFeatureStatus status) + . body (RequestBodyLBS . encode $ Public.TeamFeatureStatusNoConfig status) ) !!! do - const 204 === statusCode + const 200 === statusCode setTeamSearchVisibility :: HasCallStack => Galley -> TeamId -> Team.TeamSearchVisibility -> Http () setTeamSearchVisibility galley tid typ = diff --git a/services/galley/galley.cabal b/services/galley/galley.cabal index 8366b6753c5..f4e85eb06cf 100644 --- a/services/galley/galley.cabal +++ b/services/galley/galley.cabal @@ -1,10 +1,10 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.31.2. +-- This file has been generated from package.yaml by hpack version 0.33.0. -- -- see: https://github.com/sol/hpack -- --- hash: 85f04ae9c723a855be519c59f49ed58d99684c46e4541c67b15592f702fa26ea +-- hash: f6deeba4679ebd1588720a94dbc73f7fb8520a76afe45fbe1169d75f4b0ae729 name: galley version: 0.83.0 @@ -344,6 +344,7 @@ executable galley-schema V43_TeamFeatureDigitalSignatures V44_AddRemoteIdentifiers V45_AddFederationIdMapping + V46_TeamFeatureAppLock Paths_galley hs-source-dirs: schema/src diff --git a/services/galley/schema/src/Main.hs b/services/galley/schema/src/Main.hs index ad2dc194dbb..418afbbef75 100644 --- a/services/galley/schema/src/Main.hs +++ b/services/galley/schema/src/Main.hs @@ -48,6 +48,7 @@ import qualified V42_TeamFeatureValidateSamlEmails import qualified V43_TeamFeatureDigitalSignatures import qualified V44_AddRemoteIdentifiers import qualified V45_AddFederationIdMapping +import qualified V46_TeamFeatureAppLock main :: IO () main = do @@ -81,7 +82,8 @@ main = do V42_TeamFeatureValidateSamlEmails.migration, V43_TeamFeatureDigitalSignatures.migration, V44_AddRemoteIdentifiers.migration, - V45_AddFederationIdMapping.migration + V45_AddFederationIdMapping.migration, + V46_TeamFeatureAppLock.migration -- When adding migrations here, don't forget to update -- 'schemaVersion' in Galley.Data ] diff --git a/services/galley/schema/src/V46_TeamFeatureAppLock.hs b/services/galley/schema/src/V46_TeamFeatureAppLock.hs new file mode 100644 index 00000000000..5ddd7542a96 --- /dev/null +++ b/services/galley/schema/src/V46_TeamFeatureAppLock.hs @@ -0,0 +1,36 @@ +-- This file is part of the Wire Server implementation. +-- +-- Copyright (C) 2020 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 V46_TeamFeatureAppLock + ( migration, + ) +where + +import Cassandra.Schema +import Imports +import Text.RawString.QQ + +migration :: Migration +migration = Migration 46 "Add feature flag for app lock" $ do + schema' + [r| + ALTER TABLE team_features ADD ( + app_lock_status int, + app_lock_enforce int, + app_lock_inactivity_timeout_secs int + ); + |] diff --git a/services/galley/src/Galley/API/Error.hs b/services/galley/src/Galley/API/Error.hs index 5e6bd16254a..b41a52269b1 100644 --- a/services/galley/src/Galley/API/Error.hs +++ b/services/galley/src/Galley/API/Error.hs @@ -239,6 +239,9 @@ customBackendNotFound domain = invalidTeamNotificationId :: Error invalidTeamNotificationId = Error status400 "invalid-notification-id" "Could not parse notification id (must be UUIDv1)." +inactivityTimeoutTooLow :: Error +inactivityTimeoutTooLow = Error status400 "inactivity-timeout-too-low" "applock inactivity timeout must be at least 30 seconds" + -------------------------------------------------------------------------------- -- Federation diff --git a/services/galley/src/Galley/API/Internal.hs b/services/galley/src/Galley/API/Internal.hs index 4aa1a244d76..7e8fe647370 100644 --- a/services/galley/src/Galley/API/Internal.hs +++ b/services/galley/src/Galley/API/Internal.hs @@ -26,6 +26,8 @@ import qualified Cassandra as Cql import Control.Exception.Safe (catchAny) import Control.Lens hiding ((.=)) import Control.Monad.Catch (MonadCatch, throwM) +import Data.Aeson (FromJSON, ToJSON) +import Data.ByteString.Conversion (toByteString') import Data.Id as Id import Data.IdMapping (MappedOrLocalId (Local), partitionMappedOrLocalIds) import Data.List.NonEmpty (nonEmpty) @@ -38,10 +40,10 @@ import qualified Galley.API.CustomBackend as CustomBackend import qualified Galley.API.Error as Error import qualified Galley.API.IdMapping as IdMapping import qualified Galley.API.Query as Query -import Galley.API.Teams (uncheckedDeleteTeamMember) +import Galley.API.Teams (DoAuth (..), uncheckedDeleteTeamMember) import qualified Galley.API.Teams as Teams import qualified Galley.API.Update as Update -import Galley.API.Util (isMember) +import Galley.API.Util (JSON, isMember) import Galley.App import qualified Galley.Data as Data import qualified Galley.Intra.Push as Intra @@ -54,6 +56,7 @@ import Galley.Types.Teams import Galley.Types.Teams.Intra import Galley.Types.Teams.SearchVisibility import Imports hiding (head) +import Network.HTTP.Types (status200) import Network.Wai import Network.Wai.Predicate hiding (err) import qualified Network.Wai.Predicate as P @@ -171,16 +174,12 @@ sitemap = do -- Enabling this should only be possible internally. -- Viewing the status should be allowed for any admin. - get "/i/teams/:tid/features/:feature" (continue Teams.getFeatureStatusInternalH) $ - capture "tid" - .&. capture "feature" - .&. accept "application" "json" - - put "/i/teams/:tid/features/:feature" (continue Teams.setFeatureStatusInternalH) $ - capture "tid" - .&. capture "feature" - .&. jsonRequest @Public.TeamFeatureStatus - .&. accept "application" "json" + mkFeatureGetAndPutRoute @'Public.TeamFeatureSSO Teams.getSSOStatusInternal Teams.setSSOStatusInternal + mkFeatureGetAndPutRoute @'Public.TeamFeatureLegalHold Teams.getLegalholdStatusInternal Teams.setLegalholdStatusInternal + mkFeatureGetAndPutRoute @'Public.TeamFeatureSearchVisibility Teams.getTeamSearchVisibilityAvailableInternal Teams.setTeamSearchVisibilityAvailableInternal + mkFeatureGetAndPutRoute @'Public.TeamFeatureValidateSAMLEmails Teams.getValidateSAMLEmailsInternal Teams.setValidateSAMLEmailsInternal + mkFeatureGetAndPutRoute @'Public.TeamFeatureDigitalSignatures Teams.getDigitalSignaturesInternal Teams.setDigitalSignaturesInternal + mkFeatureGetAndPutRoute @'Public.TeamFeatureAppLock Teams.getAppLockInternal Teams.setAppLockInternal -- Misc API (internal) ------------------------------------------------ @@ -320,3 +319,34 @@ safeForever funName action = action `catchAny` \exc -> do err $ "error" .= show exc ~~ msg (val $ cs funName <> " failed") threadDelay 60000000 -- pause to keep worst-case noise in logs manageable + +mkFeatureGetAndPutRoute :: + forall (a :: Public.TeamFeatureName) r. + ( Public.KnownTeamFeatureName a, + ToJSON (Public.TeamFeatureStatus a), + FromJSON (Public.TeamFeatureStatus a) + ) => + (TeamId -> Galley (Public.TeamFeatureStatus a)) -> + (TeamId -> Public.TeamFeatureStatus a -> Galley (Public.TeamFeatureStatus a)) -> + Routes r Galley () +mkFeatureGetAndPutRoute getter setter = do + let featureName = Public.knownTeamFeatureName @a + + let getHandler :: TeamId ::: JSON -> Galley Response + getHandler (tid ::: _) = + json <$> Teams.getFeatureStatus @a getter DontDoAuth tid + + get ("/i/teams/:tid/features/" <> toByteString' featureName) (continue getHandler) $ + capture "tid" + .&. accept "application" "json" + + let putHandler :: TeamId ::: JsonRequest (Public.TeamFeatureStatus a) ::: JSON -> Galley Response + putHandler (tid ::: req ::: _) = do + status <- fromJsonBody req + res <- Teams.setFeatureStatus @a setter DontDoAuth tid status + pure $ (json res) & Network.Wai.Utilities.setStatus status200 + + put ("/i/teams/:tid/features/" <> toByteString' featureName) (continue putHandler) $ + capture "tid" + .&. jsonRequest @(Public.TeamFeatureStatus a) + .&. accept "application" "json" diff --git a/services/galley/src/Galley/API/LegalHold.hs b/services/galley/src/Galley/API/LegalHold.hs index bf1719bf7ce..e04d83d4b5d 100644 --- a/services/galley/src/Galley/API/LegalHold.hs +++ b/services/galley/src/Galley/API/LegalHold.hs @@ -61,8 +61,8 @@ assertLegalHoldEnabled tid = unlessM (isLegalHoldEnabled tid) $ throwM legalHold isLegalHoldEnabled :: TeamId -> Galley Bool isLegalHoldEnabled tid = do - lhConfig <- TeamFeatures.getFlag tid Public.TeamFeatureLegalHold - return $ case lhConfig of + statusValue <- Public.tfwoStatus <$$> TeamFeatures.getFeatureStatusNoConfig @'Public.TeamFeatureLegalHold tid + return $ case statusValue of Just Public.TeamFeatureEnabled -> True Just Public.TeamFeatureDisabled -> False Nothing -> False diff --git a/services/galley/src/Galley/API/Public.hs b/services/galley/src/Galley/API/Public.hs index f21292b0e20..14f894df461 100644 --- a/services/galley/src/Galley/API/Public.hs +++ b/services/galley/src/Galley/API/Public.hs @@ -23,9 +23,9 @@ module Galley.API.Public ) where -import Data.Aeson (encode) -import Data.ByteString.Conversion (fromByteString, fromList) -import Data.Id (OpaqueUserId) +import Data.Aeson (FromJSON, ToJSON, encode) +import Data.ByteString.Conversion (fromByteString, fromList, toByteString') +import Data.Id (OpaqueUserId, TeamId, UserId) import qualified Data.Predicate as P import Data.Range import qualified Data.Set as Set @@ -38,6 +38,7 @@ import qualified Galley.API.Error as Error import qualified Galley.API.LegalHold as LegalHold import qualified Galley.API.Query as Query import Galley.API.Swagger (swagger) +import Galley.API.Teams (DoAuth (..)) import qualified Galley.API.Teams as Teams import qualified Galley.API.Update as Update import Galley.App @@ -450,21 +451,12 @@ sitemap = do response 204 "Search visibility set" end errorResponse Error.teamSearchVisibilityNotEnabled - -- Team Feature Flag API ---------------------------------------------- - - get "/teams/:tid/features/:feature" (continue Teams.getFeatureStatusH) $ - zauthUserId - .&. capture "tid" - .&. capture "feature" - .&. accept "application" "json" - document "GET" "getTeamFeature" $ do - summary "Shows whether a feature is enabled for a team" - parameter Path "tid" bytes' $ - description "Team ID" - parameter Path "feature" Public.typeTeamFeatureName $ - description "Feature name" - returns (ref Public.modelTeamFeatureStatus) - response 200 "Team feature status" end + mkFeatureGetAndPutRoute @'Public.TeamFeatureSSO Teams.getSSOStatusInternal Teams.setSSOStatusInternal + mkFeatureGetAndPutRoute @'Public.TeamFeatureLegalHold Teams.getLegalholdStatusInternal Teams.setLegalholdStatusInternal + mkFeatureGetAndPutRoute @'Public.TeamFeatureSearchVisibility Teams.getTeamSearchVisibilityAvailableInternal Teams.setTeamSearchVisibilityAvailableInternal + mkFeatureGetAndPutRoute @'Public.TeamFeatureValidateSAMLEmails Teams.getValidateSAMLEmailsInternal Teams.setValidateSAMLEmailsInternal + mkFeatureGetAndPutRoute @'Public.TeamFeatureDigitalSignatures Teams.getDigitalSignaturesInternal Teams.setDigitalSignaturesInternal + mkFeatureGetAndPutRoute @'Public.TeamFeatureAppLock Teams.getAppLockInternal Teams.setAppLockInternal -- Custom Backend API ------------------------------------------------- @@ -1080,3 +1072,47 @@ filterMissing = (>>= go) <$> (query "ignore_missing" ||| query "report_missing") -- user IDs, and then 'fromList' unwraps it; took me a while to -- understand this Just l -> P.Okay 0 (Set.fromList (fromList l)) + +mkFeatureGetAndPutRoute :: + forall (a :: Public.TeamFeatureName). + ( Public.KnownTeamFeatureName a, + ToJSON (Public.TeamFeatureStatus a), + FromJSON (Public.TeamFeatureStatus a) + ) => + (TeamId -> Galley (Public.TeamFeatureStatus a)) -> + (TeamId -> Public.TeamFeatureStatus a -> Galley (Public.TeamFeatureStatus a)) -> + Routes ApiBuilder Galley () +mkFeatureGetAndPutRoute getter setter = do + let featureName = Public.knownTeamFeatureName @a + + let getHandler :: UserId ::: TeamId ::: JSON -> Galley Response + getHandler (uid ::: tid ::: _) = + json <$> Teams.getFeatureStatus @a getter (DoAuth uid) tid + + get ("/teams/:tid/features/" <> toByteString' featureName) (continue getHandler) $ + zauthUserId + .&. capture "tid" + .&. accept "application" "json" + document "GET" "getTeamFeature" $ do + parameter Path "tid" bytes' $ + description "Team ID" + returns (ref (Public.modelForTeamFeature featureName)) + response 200 "Team feature status" end + + let putHandler :: UserId ::: TeamId ::: JsonRequest (Public.TeamFeatureStatus a) ::: JSON -> Galley Response + putHandler (uid ::: tid ::: req ::: _) = do + status <- fromJsonBody req + res <- Teams.setFeatureStatus @a setter (DoAuth uid) tid status + pure $ (json res) & Network.Wai.Utilities.setStatus status200 + + put ("/teams/:tid/features/" <> toByteString' featureName) (continue putHandler) $ + zauthUserId + .&. capture "tid" + .&. jsonRequest @(Public.TeamFeatureStatus a) + .&. accept "application" "json" + document "PUT" "putTeamFeature" $ do + parameter Path "tid" bytes' $ + description "Team ID" + body (ref (Public.modelForTeamFeature featureName)) $ + description "JSON body" + response 204 "Team feature status" end diff --git a/services/galley/src/Galley/API/Swagger.hs b/services/galley/src/Galley/API/Swagger.hs index 2d0da3ef867..c2abd941200 100644 --- a/services/galley/src/Galley/API/Swagger.hs +++ b/services/galley/src/Galley/API/Swagger.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE DerivingVia #-} {-# OPTIONS_GHC -Wno-incomplete-patterns #-} {-# OPTIONS_GHC -Wno-orphans #-} @@ -40,6 +41,7 @@ import Data.LegalHold import Data.Misc import Data.Proxy import Data.Swagger hiding (Header (..)) +import Data.Swagger.Declare (Declare) import Data.Text as Text (unlines) import Data.UUID (UUID) import Imports @@ -98,9 +100,9 @@ type GalleyRoutesPublic = type GalleyRoutesInternal = "i" :> "teams" :> Capture "tid" TeamId :> "legalhold" - :> Get '[JSON] TeamFeatureStatus + :> Get '[JSON] (TeamFeatureStatus 'TeamFeatureLegalHold) :<|> "i" :> "teams" :> Capture "tid" TeamId :> "legalhold" - :> ReqBody '[JSON] TeamFeatureStatus + :> ReqBody '[JSON] (TeamFeatureStatus 'TeamFeatureLegalHold) :> Put '[] NoContent -- FUTUREWORK: move Swagger instances next to the types they describe @@ -225,19 +227,39 @@ instance ToSchema ViewLegalHoldServiceInfo where ViewLegalHoldService (ViewLegalHoldServiceInfo arbitraryExample arbitraryExample arbitraryExample (ServiceToken "sometoken") arbitraryExample) -instance ToSchema TeamFeatureStatus where +declareNamedSchemaFeatureNoConfig :: f -> Declare (Definitions Schema) NamedSchema +declareNamedSchemaFeatureNoConfig _ = + pure $ + NamedSchema (Just "TeamFeatureStatus") $ + mempty + & properties .~ (fromList [("status", Inline statusValue)]) + & required .~ ["status"] + & type_ ?~ SwaggerObject + & description ?~ "whether a given team feature is enabled" + where + statusValue = + mempty + & enum_ ?~ [String "enabled", String "disabled"] + +instance ToSchema TeamFeatureStatusNoConfig where + declareNamedSchema = declareNamedSchemaFeatureNoConfig + +-- (we're still using the swagger1.2 swagger for this, but let's just keep it around, we may use it later.) +instance ToSchema TeamFeatureAppLockConfig where declareNamedSchema _ = pure $ - NamedSchema (Just "TeamFeatureStatus") $ + NamedSchema (Just "TeamFeatureAppLockConfig") $ mempty - & properties .~ (fromList [("status", Inline statusValue)]) - & required .~ ["status"] - & type_ ?~ SwaggerObject - & description ?~ "whether a given team feature is enabled" + & type_ .~ Just SwaggerObject + & properties .~ configProperties + & required .~ ["enforceAppLock", "inactivityTimeoutSecs"] where - statusValue = - mempty - & enum_ ?~ [String "enabled", String "disabled"] + configProperties :: InsOrdHashMap Text (Referenced Schema) + configProperties = + fromList + [ ("enforceAppLock", Inline (toSchema (Proxy @Bool))), + ("inactivityTimeoutSecs", Inline (toSchema (Proxy @Int))) + ] instance ToSchema RequestNewLegalHoldClient where declareNamedSchema = genericDeclareNamedSchema opts diff --git a/services/galley/src/Galley/API/Teams.hs b/services/galley/src/Galley/API/Teams.hs index 0f73416b321..021106234f0 100644 --- a/services/galley/src/Galley/API/Teams.hs +++ b/services/galley/src/Galley/API/Teams.hs @@ -39,9 +39,6 @@ module Galley.API.Teams getTeamConversationH, getTeamConversationRolesH, deleteTeamConversationH, - getFeatureStatusH, - getFeatureStatusInternalH, - setFeatureStatusInternalH, getSearchVisibilityH, setSearchVisibilityH, getSearchVisibilityInternalH, @@ -55,6 +52,21 @@ module Galley.API.Teams canUserJoinTeamH, internalDeleteBindingTeamWithOneMemberH, internalDeleteBindingTeamWithOneMember, + getFeatureStatus, + setFeatureStatus, + getSSOStatusInternal, + setSSOStatusInternal, + getLegalholdStatusInternal, + setLegalholdStatusInternal, + getTeamSearchVisibilityAvailableInternal, + setTeamSearchVisibilityAvailableInternal, + getValidateSAMLEmailsInternal, + setValidateSAMLEmailsInternal, + getDigitalSignaturesInternal, + setDigitalSignaturesInternal, + getAppLockInternal, + setAppLockInternal, + DoAuth (..), ) where @@ -856,77 +868,77 @@ canUserJoinTeam tid = do when (size >= limit) $ do throwM tooManyTeamMembersOnTeamWithLegalhold --- Public endpoints for feature checks - -getFeatureStatusH :: UserId ::: TeamId ::: Public.TeamFeatureName ::: JSON -> Galley Response -getFeatureStatusH (uid ::: tid ::: featureName ::: _) = - json <$> getFeatureStatus uid tid featureName - -getFeatureStatus :: UserId -> TeamId -> Public.TeamFeatureName -> Galley Public.TeamFeatureStatus -getFeatureStatus uid tid featureName = do - zusrMembership <- Data.teamMember tid uid - void $ permissionCheck (ViewTeamFeature featureName) zusrMembership - getFeatureStatusInternal tid featureName - --- | Get feature flag status for a team. To be called only from authorized personnel (e.g., --- from a backoffice tool) -getFeatureStatusInternalH :: TeamId ::: Public.TeamFeatureName ::: JSON -> Galley Response -getFeatureStatusInternalH (tid ::: featureName ::: _) = do - json <$> getFeatureStatusInternal tid featureName - -getFeatureStatusInternal :: TeamId -> Public.TeamFeatureName -> Galley Public.TeamFeatureStatus -getFeatureStatusInternal tid featureName = do - case featureName of - Public.TeamFeatureLegalHold -> getLegalholdStatusInternal tid - Public.TeamFeatureSSO -> getSSOStatusInternal tid - Public.TeamFeatureSearchVisibility -> getTeamSearchVisibilityAvailableInternal tid - Public.TeamFeatureValidateSAMLEmails -> getValidateSAMLEmailsInternal tid - Public.TeamFeatureDigitalSignatures -> getDigitalSignaturesInternal tid - --- | Enable or disable feature flag for a team. To be called only from authorized personnel --- (e.g., from a backoffice tool) -setFeatureStatusInternalH :: TeamId ::: Public.TeamFeatureName ::: JsonRequest Public.TeamFeatureStatus ::: JSON -> Galley Response -setFeatureStatusInternalH (tid ::: featureName ::: req ::: _) = - (empty & setStatus status204) <$ (setFeatureStatusInternal tid featureName =<< fromJsonBody req) - -setFeatureStatusInternal :: TeamId -> Public.TeamFeatureName -> Public.TeamFeatureStatus -> Galley () -setFeatureStatusInternal tid featureName status = do - case featureName of - Public.TeamFeatureLegalHold -> setLegalholdStatusInternal tid status - Public.TeamFeatureSSO -> setSSOStatusInternal tid status - Public.TeamFeatureSearchVisibility -> setTeamSearchVisibilityAvailableInternal tid status - Public.TeamFeatureValidateSAMLEmails -> setValidateSAMLEmailsInternal tid status - Public.TeamFeatureDigitalSignatures -> setDigitalSignaturesInternal tid status - -getSSOStatusInternal :: TeamId -> Galley Public.TeamFeatureStatus +data DoAuth = DoAuth UserId | DontDoAuth + +getFeatureStatus :: + forall (a :: Public.TeamFeatureName). + Public.KnownTeamFeatureName a => + ( TeamId -> + Galley (Public.TeamFeatureStatus a) + ) -> + DoAuth -> + TeamId -> + Galley (Public.TeamFeatureStatus a) +getFeatureStatus getter doauth tid = do + case doauth of + DoAuth uid -> do + zusrMembership <- Data.teamMember tid uid + void $ permissionCheck (ViewTeamFeature (Public.knownTeamFeatureName @a)) zusrMembership + DontDoAuth -> + pure () + getter tid + +setFeatureStatus :: + forall (a :: Public.TeamFeatureName). + Public.KnownTeamFeatureName a => + ( TeamId -> + Public.TeamFeatureStatus a -> + Galley (Public.TeamFeatureStatus a) + ) -> + DoAuth -> + TeamId -> + Public.TeamFeatureStatus a -> + Galley (Public.TeamFeatureStatus a) +setFeatureStatus setter doauth tid status = do + case doauth of + DoAuth uid -> do + zusrMembership <- Data.teamMember tid uid + void $ permissionCheck (ChangeTeamFeature (Public.knownTeamFeatureName @a)) zusrMembership + DontDoAuth -> + pure () + setter tid status + +getSSOStatusInternal :: TeamId -> Galley (Public.TeamFeatureStatus 'Public.TeamFeatureSSO) getSSOStatusInternal tid = do - defConfig <- do + defStatus <- do featureSSO <- view (options . optSettings . setFeatureFlags . flagSSO) pure $ case featureSSO of - FeatureSSOEnabledByDefault -> Public.TeamFeatureEnabled - FeatureSSODisabledByDefault -> Public.TeamFeatureDisabled - ssoTeamConfig <- TeamFeatures.getFlag tid Public.TeamFeatureSSO - pure . Public.TeamFeatureStatus . fromMaybe defConfig $ ssoTeamConfig - -setSSOStatusInternal :: TeamId -> Public.TeamFeatureStatus -> Galley () -setSSOStatusInternal tid (Public.TeamFeatureStatus status) = do - case status of + FeatureSSOEnabledByDefault -> Public.TeamFeatureStatusNoConfig Public.TeamFeatureEnabled + FeatureSSODisabledByDefault -> Public.TeamFeatureStatusNoConfig Public.TeamFeatureDisabled + status <- TeamFeatures.getFeatureStatusNoConfig @'Public.TeamFeatureSSO tid + pure . fromMaybe defStatus $ status + +setSSOStatusInternal :: TeamId -> (Public.TeamFeatureStatus 'Public.TeamFeatureSSO) -> Galley (Public.TeamFeatureStatus 'Public.TeamFeatureSSO) +setSSOStatusInternal tid status = do + let statusValue = Public.tfwoStatus status + case statusValue of Public.TeamFeatureDisabled -> throwM disableSsoNotImplemented Public.TeamFeatureEnabled -> pure () -- this one is easy to implement :) - TeamFeatures.setFlag tid Public.TeamFeatureSSO status + TeamFeatures.setFeatureStatusNoConfig @'Public.TeamFeatureSSO tid status -getLegalholdStatusInternal :: TeamId -> Galley Public.TeamFeatureStatus +getLegalholdStatusInternal :: TeamId -> Galley (Public.TeamFeatureStatus 'Public.TeamFeatureLegalHold) getLegalholdStatusInternal tid = do featureLegalHold <- view (options . optSettings . setFeatureFlags . flagLegalHold) case featureLegalHold of FeatureLegalHoldDisabledByDefault -> do - status <- TeamFeatures.getFlag tid Public.TeamFeatureLegalHold - pure . Public.TeamFeatureStatus $ fromMaybe Public.TeamFeatureDisabled status + let defaultStatus = Public.TeamFeatureStatusNoConfig Public.TeamFeatureDisabled + status <- TeamFeatures.getFeatureStatusNoConfig @'Public.TeamFeatureLegalHold tid + pure (fromMaybe defaultStatus status) FeatureLegalHoldDisabledPermanently -> do - pure (Public.TeamFeatureStatus Public.TeamFeatureDisabled) + pure (Public.TeamFeatureStatusNoConfig Public.TeamFeatureDisabled) -setLegalholdStatusInternal :: TeamId -> Public.TeamFeatureStatus -> Galley () -setLegalholdStatusInternal tid (Public.TeamFeatureStatus status) = do +setLegalholdStatusInternal :: TeamId -> (Public.TeamFeatureStatus 'Public.TeamFeatureLegalHold) -> Galley (Public.TeamFeatureStatus 'Public.TeamFeatureLegalHold) +setLegalholdStatusInternal tid status@(Public.tfwoStatus -> statusValue) = do do featureLegalHold <- view (options . optSettings . setFeatureFlags . flagLegalHold) case featureLegalHold of @@ -934,11 +946,11 @@ setLegalholdStatusInternal tid (Public.TeamFeatureStatus status) = do pure () FeatureLegalHoldDisabledPermanently -> do throwM legalHoldFeatureFlagNotEnabled - case status of + case statusValue of Public.TeamFeatureDisabled -> removeSettings' tid -- FUTUREWORK: We cannot enable legalhold on large teams right now Public.TeamFeatureEnabled -> checkTeamSize - TeamFeatures.setFlag tid Public.TeamFeatureLegalHold status + TeamFeatures.setFeatureStatusNoConfig @'Public.TeamFeatureLegalHold tid status where checkTeamSize = do (TeamSize size) <- BrigTeam.getSize tid @@ -946,51 +958,69 @@ setLegalholdStatusInternal tid (Public.TeamFeatureStatus status) = do when (size > limit) $ do throwM cannotEnableLegalHoldServiceLargeTeam -getTeamSearchVisibilityAvailableInternal :: TeamId -> Galley Public.TeamFeatureStatus +getTeamSearchVisibilityAvailableInternal :: TeamId -> Galley (Public.TeamFeatureStatus 'Public.TeamFeatureSearchVisibility) getTeamSearchVisibilityAvailableInternal tid = do -- TODO: This is just redundant given there is a decent default defConfig <- do featureTeamSearchVisibility <- view (options . optSettings . setFeatureFlags . flagTeamSearchVisibility) - pure $ case featureTeamSearchVisibility of + pure . Public.TeamFeatureStatusNoConfig $ case featureTeamSearchVisibility of FeatureTeamSearchVisibilityEnabledByDefault -> Public.TeamFeatureEnabled FeatureTeamSearchVisibilityDisabledByDefault -> Public.TeamFeatureDisabled - Public.TeamFeatureStatus . fromMaybe defConfig - <$> TeamFeatures.getFlag tid Public.TeamFeatureSearchVisibility -setTeamSearchVisibilityAvailableInternal :: TeamId -> Public.TeamFeatureStatus -> Galley () -setTeamSearchVisibilityAvailableInternal tid (Public.TeamFeatureStatus status) = do - case status of + fromMaybe defConfig + <$> TeamFeatures.getFeatureStatusNoConfig @'Public.TeamFeatureSearchVisibility tid + +setTeamSearchVisibilityAvailableInternal :: TeamId -> (Public.TeamFeatureStatus 'Public.TeamFeatureSearchVisibility) -> Galley (Public.TeamFeatureStatus 'Public.TeamFeatureSearchVisibility) +setTeamSearchVisibilityAvailableInternal tid status@(Public.tfwoStatus -> statusValue) = do + case statusValue of Public.TeamFeatureDisabled -> SearchVisibilityData.resetSearchVisibility tid Public.TeamFeatureEnabled -> pure () -- This allows the option to be set at the team level - TeamFeatures.setFlag tid Public.TeamFeatureSearchVisibility status + TeamFeatures.setFeatureStatusNoConfig @'Public.TeamFeatureSearchVisibility tid status -getValidateSAMLEmailsInternal :: TeamId -> Galley Public.TeamFeatureStatus -getValidateSAMLEmailsInternal tid = +getValidateSAMLEmailsInternal :: TeamId -> Galley (Public.TeamFeatureStatus 'Public.TeamFeatureValidateSAMLEmails) +getValidateSAMLEmailsInternal tid = do -- FUTUREWORK: we may also want to get a default from the server config file here, like for -- sso, and team search visibility. - Public.TeamFeatureStatus . fromMaybe Public.TeamFeatureDisabled - <$> TeamFeatures.getFlag tid Public.TeamFeatureValidateSAMLEmails + let defaultStatus = Public.TeamFeatureStatusNoConfig Public.TeamFeatureDisabled + fromMaybe defaultStatus + <$> TeamFeatures.getFeatureStatusNoConfig @'Public.TeamFeatureValidateSAMLEmails tid -setValidateSAMLEmailsInternal :: TeamId -> Public.TeamFeatureStatus -> Galley () +setValidateSAMLEmailsInternal :: TeamId -> (Public.TeamFeatureStatus 'Public.TeamFeatureValidateSAMLEmails) -> Galley (Public.TeamFeatureStatus 'Public.TeamFeatureValidateSAMLEmails) setValidateSAMLEmailsInternal tid = - TeamFeatures.setFlag tid Public.TeamFeatureValidateSAMLEmails . Public.teamFeatureStatusValue + TeamFeatures.setFeatureStatusNoConfig @'Public.TeamFeatureValidateSAMLEmails tid -getDigitalSignaturesInternal :: TeamId -> Galley Public.TeamFeatureStatus -getDigitalSignaturesInternal tid = +getDigitalSignaturesInternal :: TeamId -> Galley (Public.TeamFeatureStatus 'Public.TeamFeatureDigitalSignatures) +getDigitalSignaturesInternal tid = do -- FUTUREWORK: we may also want to get a default from the server config file here, like for -- sso, and team search visibility. - Public.TeamFeatureStatus . fromMaybe Public.TeamFeatureDisabled - <$> TeamFeatures.getFlag tid Public.TeamFeatureDigitalSignatures + let defaultStatus = Public.TeamFeatureStatusNoConfig Public.TeamFeatureDisabled + fromMaybe defaultStatus + <$> TeamFeatures.getFeatureStatusNoConfig @'Public.TeamFeatureDigitalSignatures tid -setDigitalSignaturesInternal :: TeamId -> Public.TeamFeatureStatus -> Galley () +setDigitalSignaturesInternal :: TeamId -> (Public.TeamFeatureStatus 'Public.TeamFeatureDigitalSignatures) -> Galley (Public.TeamFeatureStatus 'Public.TeamFeatureDigitalSignatures) setDigitalSignaturesInternal tid = - TeamFeatures.setFlag tid Public.TeamFeatureDigitalSignatures . Public.teamFeatureStatusValue + TeamFeatures.setFeatureStatusNoConfig @'Public.TeamFeatureDigitalSignatures tid -- | Modify and get visibility type for a team (internal, no user permission checks) getSearchVisibilityInternalH :: TeamId ::: JSON -> Galley Response getSearchVisibilityInternalH (tid ::: _) = json <$> getSearchVisibilityInternal tid +getAppLockInternal :: TeamId -> Galley (Public.TeamFeatureStatus 'Public.TeamFeatureAppLock) +getAppLockInternal tid = do + let defaultStatus = + Public.TeamFeatureStatusWithConfig + Public.TeamFeatureEnabled + (Public.TeamFeatureAppLockConfig (Public.EnforceAppLock False) 60) + status <- TeamFeatures.getApplockFeatureStatus tid + pure $ fromMaybe defaultStatus status + +setAppLockInternal :: TeamId -> (Public.TeamFeatureStatus 'Public.TeamFeatureAppLock) -> Galley (Public.TeamFeatureStatus 'Public.TeamFeatureAppLock) +setAppLockInternal tid status = do + when (Public.applockInactivityTimeoutSecs (Public.tfwcConfig status) < 30) $ + throwM inactivityTimeoutTooLow + TeamFeatures.setApplockFeatureStatus tid status + getSearchVisibilityInternal :: TeamId -> Galley TeamSearchVisibilityView getSearchVisibilityInternal = fmap TeamSearchVisibilityView . SearchVisibilityData.getSearchVisibility @@ -1001,8 +1031,8 @@ setSearchVisibilityInternalH (tid ::: req ::: _) = do setSearchVisibilityInternal :: TeamId -> TeamSearchVisibilityView -> Galley () setSearchVisibilityInternal tid (TeamSearchVisibilityView searchVisibility) = do - Public.TeamFeatureStatus status <- getTeamSearchVisibilityAvailableInternal tid - unless (status == Public.TeamFeatureEnabled) $ + status <- getTeamSearchVisibilityAvailableInternal tid + unless (Public.tfwoStatus status == Public.TeamFeatureEnabled) $ throwM teamSearchVisibilityNotEnabled SearchVisibilityData.setSearchVisibility tid searchVisibility diff --git a/services/galley/src/Galley/Data.hs b/services/galley/src/Galley/Data.hs index 5b54cba20ec..baebe821d04 100644 --- a/services/galley/src/Galley/Data.hs +++ b/services/galley/src/Galley/Data.hs @@ -181,7 +181,7 @@ mkResultSet page = ResultSet (result page) typ | otherwise = ResultSetComplete schemaVersion :: Int32 -schemaVersion = 45 +schemaVersion = 46 -- | Insert a conversation code insertCode :: MonadClient m => Code -> m () diff --git a/services/galley/src/Galley/Data/Instances.hs b/services/galley/src/Galley/Data/Instances.hs index 0175d87b5f5..e71b73a94d0 100644 --- a/services/galley/src/Galley/Data/Instances.hs +++ b/services/galley/src/Galley/Data/Instances.hs @@ -154,3 +154,13 @@ instance Cql Domain where toCql = CqlText . domainText fromCql (CqlText txt) = mkDomain txt fromCql _ = Left "Domain: Text expected" + +instance Cql Public.EnforceAppLock where + ctype = Tagged IntColumn + toCql (Public.EnforceAppLock False) = CqlInt 0 + toCql (Public.EnforceAppLock True) = CqlInt 1 + fromCql (CqlInt n) = case n of + 0 -> pure (Public.EnforceAppLock False) + 1 -> pure (Public.EnforceAppLock True) + _ -> Left "fromCql EnforceAppLock: int out of range" + fromCql _ = Left "fromCql EnforceAppLock: int expected" diff --git a/services/galley/src/Galley/Data/TeamFeatures.hs b/services/galley/src/Galley/Data/TeamFeatures.hs index 968958badef..5f314cf7b68 100644 --- a/services/galley/src/Galley/Data/TeamFeatures.hs +++ b/services/galley/src/Galley/Data/TeamFeatures.hs @@ -18,8 +18,10 @@ -- with this program. If not, see . module Galley.Data.TeamFeatures - ( setFlag, - getFlag, + ( getFeatureStatusNoConfig, + setFeatureStatusNoConfig, + getApplockFeatureStatus, + setApplockFeatureStatus, ) where @@ -27,22 +29,14 @@ import Cassandra import Data.Id import Galley.Data.Instances () import Imports -import Wire.API.Team.Feature (TeamFeatureName (..), TeamFeatureStatusValue (..)) - --- | Is a given feature enabled or disabled? Returns 'Nothing' if team does not exist or the --- feature flag in Cassandra is null. -getFlag :: MonadClient m => TeamId -> TeamFeatureName -> m (Maybe TeamFeatureStatusValue) -getFlag tid feature = (>>= runIdentity) <$> retry x1 (query1 (select feature) (params Quorum (Identity tid))) - --- | Enable or disable feature flag. -setFlag :: MonadClient m => TeamId -> TeamFeatureName -> TeamFeatureStatusValue -> m () -setFlag tid feature flag = do retry x5 $ write (update feature) (params Quorum (flag, tid)) - -select :: TeamFeatureName -> PrepQuery R (Identity TeamId) (Identity (Maybe TeamFeatureStatusValue)) -select feature = fromString $ "select " <> toCol feature <> " from team_features where team_id = ?" - -update :: TeamFeatureName -> PrepQuery W (TeamFeatureStatusValue, TeamId) () -update feature = fromString $ "update team_features set " <> toCol feature <> " = ? where team_id = ?" +import Wire.API.Team.Feature + ( TeamFeatureName (..), + TeamFeatureStatus, + TeamFeatureStatusNoConfig (..), + TeamFeatureStatusValue (..), + TeamFeatureStatusWithConfig (..), + ) +import qualified Wire.API.Team.Feature as Public toCol :: TeamFeatureName -> String toCol TeamFeatureLegalHold = "legalhold_status" @@ -50,3 +44,76 @@ toCol TeamFeatureSSO = "sso_status" toCol TeamFeatureSearchVisibility = "search_visibility_status" toCol TeamFeatureValidateSAMLEmails = "validate_saml_emails" toCol TeamFeatureDigitalSignatures = "digital_signatures" +toCol TeamFeatureAppLock = "app_lock_status" + +getFeatureStatusNoConfig :: + forall (a :: Public.TeamFeatureName) m. + ( MonadClient m, + Public.KnownTeamFeatureName a, + Public.FeatureHasNoConfig a + ) => + TeamId -> + m (Maybe (TeamFeatureStatus a)) +getFeatureStatusNoConfig tid = do + let q = query1 (select (Public.knownTeamFeatureName @a)) (params Quorum (Identity tid)) + mStatusValue <- (>>= runIdentity) <$> retry x1 q + pure $ TeamFeatureStatusNoConfig <$> mStatusValue + where + select :: TeamFeatureName -> PrepQuery R (Identity TeamId) (Identity (Maybe TeamFeatureStatusValue)) + select feature = fromString $ "select " <> toCol feature <> " from team_features where team_id = ?" + +setFeatureStatusNoConfig :: + forall (a :: Public.TeamFeatureName) m. + ( MonadClient m, + Public.KnownTeamFeatureName a, + Public.FeatureHasNoConfig a + ) => + TeamId -> + (TeamFeatureStatus a) -> + m (TeamFeatureStatus a) +setFeatureStatusNoConfig tid status = do + let flag = Public.tfwoStatus status + retry x5 $ write (update (Public.knownTeamFeatureName @a)) (params Quorum (flag, tid)) + pure status + where + update :: TeamFeatureName -> PrepQuery W (TeamFeatureStatusValue, TeamId) () + update feature = fromString $ "update team_features set " <> toCol feature <> " = ? where team_id = ?" + +getApplockFeatureStatus :: + (MonadClient m) => + TeamId -> + m (Maybe (TeamFeatureStatus 'Public.TeamFeatureAppLock)) +getApplockFeatureStatus tid = do + let q = query1 (select) (params Quorum (Identity tid)) + mTuple <- retry x1 q + pure $ + mTuple <&> \(statusValue, enforce, timeout) -> + TeamFeatureStatusWithConfig statusValue (Public.TeamFeatureAppLockConfig enforce timeout) + where + select :: PrepQuery R (Identity TeamId) (TeamFeatureStatusValue, Public.EnforceAppLock, Int32) + select = + fromString $ + "select " <> toCol Public.TeamFeatureAppLock <> ", app_lock_enforce, app_lock_inactivity_timeout_secs " + <> "from team_features where team_id = ?" + +setApplockFeatureStatus :: + (MonadClient m) => + TeamId -> + (TeamFeatureStatus 'Public.TeamFeatureAppLock) -> + m (TeamFeatureStatus 'Public.TeamFeatureAppLock) +setApplockFeatureStatus tid status = do + let statusValue = Public.tfwcStatus status + enforce = Public.applockEnforceAppLock . Public.tfwcConfig $ status + timeout = Public.applockInactivityTimeoutSecs . Public.tfwcConfig $ status + retry x5 $ write update (params Quorum (statusValue, enforce, timeout, tid)) + pure status + where + update :: PrepQuery W (TeamFeatureStatusValue, Public.EnforceAppLock, Int32, TeamId) () + update = + fromString $ + "update team_features set " + <> toCol Public.TeamFeatureAppLock + <> " = ?, " + <> "app_lock_enforce = ?, " + <> "app_lock_inactivity_timeout_secs = ? " + <> "where team_id = ?" diff --git a/services/galley/test/integration/API/Teams.hs b/services/galley/test/integration/API/Teams.hs index dcd0b09600a..f42be4cfd6b 100644 --- a/services/galley/test/integration/API/Teams.hs +++ b/services/galley/test/integration/API/Teams.hs @@ -288,10 +288,9 @@ testEnableSSOPerTeam = do assertQueue "create team" tActivate let check :: HasCallStack => String -> Public.TeamFeatureStatusValue -> TestM () check msg enabledness = do - status <- - Public.teamFeatureStatusValue . responseJsonUnsafe - <$> (getSSOEnabledInternal tid (getSSOEnabledInternal tid TestM () putSSOEnabledInternalCheckNotImplemented = do g <- view tsGalley @@ -300,7 +299,7 @@ testEnableSSOPerTeam = do <$> put ( g . paths ["i", "teams", toByteString' tid, "features", "sso"] - . json (Public.TeamFeatureStatus Public.TeamFeatureDisabled) + . json (Public.TeamFeatureStatusNoConfig Public.TeamFeatureDisabled) ) liftIO $ do assertEqual "bad status" status403 status @@ -319,10 +318,10 @@ testEnableTeamSearchVisibilityPerTeam = do (tid, owner, (member : _)) <- Util.createBindingTeamWithMembers 2 let check :: (HasCallStack, MonadCatch m, MonadIO m, Monad m, MonadHttp m) => String -> Public.TeamFeatureStatusValue -> m () check msg enabledness = do - status <- - Public.teamFeatureStatusValue . responseJsonUnsafe - <$> (Util.getTeamSearchVisibilityAvailableInternal g tid (Util.getTeamSearchVisibilityAvailableInternal g tid m () putSearchVisibilityCheckNotAllowed = do Wai.Error status label _ <- responseJsonUnsafe <$> putSearchVisibility g owner tid SearchVisibilityNoNameOutsideTeam @@ -1893,7 +1892,7 @@ getSSOEnabledInternal :: HasCallStack => TeamId -> TestM ResponseLBS getSSOEnabledInternal = Util.getTeamFeatureFlagInternal Public.TeamFeatureSSO putSSOEnabledInternal :: HasCallStack => TeamId -> Public.TeamFeatureStatusValue -> TestM () -putSSOEnabledInternal = Util.putTeamFeatureFlagInternal' Public.TeamFeatureSSO expect2xx +putSSOEnabledInternal tid statusValue = Util.putTeamFeatureFlagInternal @'Public.TeamFeatureSSO expect2xx tid (Public.TeamFeatureStatusNoConfig statusValue) getSearchVisibility :: HasCallStack => (Request -> Request) -> UserId -> TeamId -> (MonadIO m, MonadHttp m) => m ResponseLBS getSearchVisibility g uid tid = do diff --git a/services/galley/test/integration/API/Teams/Feature.hs b/services/galley/test/integration/API/Teams/Feature.hs index 79b2e1f3f8b..f4162d50248 100644 --- a/services/galley/test/integration/API/Teams/Feature.hs +++ b/services/galley/test/integration/API/Teams/Feature.hs @@ -23,7 +23,8 @@ import Bilge import Bilge.Assert import Control.Lens (view) import Control.Monad.Catch (MonadCatch) -import Data.Id (TeamId) +import Data.Aeson (FromJSON, ToJSON) +import Data.Id import Data.List1 (list1) import Galley.Options (optSettings, setFeatureFlags) import Galley.Types.Teams @@ -40,8 +41,8 @@ tests s = [ test s "SSO" testSSO, test s "LegalHold" testLegalHold, test s "SearchVisibility" testSearchVisibility, - test s "DigitalSignatures" $ testSimpleFlag Public.TeamFeatureDigitalSignatures, - test s "ValidateSAMLEmails" $ testSimpleFlag Public.TeamFeatureValidateSAMLEmails + test s "DigitalSignatures" $ testSimpleFlag @'Public.TeamFeatureDigitalSignatures, + test s "ValidateSAMLEmails" $ testSimpleFlag @'Public.TeamFeatureValidateSAMLEmails ] testSSO :: TestM () @@ -53,11 +54,11 @@ testSSO = do Util.addTeamMember owner tid (Public.newTeamMember member (rolePermissions RoleMember) Nothing) let getSSO :: HasCallStack => Public.TeamFeatureStatusValue -> TestM () - getSSO = assertFlag $ Util.getTeamFeatureFlag Public.TeamFeatureSSO member tid + getSSO = assertFlagNoConfig @'Public.TeamFeatureSSO $ Util.getTeamFeatureFlag Public.TeamFeatureSSO member tid getSSOInternal :: HasCallStack => Public.TeamFeatureStatusValue -> TestM () - getSSOInternal = assertFlag $ Util.getTeamFeatureFlagInternal Public.TeamFeatureSSO tid + getSSOInternal = assertFlagNoConfig @'Public.TeamFeatureSSO $ Util.getTeamFeatureFlagInternal Public.TeamFeatureSSO tid setSSOInternal :: HasCallStack => Public.TeamFeatureStatusValue -> TestM () - setSSOInternal = Util.putTeamFeatureFlagInternal' Public.TeamFeatureSSO expect2xx tid + setSSOInternal = Util.putTeamFeatureFlagInternal @'Public.TeamFeatureSSO expect2xx tid . Public.TeamFeatureStatusNoConfig featureSSO <- view (tsGConf . optSettings . setFeatureFlags . flagSSO) case featureSSO of FeatureSSODisabledByDefault -> do @@ -84,11 +85,12 @@ testLegalHold = do Util.addTeamMember owner tid (Public.newTeamMember member (rolePermissions RoleMember) Nothing) let getLegalHold :: HasCallStack => Public.TeamFeatureStatusValue -> TestM () - getLegalHold = assertFlag $ Util.getTeamFeatureFlag Public.TeamFeatureLegalHold member tid + getLegalHold = assertFlagNoConfig @'Public.TeamFeatureLegalHold $ Util.getTeamFeatureFlag Public.TeamFeatureLegalHold member tid getLegalHoldInternal :: HasCallStack => Public.TeamFeatureStatusValue -> TestM () - getLegalHoldInternal = assertFlag $ Util.getTeamFeatureFlagInternal Public.TeamFeatureLegalHold tid + getLegalHoldInternal = assertFlagNoConfig @'Public.TeamFeatureLegalHold $ Util.getTeamFeatureFlagInternal Public.TeamFeatureLegalHold tid + setLegalHoldInternal :: HasCallStack => Public.TeamFeatureStatusValue -> TestM () - setLegalHoldInternal = Util.putTeamFeatureFlagInternal' Public.TeamFeatureLegalHold expect2xx tid + setLegalHoldInternal = Util.putTeamFeatureFlagInternal @'Public.TeamFeatureLegalHold expect2xx tid . Public.TeamFeatureStatusNoConfig getLegalHold Public.TeamFeatureDisabled getLegalHoldInternal Public.TeamFeatureDisabled @@ -124,7 +126,7 @@ testSearchVisibility = do getTeamSearchVisibility teamid expected = Util.getTeamSearchVisibilityAvailable g owner teamid !!! do statusCode === const 200 - responseJsonEither === const (Right (Public.TeamFeatureStatus expected)) + responseJsonEither === const (Right (Public.TeamFeatureStatusNoConfig expected)) let getTeamSearchVisibilityInternal :: (Monad m, MonadHttp m, MonadIO m, MonadCatch m, HasCallStack) => @@ -134,7 +136,7 @@ testSearchVisibility = do getTeamSearchVisibilityInternal teamid expected = Util.getTeamSearchVisibilityAvailableInternal g teamid !!! do statusCode === const 200 - responseJsonEither === const (Right (Public.TeamFeatureStatus expected)) + responseJsonEither === const (Right (Public.TeamFeatureStatusNoConfig expected)) let setTeamSearchVisibilityInternal :: (Monad m, MonadHttp m, MonadIO m, HasCallStack) => @@ -164,32 +166,60 @@ testSearchVisibility = do getTeamSearchVisibility tid3 Public.TeamFeatureEnabled getTeamSearchVisibilityInternal tid3 Public.TeamFeatureEnabled -testSimpleFlag :: Public.TeamFeatureName -> TestM () -testSimpleFlag feature = do +testSimpleFlag :: + forall (a :: Public.TeamFeatureName). + ( HasCallStack, + Typeable a, + Public.FeatureHasNoConfig a, + Public.KnownTeamFeatureName a, + FromJSON (Public.TeamFeatureStatus a), + ToJSON (Public.TeamFeatureStatus a) + ) => + TestM () +testSimpleFlag = do + let feature = Public.knownTeamFeatureName @a owner <- Util.randomUser member <- Util.randomUser tid <- Util.createNonBindingTeam "foo" owner [] Util.connectUsers owner (list1 member []) Util.addTeamMember owner tid (Public.newTeamMember member (rolePermissions RoleMember) Nothing) - let getFlag :: HasCallStack => Public.TeamFeatureName -> Public.TeamFeatureStatusValue -> TestM () - getFlag f expected = flip assertFlag expected $ Util.getTeamFeatureFlag f member tid - getFlagInternal :: HasCallStack => Public.TeamFeatureName -> Public.TeamFeatureStatusValue -> TestM () - getFlagInternal f expected = flip assertFlag expected $ Util.getTeamFeatureFlagInternal f tid - setFlagInternal :: HasCallStack => Public.TeamFeatureName -> Public.TeamFeatureStatusValue -> TestM () - setFlagInternal f = Util.putTeamFeatureFlagInternal' f expect2xx tid + let getFlag :: HasCallStack => Public.TeamFeatureStatusValue -> TestM () + getFlag expected = + flip (assertFlagNoConfig @a) expected $ Util.getTeamFeatureFlag feature member tid + + getFlagInternal :: HasCallStack => Public.TeamFeatureStatusValue -> TestM () + getFlagInternal expected = + flip (assertFlagNoConfig @a) expected $ Util.getTeamFeatureFlagInternal feature tid + + setFlagInternal :: Public.TeamFeatureStatusValue -> TestM () + setFlagInternal statusValue = + Util.putTeamFeatureFlagInternal @a expect2xx tid (Public.TeamFeatureStatusNoConfig statusValue) -- Disabled by default - getFlag feature Public.TeamFeatureDisabled - getFlagInternal feature Public.TeamFeatureDisabled + getFlag Public.TeamFeatureDisabled + getFlagInternal Public.TeamFeatureDisabled -- Settting should work - setFlagInternal feature Public.TeamFeatureEnabled - getFlag feature Public.TeamFeatureEnabled - getFlagInternal feature Public.TeamFeatureEnabled - -assertFlag :: HasCallStack => TestM ResponseLBS -> Public.TeamFeatureStatusValue -> TestM () -assertFlag res expected = + setFlagInternal Public.TeamFeatureEnabled + getFlag Public.TeamFeatureEnabled + getFlagInternal Public.TeamFeatureEnabled + +assertFlagNoConfig :: + forall (a :: Public.TeamFeatureName). + ( HasCallStack, + Typeable a, + Public.FeatureHasNoConfig a, + FromJSON (Public.TeamFeatureStatus a), + Public.KnownTeamFeatureName a + ) => + TestM ResponseLBS -> + Public.TeamFeatureStatusValue -> + TestM () +assertFlagNoConfig res expected = do res !!! do statusCode === const 200 - responseJsonEither === const (Right (Public.TeamFeatureStatus expected)) + ( fmap Public.tfwoStatus + . responseJsonEither @(Public.TeamFeatureStatus a) + ) + === const (Right expected) diff --git a/services/galley/test/integration/API/Teams/LegalHold.hs b/services/galley/test/integration/API/Teams/LegalHold.hs index 01481bfa563..07cce83e75b 100644 --- a/services/galley/test/integration/API/Teams/LegalHold.hs +++ b/services/galley/test/integration/API/Teams/LegalHold.hs @@ -497,12 +497,14 @@ testEnablePerTeam = do addTeamMemberInternal tid $ newTeamMember member (rolePermissions RoleMember) Nothing ensureQueueEmpty do - Public.TeamFeatureStatus status <- responseJsonUnsafe <$> (getEnabled tid (getEnabled tid (getEnabled tid (getEnabled tid do requestLegalHoldDevice owner member tid !!! const 201 === statusCode approveLegalHoldDevice (Just defPassword) member member tid !!! testResponse 200 Nothing @@ -511,8 +513,9 @@ testEnablePerTeam = do liftIO $ assertEqual "User legal hold status should be enabled" UserLegalHoldEnabled status do putEnabled tid Public.TeamFeatureDisabled -- disable again - Public.TeamFeatureStatus status <- responseJsonUnsafe <$> (getEnabled tid (getEnabled tid (getEnabled tid (getEnabled tid (getEnabled tid (getEnabled tid UserId -> TeamId -> NewLegalHoldService -> TestM ResponseLBS diff --git a/services/galley/test/integration/API/Util/TeamFeature.hs b/services/galley/test/integration/API/Util/TeamFeature.hs index 99299b3ad64..a16be31d0d4 100644 --- a/services/galley/test/integration/API/Util/TeamFeature.hs +++ b/services/galley/test/integration/API/Util/TeamFeature.hs @@ -21,6 +21,7 @@ import API.Util (zUser) import qualified API.Util as Util import Bilge import Control.Lens (view, (.~)) +import Data.Aeson (ToJSON) import Data.ByteString.Conversion (toByteString') import Data.Id (TeamId, UserId) import Galley.Options (optSettings, setFeatureFlags) @@ -43,34 +44,36 @@ getTeamSearchVisibilityAvailableInternal :: HasCallStack => (Request -> Request) getTeamSearchVisibilityAvailableInternal = getTeamFeatureFlagInternalWithGalley Public.TeamFeatureSearchVisibility -putTeamSearchVisibilityAvailableInternal :: HasCallStack => (Request -> Request) -> TeamId -> Public.TeamFeatureStatusValue -> (MonadIO m, MonadHttp m) => m () -putTeamSearchVisibilityAvailableInternal g = - putTeamFeatureFlagInternalWithGalleyAndMod Public.TeamFeatureSearchVisibility g expect2xx - -putLegalHoldEnabledInternal' :: HasCallStack => (Request -> Request) -> TeamId -> Public.TeamFeatureStatusValue -> TestM () -putLegalHoldEnabledInternal' = putTeamFeatureFlagInternal' Public.TeamFeatureLegalHold - -putTeamFeatureFlagInternal' :: HasCallStack => Public.TeamFeatureName -> (Request -> Request) -> TeamId -> Public.TeamFeatureStatusValue -> TestM () -putTeamFeatureFlagInternal' feature reqmod tid status = do - g <- view tsGalley - putTeamFeatureFlagInternalWithGalleyAndMod feature g reqmod tid status - -putTeamFeatureFlagInternalWithGalleyAndMod :: - (MonadIO m, MonadHttp m, HasCallStack) => - Public.TeamFeatureName -> +putTeamSearchVisibilityAvailableInternal :: + HasCallStack => (Request -> Request) -> + TeamId -> + Public.TeamFeatureStatusValue -> + (MonadIO m, MonadHttp m) => m () +putTeamSearchVisibilityAvailableInternal g tid statusValue = + putTeamFeatureFlagInternalWithGalleyAndMod + @'Public.TeamFeatureSearchVisibility + g + expect2xx + tid + (Public.TeamFeatureStatusNoConfig statusValue) + +putLegalHoldEnabledInternal' :: + HasCallStack => (Request -> Request) -> TeamId -> Public.TeamFeatureStatusValue -> - m () -putTeamFeatureFlagInternalWithGalleyAndMod feature galley reqmod tid status = - void . put $ - galley - . paths ["i", "teams", toByteString' tid, "features", toByteString' feature] - . json (Public.TeamFeatureStatus status) - . reqmod + TestM () +putLegalHoldEnabledInternal' g tid statusValue = + putTeamFeatureFlagInternal @'Public.TeamFeatureLegalHold g tid (Public.TeamFeatureStatusNoConfig statusValue) + +-------------------------------------------------------------------------------- -getTeamFeatureFlagInternal :: HasCallStack => Public.TeamFeatureName -> TeamId -> TestM ResponseLBS +getTeamFeatureFlagInternal :: + (HasCallStack) => + Public.TeamFeatureName -> + TeamId -> + TestM ResponseLBS getTeamFeatureFlagInternal feature tid = do g <- view tsGalley getTeamFeatureFlagInternalWithGalley feature g tid @@ -92,3 +95,37 @@ getTeamFeatureFlagWithGalley feature galley uid tid = do galley . paths ["teams", toByteString' tid, "features", toByteString' feature] . zUser uid + +putTeamFeatureFlagInternal :: + forall (a :: Public.TeamFeatureName). + ( HasCallStack, + Public.KnownTeamFeatureName a, + ToJSON (Public.TeamFeatureStatus a) + ) => + (Request -> Request) -> + TeamId -> + (Public.TeamFeatureStatus a) -> + TestM () +putTeamFeatureFlagInternal reqmod tid status = do + g <- view tsGalley + putTeamFeatureFlagInternalWithGalleyAndMod @a g reqmod tid status + +putTeamFeatureFlagInternalWithGalleyAndMod :: + forall (a :: Public.TeamFeatureName) m. + ( MonadIO m, + MonadHttp m, + HasCallStack, + Public.KnownTeamFeatureName a, + ToJSON (Public.TeamFeatureStatus a) + ) => + (Request -> Request) -> + (Request -> Request) -> + TeamId -> + (Public.TeamFeatureStatus a) -> + m () +putTeamFeatureFlagInternalWithGalleyAndMod galley reqmod tid status = + void . put $ + galley + . paths ["i", "teams", toByteString' tid, "features", toByteString' (Public.knownTeamFeatureName @a)] + . json status + . reqmod diff --git a/services/spar/src/Spar/Intra/Galley.hs b/services/spar/src/Spar/Intra/Galley.hs index d62e79cd6ab..61a355978d9 100644 --- a/services/spar/src/Spar/Intra/Galley.hs +++ b/services/spar/src/Spar/Intra/Galley.hs @@ -33,7 +33,7 @@ import Imports import Network.HTTP.Types (status403) import Network.HTTP.Types.Method import Spar.Error -import Wire.API.Team.Feature (TeamFeatureStatus (..), TeamFeatureStatusValue (..)) +import Wire.API.Team.Feature (TeamFeatureName (..), TeamFeatureStatus, TeamFeatureStatusNoConfig (..), TeamFeatureStatusValue (..)) ---------------------------------------------------------------------- @@ -88,11 +88,16 @@ assertSSOEnabled tid = do . paths ["i", "teams", toByteString' tid, "features", "sso"] unless (statusCode resp == 200) $ throwSpar (SparGalleyError "Could not retrieve SSO config") - TeamFeatureStatus status <- parseResponse resp + TeamFeatureStatusNoConfig status <- parseResponse resp unless (status == TeamFeatureEnabled) $ throwSpar SparSSODisabled isEmailValidationEnabledTeam :: (HasCallStack, MonadSparToGalley m) => TeamId -> m Bool isEmailValidationEnabledTeam tid = do resp <- call $ method GET . paths ["i", "teams", toByteString' tid, "features", "validate-saml-emails"] - pure (statusCode resp == 200 && responseJsonMaybe resp == Just (TeamFeatureStatus TeamFeatureEnabled)) + pure + ( (statusCode resp == 200) + && ( responseJsonMaybe @(TeamFeatureStatus 'TeamFeatureValidateSAMLEmails) resp + == Just (TeamFeatureStatusNoConfig TeamFeatureEnabled) + ) + ) diff --git a/services/spar/test-integration/Test/Spar/Scim/UserSpec.hs b/services/spar/test-integration/Test/Spar/Scim/UserSpec.hs index 6c90d943607..369de4c11b2 100644 --- a/services/spar/test-integration/Test/Spar/Scim/UserSpec.hs +++ b/services/spar/test-integration/Test/Spar/Scim/UserSpec.hs @@ -1524,9 +1524,9 @@ specEmailValidation = do let enableSamlEmailValidation :: HasCallStack => TeamId -> TestSpar () enableSamlEmailValidation tid = do galley <- asks (^. teGalley) - let req = put $ galley . paths p . json (Feature.TeamFeatureStatus Feature.TeamFeatureEnabled) + let req = put $ galley . paths p . json (Feature.TeamFeatureStatusNoConfig Feature.TeamFeatureEnabled) p = ["/i/teams", toByteString' tid, "features", "validate-saml-emails"] - call req !!! const 204 === statusCode + call req !!! const 200 === statusCode -- (This may be the same as 'Util.Email.checkEmail'.) assertEmail :: HasCallStack => UserId -> Maybe Email -> TestSpar () diff --git a/services/spar/test-integration/Util/Core.hs b/services/spar/test-integration/Util/Core.hs index 3f471fe849f..3fe3566dec2 100644 --- a/services/spar/test-integration/Util/Core.hs +++ b/services/spar/test-integration/Util/Core.hs @@ -189,7 +189,8 @@ import URI.ByteString import Util.Options import Util.Types import qualified Web.Cookie as Web -import Wire.API.Team.Feature (TeamFeatureStatus (..), TeamFeatureStatusValue (..)) +import Wire.API.Team.Feature (TeamFeatureStatusValue (..)) +import qualified Wire.API.Team.Feature as Public import qualified Wire.API.Team.Invitation as TeamInvitation import qualified Wire.API.User as User @@ -363,7 +364,7 @@ putSSOEnabledInternal gly tid enabled = do void . put $ gly . paths ["i", "teams", toByteString' tid, "features", "sso"] - . json (TeamFeatureStatus enabled) + . json (Public.TeamFeatureStatusNoConfig enabled) . expect2xx -- | cloned from `/services/brig/test/integration/API/Team/Util.hs`. diff --git a/tools/stern/src/Stern/API.hs b/tools/stern/src/Stern/API.hs index 1e20b506dc4..416744a3eb6 100644 --- a/tools/stern/src/Stern/API.hs +++ b/tools/stern/src/Stern/API.hs @@ -324,34 +324,12 @@ routes = do Doc.response 200 "Team Information about Owners and Admins" Doc.end -- feature flags - - get "/teams/:tid/features/:feature" (continue getTeamFeatureFlagH) $ - capture "tid" - .&. capture "feature" - document "GET" "getTeamFeatureFlag" $ do - summary "Shows whether a feature flag is enabled or not for a given team." - Doc.parameter Doc.Path "tid" Doc.bytes' $ - description "Team ID" - Doc.parameter Doc.Path "feature" Public.typeTeamFeatureName $ - description "Feature name" - Doc.returns (Doc.ref Public.modelTeamFeatureStatus) - Doc.response 200 "Team feature flag status" Doc.end - - put "/teams/:tid/features/:feature" (continue setTeamFeatureFlagH) $ - capture "tid" - .&. capture "feature" - -- We use a query parameter "status" here instead of a JSON body. - -- This improves usability, since swagger-ui displays is as a dropdown, not a text box. - .&. param "status" - document "PUT" "setTeamFeatureFlag" $ do - summary "Disable / enable feature flag for a given team" - Doc.parameter Doc.Path "tid" Doc.bytes' $ - description "Team ID" - Doc.parameter Doc.Path "feature" Public.typeTeamFeatureName $ - description "Feature name" - Doc.parameter Doc.Query "status" Public.typeTeamFeatureStatusValue $ do - Doc.description "team feature status (enabled or disabled)" - Doc.response 200 "Team feature flag status" Doc.end + mkFeaturePutGetRoute @'Public.TeamFeatureLegalHold + mkFeaturePutGetRoute @'Public.TeamFeatureSSO + mkFeaturePutGetRoute @'Public.TeamFeatureSearchVisibility + mkFeaturePutGetRoute @'Public.TeamFeatureValidateSAMLEmails + mkFeaturePutGetRoute @'Public.TeamFeatureDigitalSignatures + mkFeaturePutGetRoute @'Public.TeamFeatureAppLock -- These endpoints should be part of team settings. Until then, we access them from here -- for authorized personnel to enable/disable this on the team's behalf @@ -578,13 +556,29 @@ getTeamInfo = liftM json . Intra.getTeamInfo getTeamAdminInfo :: TeamId -> Handler Response getTeamAdminInfo = liftM (json . toAdminInfo) . Intra.getTeamInfo -getTeamFeatureFlagH :: TeamId ::: Public.TeamFeatureName -> Handler Response -getTeamFeatureFlagH (tid ::: feature) = - json <$> Intra.getTeamFeatureFlag tid feature - -setTeamFeatureFlagH :: TeamId ::: Public.TeamFeatureName ::: Public.TeamFeatureStatusValue -> Handler Response -setTeamFeatureFlagH (tid ::: feature ::: status) = do - empty <$ Intra.setTeamFeatureFlag tid feature status +getTeamFeatureFlagH :: + forall (a :: Public.TeamFeatureName). + ( Public.KnownTeamFeatureName a, + FromJSON (Public.TeamFeatureStatus a), + ToJSON (Public.TeamFeatureStatus a), + Typeable (Public.TeamFeatureStatus a) + ) => + TeamId -> + Handler Response +getTeamFeatureFlagH tid = + json <$> Intra.getTeamFeatureFlag @a tid + +setTeamFeatureFlagH :: + forall (a :: Public.TeamFeatureName). + ( Public.KnownTeamFeatureName a, + FromJSON (Public.TeamFeatureStatus a), + ToJSON (Public.TeamFeatureStatus a) + ) => + TeamId ::: JsonRequest (Public.TeamFeatureStatus a) ::: JSON -> + Handler Response +setTeamFeatureFlagH (tid ::: req ::: _) = do + status :: Public.TeamFeatureStatus a <- parseBody req !>> Error status400 "client-error" + empty <$ Intra.setTeamFeatureFlag @a tid status setSearchVisibility :: JSON ::: TeamId ::: JsonRequest Team.TeamSearchVisibility -> Handler Response setSearchVisibility (_ ::: tid ::: req) = do @@ -709,3 +703,35 @@ ifNothing e = maybe (throwE e) return noSuchUser :: Maybe a -> Handler a noSuchUser = ifNothing (Error status404 "no-user" "No such user") + +mkFeaturePutGetRoute :: + forall (a :: Public.TeamFeatureName). + ( Public.KnownTeamFeatureName a, + FromJSON (Public.TeamFeatureStatus a), + ToJSON (Public.TeamFeatureStatus a), + Typeable (Public.TeamFeatureStatus a) + ) => + Routes Doc.ApiBuilder Handler () +mkFeaturePutGetRoute = do + let featureName = Public.knownTeamFeatureName @a + + get ("/teams/:tid/features/" <> toByteString' featureName) (continue (getTeamFeatureFlagH @a)) $ + capture "tid" + document "GET" "getTeamFeatureFlag" $ do + summary "Shows whether a feature flag is enabled or not for a given team." + Doc.parameter Doc.Path "tid" Doc.bytes' $ + description "Team ID" + Doc.returns (Doc.ref (Public.modelForTeamFeature featureName)) + Doc.response 200 "Team feature flag status" Doc.end + + put ("/teams/:tid/features/" <> toByteString' featureName) (continue (setTeamFeatureFlagH @a)) $ + capture "tid" + .&. jsonRequest @(Public.TeamFeatureStatus a) + .&. accept "application" "json" + document "PUT" "setTeamFeatureFlag" $ do + summary "Disable / enable feature flag for a given team" + Doc.parameter Doc.Path "tid" Doc.bytes' $ + description "Team ID" + Doc.body (Doc.ref (Public.modelForTeamFeature featureName)) $ + Doc.description "JSON body" + Doc.response 200 "Team feature flag status" Doc.end diff --git a/tools/stern/src/Stern/Intra.hs b/tools/stern/src/Stern/Intra.hs index 8fc0645b991..8ffd65bd5d8 100644 --- a/tools/stern/src/Stern/Intra.hs +++ b/tools/stern/src/Stern/Intra.hs @@ -425,24 +425,38 @@ setBlacklistStatus status emailOrPhone = do statusToMethod False = DELETE statusToMethod True = POST -getTeamFeatureFlag :: TeamId -> Public.TeamFeatureName -> Handler Public.TeamFeatureStatus -getTeamFeatureFlag tid feature = do +getTeamFeatureFlag :: + forall (a :: Public.TeamFeatureName). + ( Public.KnownTeamFeatureName a, + Typeable (Public.TeamFeatureStatus a), + FromJSON (Public.TeamFeatureStatus a) + ) => + TeamId -> + Handler (Public.TeamFeatureStatus a) +getTeamFeatureFlag tid = do info $ msg "Getting team feature status" gly <- view galley let req = method GET - . paths ["/i/teams", toByteString' tid, "features", toByteString' feature] + . paths ["/i/teams", toByteString' tid, "features", toByteString' (Public.knownTeamFeatureName @a)] . expect2xx - responseJsonUnsafe <$> catchRpcErrors (rpc' "galley" gly req) - -setTeamFeatureFlag :: TeamId -> Public.TeamFeatureName -> Public.TeamFeatureStatusValue -> Handler () -setTeamFeatureFlag tid feature status = do + responseJsonUnsafe @(Public.TeamFeatureStatus a) <$> catchRpcErrors (rpc' "galley" gly req) + +setTeamFeatureFlag :: + forall (a :: Public.TeamFeatureName). + ( Public.KnownTeamFeatureName a, + ToJSON (Public.TeamFeatureStatus a) + ) => + TeamId -> + Public.TeamFeatureStatus a -> + Handler () +setTeamFeatureFlag tid status = do info $ msg "Setting team feature status" gly <- view galley let req = method PUT - . paths ["/i/teams", toByteString' tid, "features", toByteString' feature] - . Bilge.json (Public.TeamFeatureStatus status) + . paths ["/i/teams", toByteString' tid, "features", toByteString' (Public.knownTeamFeatureName @a)] + . Bilge.json status . contentJson resp <- catchRpcErrors $ rpc' "galley" gly req case statusCode resp of diff --git a/tools/stern/src/Stern/Swagger.hs b/tools/stern/src/Stern/Swagger.hs index db7699c714e..6c7ed5095ad 100644 --- a/tools/stern/src/Stern/Swagger.hs +++ b/tools/stern/src/Stern/Swagger.hs @@ -21,6 +21,7 @@ module Stern.Swagger where import Data.Swagger.Build.Api import Imports +import qualified Wire.API.Team.Feature as Feature import Wire.API.Team.SearchVisibility (modelTeamSearchVisibility) sternModels :: [Model] @@ -31,6 +32,7 @@ sternModels = teamBillingInfo, teamBillingInfoUpdate ] + <> (Feature.modelForTeamFeature <$> [minBound ..]) emailUpdate :: Model emailUpdate = defineModel "EmailUpdate" $ do From aca893a3a80ff6c3c2e5625f4eae7a3a1e05813d Mon Sep 17 00:00:00 2001 From: Stefan Matting Date: Mon, 23 Nov 2020 17:13:14 +0100 Subject: [PATCH 27/34] App-Lock follow-up (#1253) * Fix bug: stern cannot set features (204 expected instead of 200) * Fix bug: GET features/app-lock 500 when other feature flags set * Fix: TeamFeatureAppLockConfig schema missing from the swagger docs * Fix: internal feature flag doesnt check existence of team * Use camelCase for feature flags , allow deprecated kebab-case * Add features/ endpoint * move appLock defaults hardcoded -> config file * Revert "move appLock defaults hardcoded -> config file" This reverts commit 4cc033a86d9b96d1dab1330ccdcc26e09fbf2e9c. * Update services/galley/src/Galley/API/Internal.hs Co-authored-by: fisx * Update services/galley/src/Galley/API/Internal.hs Co-authored-by: fisx * equivalent by category theory ;) * apply suggestions from PR review Co-authored-by: Matthias Fischmann --- libs/wire-api/src/Wire/API/Swagger.hs | 1 + libs/wire-api/src/Wire/API/Team/Feature.hs | 20 +++++-- .../brig/test/integration/API/Team/Util.hs | 2 +- services/galley/src/Galley/API/Internal.hs | 24 +++++--- services/galley/src/Galley/API/Public.hs | 60 ++++++++++++------- services/galley/src/Galley/API/Teams.hs | 33 +++++++++- services/galley/src/Galley/API/Util.hs | 7 +++ .../galley/src/Galley/Data/TeamFeatures.hs | 6 +- services/spar/src/Spar/Intra/Galley.hs | 2 +- .../Test/Spar/Scim/UserSpec.hs | 2 +- tools/stern/src/Stern/Intra.hs | 4 +- 11 files changed, 118 insertions(+), 43 deletions(-) diff --git a/libs/wire-api/src/Wire/API/Swagger.hs b/libs/wire-api/src/Wire/API/Swagger.hs index 0478b64b3fc..0484c0eb614 100644 --- a/libs/wire-api/src/Wire/API/Swagger.hs +++ b/libs/wire-api/src/Wire/API/Swagger.hs @@ -126,6 +126,7 @@ models = Team.Feature.modelForTeamFeature Team.Feature.TeamFeatureValidateSAMLEmails, Team.Feature.modelForTeamFeature Team.Feature.TeamFeatureDigitalSignatures, Team.Feature.modelForTeamFeature Team.Feature.TeamFeatureAppLock, + Team.Feature.modelTeamFeatureAppLockConfig, Team.Invitation.modelTeamInvitation, Team.Invitation.modelTeamInvitationList, Team.Invitation.modelTeamInvitationRequest, diff --git a/libs/wire-api/src/Wire/API/Team/Feature.hs b/libs/wire-api/src/Wire/API/Team/Feature.hs index e9af1051138..148ba6da952 100644 --- a/libs/wire-api/src/Wire/API/Team/Feature.hs +++ b/libs/wire-api/src/Wire/API/Team/Feature.hs @@ -29,6 +29,7 @@ module Wire.API.Team.Feature KnownTeamFeatureName (..), TeamFeatureStatusNoConfig (..), TeamFeatureStatusWithConfig (..), + deprecatedFeatureName, -- * Swagger typeTeamFeatureName, @@ -89,19 +90,28 @@ instance FromByteString TeamFeatureName where Left e -> fail $ "Invalid TeamFeatureName: " <> show e Right "legalhold" -> pure TeamFeatureLegalHold Right "sso" -> pure TeamFeatureSSO + Right "searchVisibility" -> pure TeamFeatureSearchVisibility Right "search-visibility" -> pure TeamFeatureSearchVisibility + Right "validateSAMLemails" -> pure TeamFeatureValidateSAMLEmails Right "validate-saml-emails" -> pure TeamFeatureValidateSAMLEmails + Right "digitalSignatures" -> pure TeamFeatureDigitalSignatures Right "digital-signatures" -> pure TeamFeatureDigitalSignatures - Right "app-lock" -> pure TeamFeatureAppLock + Right "appLock" -> pure TeamFeatureAppLock Right t -> fail $ "Invalid TeamFeatureName: " <> T.unpack t instance ToByteString TeamFeatureName where builder TeamFeatureLegalHold = "legalhold" builder TeamFeatureSSO = "sso" - builder TeamFeatureSearchVisibility = "search-visibility" - builder TeamFeatureValidateSAMLEmails = "validate-saml-emails" - builder TeamFeatureDigitalSignatures = "digital-signatures" - builder TeamFeatureAppLock = "app-lock" + builder TeamFeatureSearchVisibility = "searchVisibility" + builder TeamFeatureValidateSAMLEmails = "validateSAMLemails" + builder TeamFeatureDigitalSignatures = "digitalSignatures" + builder TeamFeatureAppLock = "appLock" + +deprecatedFeatureName :: TeamFeatureName -> Maybe ByteString +deprecatedFeatureName TeamFeatureSearchVisibility = Just "search-visibility" +deprecatedFeatureName TeamFeatureValidateSAMLEmails = Just "validate-saml-emails" +deprecatedFeatureName TeamFeatureDigitalSignatures = Just "digital-signatures" +deprecatedFeatureName _ = Nothing typeTeamFeatureName :: Doc.DataType typeTeamFeatureName = Doc.string . Doc.enum $ cs . toByteString' <$> [(minBound :: TeamFeatureName) ..] diff --git a/services/brig/test/integration/API/Team/Util.hs b/services/brig/test/integration/API/Team/Util.hs index 1e5d2fda92c..d88a90f8b83 100644 --- a/services/brig/test/integration/API/Team/Util.hs +++ b/services/brig/test/integration/API/Team/Util.hs @@ -448,7 +448,7 @@ setTeamTeamSearchVisibilityAvailable :: HasCallStack => Galley -> TeamId -> Team setTeamTeamSearchVisibilityAvailable galley tid status = put ( galley - . paths ["i/teams", toByteString' tid, "features/search-visibility"] + . paths ["i/teams", toByteString' tid, "features/searchVisibility"] . contentJson . body (RequestBodyLBS . encode $ Public.TeamFeatureStatusNoConfig status) ) diff --git a/services/galley/src/Galley/API/Internal.hs b/services/galley/src/Galley/API/Internal.hs index 7e8fe647370..7d86b0c7fc8 100644 --- a/services/galley/src/Galley/API/Internal.hs +++ b/services/galley/src/Galley/API/Internal.hs @@ -63,7 +63,7 @@ import qualified Network.Wai.Predicate as P import Network.Wai.Routing hiding (route) import Network.Wai.Utilities import Network.Wai.Utilities.ZAuth -import System.Logger.Class hiding (Path) +import System.Logger.Class hiding (Path, name) import qualified Wire.API.Team.Feature as Public sitemap :: Routes a Galley () @@ -336,9 +336,13 @@ mkFeatureGetAndPutRoute getter setter = do getHandler (tid ::: _) = json <$> Teams.getFeatureStatus @a getter DontDoAuth tid - get ("/i/teams/:tid/features/" <> toByteString' featureName) (continue getHandler) $ - capture "tid" - .&. accept "application" "json" + let mkGetRoute name = + get ("/i/teams/:tid/features/" <> name) (continue getHandler) $ + capture "tid" + .&. accept "application" "json" + + mkGetRoute (toByteString' featureName) + mkGetRoute `mapM_` Public.deprecatedFeatureName featureName let putHandler :: TeamId ::: JsonRequest (Public.TeamFeatureStatus a) ::: JSON -> Galley Response putHandler (tid ::: req ::: _) = do @@ -346,7 +350,11 @@ mkFeatureGetAndPutRoute getter setter = do res <- Teams.setFeatureStatus @a setter DontDoAuth tid status pure $ (json res) & Network.Wai.Utilities.setStatus status200 - put ("/i/teams/:tid/features/" <> toByteString' featureName) (continue putHandler) $ - capture "tid" - .&. jsonRequest @(Public.TeamFeatureStatus a) - .&. accept "application" "json" + let mkPutRoute name = + put ("/i/teams/:tid/features/" <> name) (continue putHandler) $ + capture "tid" + .&. jsonRequest @(Public.TeamFeatureStatus a) + .&. accept "application" "json" + + mkPutRoute (toByteString' featureName) + mkPutRoute `mapM_` Public.deprecatedFeatureName featureName diff --git a/services/galley/src/Galley/API/Public.hs b/services/galley/src/Galley/API/Public.hs index 14f894df461..a50a81e81be 100644 --- a/services/galley/src/Galley/API/Public.hs +++ b/services/galley/src/Galley/API/Public.hs @@ -458,6 +458,16 @@ sitemap = do mkFeatureGetAndPutRoute @'Public.TeamFeatureDigitalSignatures Teams.getDigitalSignaturesInternal Teams.setDigitalSignaturesInternal mkFeatureGetAndPutRoute @'Public.TeamFeatureAppLock Teams.getAppLockInternal Teams.setAppLockInternal + get "/teams/:tid/features/" (continue Teams.getAllFeaturesH) $ + zauthUserId + .&. capture "tid" + .&. accept "application" "json" + document "GET" "getAllFeatures" $ do + summary "Shows the configuration status of every team feature" + parameter Path "tid" bytes' $ + description "Team ID" + response 200 "All feature statuses" end + -- Custom Backend API ------------------------------------------------- get "/custom-backend/by-domain/:domain" (continue CustomBackend.getCustomBackendByDomainH) $ @@ -1089,15 +1099,20 @@ mkFeatureGetAndPutRoute getter setter = do getHandler (uid ::: tid ::: _) = json <$> Teams.getFeatureStatus @a getter (DoAuth uid) tid - get ("/teams/:tid/features/" <> toByteString' featureName) (continue getHandler) $ - zauthUserId - .&. capture "tid" - .&. accept "application" "json" - document "GET" "getTeamFeature" $ do - parameter Path "tid" bytes' $ - description "Team ID" - returns (ref (Public.modelForTeamFeature featureName)) - response 200 "Team feature status" end + let mkGetRoute makeDocumentation name = do + get ("/teams/:tid/features/" <> name) (continue getHandler) $ + zauthUserId + .&. capture "tid" + .&. accept "application" "json" + when makeDocumentation $ + document "GET" "getTeamFeature" $ do + parameter Path "tid" bytes' $ + description "Team ID" + returns (ref (Public.modelForTeamFeature featureName)) + response 200 "Team feature status" end + + mkGetRoute True (toByteString' featureName) + mkGetRoute False `mapM_` Public.deprecatedFeatureName featureName let putHandler :: UserId ::: TeamId ::: JsonRequest (Public.TeamFeatureStatus a) ::: JSON -> Galley Response putHandler (uid ::: tid ::: req ::: _) = do @@ -1105,14 +1120,19 @@ mkFeatureGetAndPutRoute getter setter = do res <- Teams.setFeatureStatus @a setter (DoAuth uid) tid status pure $ (json res) & Network.Wai.Utilities.setStatus status200 - put ("/teams/:tid/features/" <> toByteString' featureName) (continue putHandler) $ - zauthUserId - .&. capture "tid" - .&. jsonRequest @(Public.TeamFeatureStatus a) - .&. accept "application" "json" - document "PUT" "putTeamFeature" $ do - parameter Path "tid" bytes' $ - description "Team ID" - body (ref (Public.modelForTeamFeature featureName)) $ - description "JSON body" - response 204 "Team feature status" end + let mkPutRoute makeDocumentation name = do + put ("/teams/:tid/features/" <> name) (continue putHandler) $ + zauthUserId + .&. capture "tid" + .&. jsonRequest @(Public.TeamFeatureStatus a) + .&. accept "application" "json" + when makeDocumentation $ + document "PUT" "putTeamFeature" $ do + parameter Path "tid" bytes' $ + description "Team ID" + body (ref (Public.modelForTeamFeature featureName)) $ + description "JSON body" + response 204 "Team feature status" end + + mkPutRoute True (toByteString' featureName) + mkGetRoute False `mapM_` Public.deprecatedFeatureName featureName diff --git a/services/galley/src/Galley/API/Teams.hs b/services/galley/src/Galley/API/Teams.hs index 021106234f0..2b34f0797bb 100644 --- a/services/galley/src/Galley/API/Teams.hs +++ b/services/galley/src/Galley/API/Teams.hs @@ -54,6 +54,7 @@ module Galley.API.Teams internalDeleteBindingTeamWithOneMember, getFeatureStatus, setFeatureStatus, + getAllFeaturesH, getSSOStatusInternal, setSSOStatusInternal, getLegalholdStatusInternal, @@ -73,6 +74,7 @@ where import Brig.Types.Team (TeamSize (..)) import Control.Lens import Control.Monad.Catch +import qualified Data.Aeson as Aeson import Data.ByteString.Conversion hiding (fromList) import Data.Id import qualified Data.Id as Id @@ -82,6 +84,7 @@ import Data.List1 (list1) import Data.Range as Range import Data.Set (fromList) import qualified Data.Set as Set +import Data.String.Conversions (cs) import Data.Time.Clock (UTCTime (..), getCurrentTime) import qualified Data.UUID as UUID import qualified Data.UUID.Util as UUID @@ -885,7 +888,7 @@ getFeatureStatus getter doauth tid = do zusrMembership <- Data.teamMember tid uid void $ permissionCheck (ViewTeamFeature (Public.knownTeamFeatureName @a)) zusrMembership DontDoAuth -> - pure () + assertTeamExists tid getter tid setFeatureStatus :: @@ -905,9 +908,35 @@ setFeatureStatus setter doauth tid status = do zusrMembership <- Data.teamMember tid uid void $ permissionCheck (ChangeTeamFeature (Public.knownTeamFeatureName @a)) zusrMembership DontDoAuth -> - pure () + assertTeamExists tid setter tid status +getAllFeaturesH :: UserId ::: TeamId ::: JSON -> Galley Response +getAllFeaturesH (uid ::: tid ::: _) = + json <$> getAllFeatures uid tid + +getAllFeatures :: UserId -> TeamId -> Galley Aeson.Value +getAllFeatures uid tid = do + Aeson.object + <$> sequence + [ getStatus @'Public.TeamFeatureSSO getSSOStatusInternal, + getStatus @'Public.TeamFeatureLegalHold getLegalholdStatusInternal, + getStatus @'Public.TeamFeatureSearchVisibility getTeamSearchVisibilityAvailableInternal, + getStatus @'Public.TeamFeatureValidateSAMLEmails getValidateSAMLEmailsInternal, + getStatus @'Public.TeamFeatureDigitalSignatures getDigitalSignaturesInternal, + getStatus @'Public.TeamFeatureAppLock getAppLockInternal + ] + where + getStatus :: + forall (a :: Public.TeamFeatureName). + (Public.KnownTeamFeatureName a, Aeson.ToJSON (Public.TeamFeatureStatus a)) => + (TeamId -> Galley (Public.TeamFeatureStatus a)) -> + Galley (Text, Aeson.Value) + getStatus getter = do + status <- getFeatureStatus @a getter (DoAuth uid) tid + let feature = Public.knownTeamFeatureName @a + pure $ (cs (toByteString' feature) Aeson..= status) + getSSOStatusInternal :: TeamId -> Galley (Public.TeamFeatureStatus 'Public.TeamFeatureSSO) getSSOStatusInternal tid = do defStatus <- do diff --git a/services/galley/src/Galley/API/Util.hs b/services/galley/src/Galley/API/Util.hs index 59e0fca8083..8eb2e39e903 100644 --- a/services/galley/src/Galley/API/Util.hs +++ b/services/galley/src/Galley/API/Util.hs @@ -145,6 +145,13 @@ permissionCheck p = \case else throwM (operationDenied p) Nothing -> throwM notATeamMember +assertTeamExists :: TeamId -> Galley () +assertTeamExists tid = do + teamExists <- isJust <$> Data.team tid + if teamExists + then pure () + else throwM teamNotFound + assertOnTeam :: UserId -> TeamId -> Galley () assertOnTeam uid tid = do Data.teamMember tid uid >>= \case diff --git a/services/galley/src/Galley/Data/TeamFeatures.hs b/services/galley/src/Galley/Data/TeamFeatures.hs index 5f314cf7b68..d58df01101f 100644 --- a/services/galley/src/Galley/Data/TeamFeatures.hs +++ b/services/galley/src/Galley/Data/TeamFeatures.hs @@ -87,10 +87,10 @@ getApplockFeatureStatus tid = do let q = query1 (select) (params Quorum (Identity tid)) mTuple <- retry x1 q pure $ - mTuple <&> \(statusValue, enforce, timeout) -> - TeamFeatureStatusWithConfig statusValue (Public.TeamFeatureAppLockConfig enforce timeout) + mTuple >>= \(mbStatusValue, mbEnforce, mbTimeout) -> + TeamFeatureStatusWithConfig <$> mbStatusValue <*> (Public.TeamFeatureAppLockConfig <$> mbEnforce <*> mbTimeout) where - select :: PrepQuery R (Identity TeamId) (TeamFeatureStatusValue, Public.EnforceAppLock, Int32) + select :: PrepQuery R (Identity TeamId) (Maybe TeamFeatureStatusValue, Maybe Public.EnforceAppLock, Maybe Int32) select = fromString $ "select " <> toCol Public.TeamFeatureAppLock <> ", app_lock_enforce, app_lock_inactivity_timeout_secs " diff --git a/services/spar/src/Spar/Intra/Galley.hs b/services/spar/src/Spar/Intra/Galley.hs index 61a355978d9..7fdfa6670e4 100644 --- a/services/spar/src/Spar/Intra/Galley.hs +++ b/services/spar/src/Spar/Intra/Galley.hs @@ -94,7 +94,7 @@ assertSSOEnabled tid = do isEmailValidationEnabledTeam :: (HasCallStack, MonadSparToGalley m) => TeamId -> m Bool isEmailValidationEnabledTeam tid = do - resp <- call $ method GET . paths ["i", "teams", toByteString' tid, "features", "validate-saml-emails"] + resp <- call $ method GET . paths ["i", "teams", toByteString' tid, "features", "validateSAMLemails"] pure ( (statusCode resp == 200) && ( responseJsonMaybe @(TeamFeatureStatus 'TeamFeatureValidateSAMLEmails) resp diff --git a/services/spar/test-integration/Test/Spar/Scim/UserSpec.hs b/services/spar/test-integration/Test/Spar/Scim/UserSpec.hs index 369de4c11b2..28d37362642 100644 --- a/services/spar/test-integration/Test/Spar/Scim/UserSpec.hs +++ b/services/spar/test-integration/Test/Spar/Scim/UserSpec.hs @@ -1525,7 +1525,7 @@ specEmailValidation = do enableSamlEmailValidation tid = do galley <- asks (^. teGalley) let req = put $ galley . paths p . json (Feature.TeamFeatureStatusNoConfig Feature.TeamFeatureEnabled) - p = ["/i/teams", toByteString' tid, "features", "validate-saml-emails"] + p = ["/i/teams", toByteString' tid, "features", "validateSAMLemails"] call req !!! const 200 === statusCode -- (This may be the same as 'Util.Email.checkEmail'.) diff --git a/tools/stern/src/Stern/Intra.hs b/tools/stern/src/Stern/Intra.hs index 8ffd65bd5d8..e0226852b5d 100644 --- a/tools/stern/src/Stern/Intra.hs +++ b/tools/stern/src/Stern/Intra.hs @@ -460,7 +460,7 @@ setTeamFeatureFlag tid status = do . contentJson resp <- catchRpcErrors $ rpc' "galley" gly req case statusCode resp of - 204 -> pure () + 200 -> pure () _ -> throwE $ responseJsonUnsafe resp getSearchVisibility :: TeamId -> Handler TeamSearchVisibilityView @@ -494,7 +494,7 @@ setSearchVisibility tid typ = do . contentJson ) case statusCode resp of - 204 -> pure () + 200 -> pure () 403 -> throwE $ Error From 0dd5f20e2bd85b8a8fb4b8d660099b0e3d562684 Mon Sep 17 00:00:00 2001 From: Stefan Matting Date: Tue, 24 Nov 2020 11:29:49 +0100 Subject: [PATCH 28/34] Fix: remove trailing slash from features endpoint (#1255) --- services/galley/src/Galley/API/Public.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/services/galley/src/Galley/API/Public.hs b/services/galley/src/Galley/API/Public.hs index a50a81e81be..31849bca4f8 100644 --- a/services/galley/src/Galley/API/Public.hs +++ b/services/galley/src/Galley/API/Public.hs @@ -458,7 +458,7 @@ sitemap = do mkFeatureGetAndPutRoute @'Public.TeamFeatureDigitalSignatures Teams.getDigitalSignaturesInternal Teams.setDigitalSignaturesInternal mkFeatureGetAndPutRoute @'Public.TeamFeatureAppLock Teams.getAppLockInternal Teams.setAppLockInternal - get "/teams/:tid/features/" (continue Teams.getAllFeaturesH) $ + get "/teams/:tid/features" (continue Teams.getAllFeaturesH) $ zauthUserId .&. capture "tid" .&. accept "application" "json" From 15f7af257e5be50ad2b953d38a3d4bc50d7003a3 Mon Sep 17 00:00:00 2001 From: Stefan Matting Date: Tue, 24 Nov 2020 14:00:28 +0100 Subject: [PATCH 29/34] Revert "Fix: remove trailing slash from features endpoint (#1255)" This reverts commit 0dd5f20e2bd85b8a8fb4b8d660099b0e3d562684. --- services/galley/src/Galley/API/Public.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/services/galley/src/Galley/API/Public.hs b/services/galley/src/Galley/API/Public.hs index 31849bca4f8..a50a81e81be 100644 --- a/services/galley/src/Galley/API/Public.hs +++ b/services/galley/src/Galley/API/Public.hs @@ -458,7 +458,7 @@ sitemap = do mkFeatureGetAndPutRoute @'Public.TeamFeatureDigitalSignatures Teams.getDigitalSignaturesInternal Teams.setDigitalSignaturesInternal mkFeatureGetAndPutRoute @'Public.TeamFeatureAppLock Teams.getAppLockInternal Teams.setAppLockInternal - get "/teams/:tid/features" (continue Teams.getAllFeaturesH) $ + get "/teams/:tid/features/" (continue Teams.getAllFeaturesH) $ zauthUserId .&. capture "tid" .&. accept "application" "json" From 78c65b988cce2632e17311b5d6524870ed242e38 Mon Sep 17 00:00:00 2001 From: Stefan Matting Date: Wed, 25 Nov 2020 13:05:32 +0100 Subject: [PATCH 30/34] Galley: Rename endpoint path ..features/ -> ..features (#1258) --- .../services-demo/conf/nginz/nginx-docker.conf | 5 +++++ deploy/services-demo/conf/nginz/nginx.conf | 5 +++++ services/galley/src/Galley/API/Public.hs | 16 ++++++++-------- 3 files changed, 18 insertions(+), 8 deletions(-) diff --git a/deploy/services-demo/conf/nginz/nginx-docker.conf b/deploy/services-demo/conf/nginz/nginx-docker.conf index 3c0f9c0a37f..13897b1b9bb 100644 --- a/deploy/services-demo/conf/nginz/nginx-docker.conf +++ b/deploy/services-demo/conf/nginz/nginx-docker.conf @@ -288,6 +288,11 @@ http { proxy_pass http://galley; } + location ~* ^/teams/([^/]*)/features { + include common_response_with_zauth.conf; + proxy_pass http://galley; + } + location ~* ^/teams/([^/]*)/features/([^/]*) { include common_response_with_zauth.conf; proxy_pass http://galley; diff --git a/deploy/services-demo/conf/nginz/nginx.conf b/deploy/services-demo/conf/nginz/nginx.conf index 979aaebf215..a26dbc5bf3d 100644 --- a/deploy/services-demo/conf/nginz/nginx.conf +++ b/deploy/services-demo/conf/nginz/nginx.conf @@ -285,6 +285,11 @@ http { proxy_pass http://galley; } + location ~* ^/teams/([^/]*)/features { + include common_response_with_zauth.conf; + proxy_pass http://galley; + } + location ~* ^/teams/([^/]*)/features/([^/]*) { include common_response_with_zauth.conf; proxy_pass http://galley; diff --git a/services/galley/src/Galley/API/Public.hs b/services/galley/src/Galley/API/Public.hs index a50a81e81be..d0e65af2c46 100644 --- a/services/galley/src/Galley/API/Public.hs +++ b/services/galley/src/Galley/API/Public.hs @@ -451,14 +451,7 @@ sitemap = do response 204 "Search visibility set" end errorResponse Error.teamSearchVisibilityNotEnabled - mkFeatureGetAndPutRoute @'Public.TeamFeatureSSO Teams.getSSOStatusInternal Teams.setSSOStatusInternal - mkFeatureGetAndPutRoute @'Public.TeamFeatureLegalHold Teams.getLegalholdStatusInternal Teams.setLegalholdStatusInternal - mkFeatureGetAndPutRoute @'Public.TeamFeatureSearchVisibility Teams.getTeamSearchVisibilityAvailableInternal Teams.setTeamSearchVisibilityAvailableInternal - mkFeatureGetAndPutRoute @'Public.TeamFeatureValidateSAMLEmails Teams.getValidateSAMLEmailsInternal Teams.setValidateSAMLEmailsInternal - mkFeatureGetAndPutRoute @'Public.TeamFeatureDigitalSignatures Teams.getDigitalSignaturesInternal Teams.setDigitalSignaturesInternal - mkFeatureGetAndPutRoute @'Public.TeamFeatureAppLock Teams.getAppLockInternal Teams.setAppLockInternal - - get "/teams/:tid/features/" (continue Teams.getAllFeaturesH) $ + get "/teams/:tid/features" (continue Teams.getAllFeaturesH) $ zauthUserId .&. capture "tid" .&. accept "application" "json" @@ -468,6 +461,13 @@ sitemap = do description "Team ID" response 200 "All feature statuses" end + mkFeatureGetAndPutRoute @'Public.TeamFeatureSSO Teams.getSSOStatusInternal Teams.setSSOStatusInternal + mkFeatureGetAndPutRoute @'Public.TeamFeatureLegalHold Teams.getLegalholdStatusInternal Teams.setLegalholdStatusInternal + mkFeatureGetAndPutRoute @'Public.TeamFeatureSearchVisibility Teams.getTeamSearchVisibilityAvailableInternal Teams.setTeamSearchVisibilityAvailableInternal + mkFeatureGetAndPutRoute @'Public.TeamFeatureValidateSAMLEmails Teams.getValidateSAMLEmailsInternal Teams.setValidateSAMLEmailsInternal + mkFeatureGetAndPutRoute @'Public.TeamFeatureDigitalSignatures Teams.getDigitalSignaturesInternal Teams.setDigitalSignaturesInternal + mkFeatureGetAndPutRoute @'Public.TeamFeatureAppLock Teams.getAppLockInternal Teams.setAppLockInternal + -- Custom Backend API ------------------------------------------------- get "/custom-backend/by-domain/:domain" (continue CustomBackend.getCustomBackendByDomainH) $ From c3cd0ba1b68df04549e3ed259d0a46722b56df49 Mon Sep 17 00:00:00 2001 From: Stefan Matting Date: Wed, 25 Nov 2020 13:38:31 +0100 Subject: [PATCH 31/34] Spar: Forward errors from brig (#1251) * Better error handling in spar. (cherry-picked) * Fix incorrect call sites of rethrow * Remove commented-out functions * rethrow "brig" in updateEmail * Use own parseBody not from galley * Fix incorrect status in ensureReAuthorised * Move parseResponse fro Spar.Intra.* to Spar.Error, add error info. * Fix comment. * Use type alias. * Update services/spar/src/Spar/Error.hs Co-authored-by: fisx * add status code * parseBody: Abstract the serviceName Co-authored-by: Matthias Fischmann --- services/spar/src/Spar/App.hs | 7 +- services/spar/src/Spar/Error.hs | 66 ++++++--- services/spar/src/Spar/Intra/Brig.hs | 133 ++++++------------ services/spar/src/Spar/Intra/Galley.hs | 35 ++--- .../test-integration/Test/Spar/APISpec.hs | 2 +- 5 files changed, 106 insertions(+), 137 deletions(-) diff --git a/services/spar/src/Spar/App.hs b/services/spar/src/Spar/App.hs index fdfd31e7390..cb1b0c80963 100644 --- a/services/spar/src/Spar/App.hs +++ b/services/spar/src/Spar/App.hs @@ -428,11 +428,8 @@ verdictHandlerResultCore bindCky = \case -- to see why, consider the condition on the call to 'findUserWithOldIssuer' above. error "impossible." SAML.logger SAML.Debug ("granting sso login for " <> show uid) - mcky :: Maybe SetCookie <- Intra.ssoLogin uid - -- (creating users is synchronous and does a quorum vote, so there is no race condition here.) - case mcky of - Just cky -> pure $ VerifyHandlerGranted cky uid - Nothing -> throwSpar $ SparBrigError "sso-login failed (race condition?)" + cky <- Intra.ssoLogin uid + pure $ VerifyHandlerGranted cky uid -- | If the client is web, it will be served with an HTML page that it can process to decide whether -- to log the user in or show an error. diff --git a/services/spar/src/Spar/Error.hs b/services/spar/src/Spar/Error.hs index 6be5c1bda4b..269a9a5ddb3 100644 --- a/services/spar/src/Spar/Error.hs +++ b/services/spar/src/Spar/Error.hs @@ -30,6 +30,8 @@ module Spar.Error throwSpar, sparToServerErrorWithLogging, renderSparErrorWithLogging, + rethrow, + parseResponse, -- FUTUREWORK: we really shouldn't export this, but that requires that we can use our -- custom servant monad in the 'MakeCustomError' instances. servantToWaiError, @@ -39,9 +41,13 @@ module Spar.Error ) where +import Bilge (ResponseLBS, responseBody, responseJsonMaybe) +import qualified Bilge import Control.Monad.Except import Data.Aeson import Data.String.Conversions +import Data.Typeable (typeRep) +import GHC.Stack (callStack, prettyCallStack) import Imports import Network.HTTP.Types.Status import qualified Network.Wai as Wai @@ -79,14 +85,8 @@ data SparCustomError | SparBindUserRefTaken | SparBadUserName LT | SparCannotCreateUsersOnReplacedIdP LT - | SparNoBodyInBrigResponse - | SparCouldNotParseBrigResponse LT + | SparCouldNotParseRfcResponse LT LT | SparReAuthRequired - | SparBrigError LT - | SparBrigErrorWith Status LT - | SparNoBodyInGalleyResponse - | SparCouldNotParseGalleyResponse LT - | SparGalleyError LT | SparCouldNotRetrieveCookie | SparCassandraError LT | SparCassandraTTLError TTLError @@ -141,16 +141,9 @@ renderSparError (SAML.CustomError (SparBindFromBadAccountStatus msg)) = Right $ renderSparError (SAML.CustomError SparBindUserRefTaken) = Right $ Wai.Error status403 "subject-id-taken" "Forbidden: SubjectID is used by another wire user. If you have an old user bound to this IdP, unbind or delete that user." renderSparError (SAML.CustomError (SparBadUserName msg)) = Right $ Wai.Error status400 "bad-username" ("Bad UserName in SAML response, except len [1, 128]: " <> msg) renderSparError (SAML.CustomError (SparCannotCreateUsersOnReplacedIdP replacingIdPId)) = Right $ Wai.Error status400 "cannont-provision-on-replaced-idp" ("This IdP has been replaced, users can only be auto-provisioned on the replacing IdP " <> replacingIdPId) --- Brig-specific errors -renderSparError (SAML.CustomError SparNoBodyInBrigResponse) = Right $ Wai.Error status502 "bad-upstream" "Failed to get a response from an upstream server." -renderSparError (SAML.CustomError (SparCouldNotParseBrigResponse msg)) = Right $ Wai.Error status502 "bad-upstream" ("Could not parse response body: " <> msg) +-- RFC-specific errors +renderSparError (SAML.CustomError (SparCouldNotParseRfcResponse service msg)) = Right $ Wai.Error status502 "bad-upstream" ("Could not parse " <> service <> " response body: " <> msg) renderSparError (SAML.CustomError SparReAuthRequired) = Right $ Wai.Error status403 "access-denied" "This operation requires reauthentication." -renderSparError (SAML.CustomError (SparBrigError msg)) = Right $ Wai.Error status500 "bad-upstream" msg -renderSparError (SAML.CustomError (SparBrigErrorWith status msg)) = Right $ Wai.Error status "bad-upstream" msg --- Galley-specific errors -renderSparError (SAML.CustomError SparNoBodyInGalleyResponse) = Right $ Wai.Error status502 "bad-upstream" "Failed to get a response from an upstream server." -renderSparError (SAML.CustomError (SparCouldNotParseGalleyResponse msg)) = Right $ Wai.Error status502 "bad-upstream" ("Could not parse response body: " <> msg) -renderSparError (SAML.CustomError (SparGalleyError msg)) = Right $ Wai.Error status500 "bad-upstream" msg renderSparError (SAML.CustomError SparCouldNotRetrieveCookie) = Right $ Wai.Error status502 "bad-upstream" "Unable to get a cookie from an upstream server." renderSparError (SAML.CustomError (SparCassandraError msg)) = Right $ Wai.Error status500 "server-error" msg -- TODO: should we be more specific here and make it 'db-error'? renderSparError (SAML.CustomError (SparCassandraTTLError ttlerr)) = Right $ Wai.Error status400 "ttl-error" (cs $ show ttlerr) @@ -188,3 +181,44 @@ renderSparError (SAML.CustomError SparProvisioningTokenLimitReached) = Right $ W renderSparError (SAML.CustomError (SparScimError err)) = Left $ Scim.scimToServerError err -- Other renderSparError (SAML.CustomServant err) = Left err + +-- | If a call to another backend service fails, just respond with whatever it said. +-- +-- FUTUREWORK: with servant, there will be a way for the type checker to confirm that we +-- handle all exceptions that brig can legally throw! +rethrow :: LText -> ResponseLBS -> (HasCallStack, Log.MonadLogger m, MonadError SparError m) => m a +rethrow serviceName resp = do + Log.info + ( Log.msg ("rfc error" :: Text) + . Log.field "status" (Bilge.statusCode resp) + . Log.field "error" (show err) + . Log.field "callstack" (prettyCallStack callStack) + ) + throwError err + where + err :: SparError + err = + responseJsonMaybe resp + & maybe + ( SAML.CustomError + . SparCouldNotParseRfcResponse serviceName + . ("internal error: " <>) + . cs + . show + . (Bilge.statusCode resp,) + . fromMaybe "" + . responseBody + $ resp + ) + (SAML.CustomServant . waiToServant) + +parseResponse :: forall a m. (FromJSON a, MonadError SparError m, Typeable a) => LT -> ResponseLBS -> m a +parseResponse serviceName resp = do + let typeinfo :: LT + typeinfo = cs $ show (typeRep ([] @a)) <> ": " + + err :: forall a'. LT -> m a' + err = throwSpar . SparCouldNotParseRfcResponse serviceName . (typeinfo <>) + + bdy <- maybe (err "no body") pure $ responseBody resp + either (err . cs) pure $ eitherDecode' bdy diff --git a/services/spar/src/Spar/Intra/Brig.hs b/services/spar/src/Spar/Intra/Brig.hs index b17e56c69a4..886548002a1 100644 --- a/services/spar/src/Spar/Intra/Brig.hs +++ b/services/spar/src/Spar/Intra/Brig.hs @@ -69,7 +69,6 @@ import Control.Monad.Except import Data.ByteString.Conversion import Data.Handle (Handle (Handle, fromHandle)) import Data.Id (Id (Id), TeamId, UserId) -import Data.Ix import Data.Misc (PlainTextPassword) import Data.String.Conversions import Imports @@ -77,9 +76,9 @@ import Network.HTTP.Types.Method import qualified Network.Wai.Utilities.Error as Wai import qualified SAML2.WebSSO as SAML import Spar.Error -import Spar.Intra.Galley (parseResponse) import Spar.Intra.Galley as Galley (MonadSparToGalley, assertIsTeamOwner) import Spar.Scim.Types (ValidExternalId (..), runValidExternalId) +import qualified System.Logger.Class as Log import qualified Text.Email.Parser import Web.Cookie import Wire.API.User @@ -162,7 +161,7 @@ renderValidExternalId = runValidExternalId urefToExternalId (Just . fromEmail) -- (This is the easiest way, since the login-request that we are in the middle of responding to here -- is not from the wire client, but from a browser that is still processing a redirect from the -- IdP.) -respToCookie :: (HasCallStack, MonadError SparError m) => Response (Maybe LBS) -> m SetCookie +respToCookie :: (HasCallStack, MonadError SparError m) => ResponseLBS -> m SetCookie respToCookie resp = do let crash = throwSpar SparCouldNotRetrieveCookie unless (statusCode resp == 200) crash @@ -193,11 +192,8 @@ emailFromSAMLNameID nid = case nid ^. SAML.nameID of ---------------------------------------------------------------------- -class MonadError SparError m => MonadSparToBrig m where - call :: (Request -> Request) -> m (Response (Maybe LBS)) - -instance MonadSparToBrig m => MonadSparToBrig (ReaderT r m) where - call = lift . call +class (Log.MonadLogger m, MonadError SparError m) => MonadSparToBrig m where + call :: (Request -> Request) -> m ResponseLBS createBrigUserSAML :: (HasCallStack, MonadSparToBrig m) => @@ -218,14 +214,14 @@ createBrigUserSAML uref (Id buid) teamid uname managedBy = do newUserOrigin = Just (NewUserOriginTeamUser . NewTeamMemberSSO $ teamid), newUserManagedBy = Just managedBy } - resp :: Response (Maybe LBS) <- + resp :: ResponseLBS <- call $ method POST . path "/i/users" . json newUser if statusCode resp `elem` [200, 201] - then userId . selfUser <$> parseResponse @SelfProfile resp - else rethrow resp + then userId . selfUser <$> parseResponse @SelfProfile "brig" resp + else rethrow "brig" resp createBrigUserNoSAML :: (HasCallStack, MonadSparToBrig m) => @@ -236,15 +232,15 @@ createBrigUserNoSAML :: m UserId createBrigUserNoSAML email teamid uname = do let newUser = NewUserScimInvitation teamid Nothing uname email - resp :: Response (Maybe LBS) <- + resp :: ResponseLBS <- call $ method POST . paths ["/i/teams", toByteString' teamid, "invitations"] . json newUser if statusCode resp `elem` [200, 201] - then userId . accountUser <$> parseResponse @UserAccount resp - else rethrow resp + then userId . accountUser <$> parseResponse @UserAccount "brig" resp + else rethrow "brig" resp updateEmail :: (HasCallStack, MonadSparToBrig m) => UserId -> Email -> m () updateEmail buid email = do @@ -258,9 +254,7 @@ updateEmail buid email = do case statusCode resp of 204 -> pure () 202 -> pure () - -- everything else is an error; if the response body still cannot be parsed as a - -- Wai.Error, it's ok to crash with a 500 here, so we use the unsafe parser. - _ -> throwError . SAML.CustomServant . waiToServant . responseJsonUnsafe $ resp + _ -> rethrow "brig" resp getBrigUser :: (HasCallStack, MonadSparToBrig m) => HavePendingInvitations -> UserId -> m (Maybe User) getBrigUser ifpend = (accountUser <$$>) . getBrigUserAccount ifpend @@ -284,7 +278,7 @@ getBrigUserAccount havePending buid = do case statusCode resp of 200 -> do - parseResponse @[UserAccount] resp >>= \case + parseResponse @[UserAccount] "brig" resp >>= \case [account] -> pure $ if userDeleted $ accountUser account @@ -292,7 +286,7 @@ getBrigUserAccount havePending buid = do else Just account _ -> pure Nothing 404 -> pure Nothing - _ -> rethrow resp + _ -> rethrow "brig" resp -- | Get a user; returns 'Nothing' if the user was not found. -- @@ -300,15 +294,16 @@ getBrigUserAccount havePending buid = do -- @hscim@ stops doing checks during user creation. getBrigUserByHandle :: (HasCallStack, MonadSparToBrig m) => Handle -> m (Maybe UserAccount) getBrigUserByHandle handle = do - resp :: Response (Maybe LBS) <- + resp :: ResponseLBS <- call $ method GET . path "/i/users" . queryItem "handles" (toByteString' handle) . queryItem "includePendingInvitations" "true" case statusCode resp of - 200 -> listToMaybe <$> parseResponse @[UserAccount] resp - _ -> rethrow resp + 200 -> listToMaybe <$> parseResponse @[UserAccount] "brig" resp + 404 -> pure Nothing + _ -> rethrow "brig" resp getBrigUserByEmail :: (HasCallStack, MonadSparToBrig m) => Email -> m (Maybe UserAccount) getBrigUserByEmail email = do @@ -320,12 +315,12 @@ getBrigUserByEmail email = do . queryItem "includePendingInvitations" "true" case statusCode resp of 200 -> do - macc <- listToMaybe <$> parseResponse @[UserAccount] resp + macc <- listToMaybe <$> parseResponse @[UserAccount] "brig" resp case userEmail . accountUser =<< macc of Just email' | email' == email -> pure macc _ -> pure Nothing 404 -> pure Nothing - _ -> rethrow resp + _ -> rethrow "brig" resp -- | Set user' name. Fails with status <500 if brig fails with <500, and with 500 if brig -- fails with >= 500. @@ -340,10 +335,8 @@ setBrigUserName buid (Name name) = do if | sCode < 300 -> pure () - | inRange (400, 499) sCode -> - throwSpar . SparBrigErrorWith (responseStatus resp) $ "set name failed" | otherwise -> - throwSpar . SparBrigError . cs $ "set name failed with status " <> show sCode + rethrow "brig" resp -- | Set user's handle. Fails with status <500 if brig fails with <500, and with 500 if brig fails -- with >= 500. @@ -362,7 +355,7 @@ setBrigUserHandle buid handle = do (200, Nothing) -> do pure () _ -> do - rethrow resp + rethrow "brig" resp -- | Set user's managedBy. Fails with status <500 if brig fails with <500, and with 500 if -- brig fails with >= 500. @@ -373,14 +366,8 @@ setBrigUserManagedBy buid managedBy = do method PUT . paths ["/i/users", toByteString' buid, "managed-by"] . json (ManagedByUpdate managedBy) - let sCode = statusCode resp - if - | sCode < 300 -> - pure () - | inRange (400, 499) sCode -> - throwSpar . SparBrigErrorWith (responseStatus resp) $ "set managedBy failed" - | otherwise -> - throwSpar . SparBrigError . cs $ "set managedBy failed with status " <> show sCode + unless (statusCode resp == 200) $ + rethrow "brig" resp -- | Set user's UserSSOId. setBrigUserVeid :: (HasCallStack, MonadSparToBrig m) => UserId -> ValidExternalId -> m () @@ -392,7 +379,7 @@ setBrigUserVeid buid veid = do . json (veidToUserSSOId veid) case statusCode resp of 200 -> pure () - _ -> rethrow resp + _ -> rethrow "brig" resp -- | Set user's richInfo. Fails with status <500 if brig fails with <500, and with 500 if -- brig fails with >= 500. @@ -403,14 +390,8 @@ setBrigUserRichInfo buid richInfo = do method PUT . paths ["i", "users", toByteString' buid, "rich-info"] . json (RichInfoUpdate $ unRichInfo richInfo) - let sCode = statusCode resp - if - | sCode < 300 -> - pure () - | inRange (400, 499) sCode -> - throwSpar . SparBrigErrorWith (responseStatus resp) $ "set richInfo failed" - | otherwise -> - throwSpar . SparBrigError . cs $ "set richInfo failed with status " <> show sCode + unless (statusCode resp == 200) $ + rethrow "brig" resp getBrigUserRichInfo :: (HasCallStack, MonadSparToBrig m) => UserId -> m RichInfo getBrigUserRichInfo buid = do @@ -419,8 +400,8 @@ getBrigUserRichInfo buid = do method GET . paths ["/i/users", toByteString' buid, "rich-info"] case statusCode resp of - 200 -> parseResponse resp - _ -> rethrow resp + 200 -> parseResponse "brig" resp + _ -> rethrow "brig" resp checkHandleAvailable :: (HasCallStack, MonadSparToBrig m) => Handle -> m Bool checkHandleAvailable hnd = do @@ -434,25 +415,18 @@ checkHandleAvailable hnd = do pure False | sCode == 404 -> -- handle not found pure True - | sCode < 500 -> - throwSpar . SparBrigErrorWith (responseStatus resp) $ "check handle failed" | otherwise -> - throwSpar . SparBrigError . cs $ "check handle failed with status " <> show sCode + rethrow "brig" resp -- | Call brig to delete a user deleteBrigUser :: (HasCallStack, MonadSparToBrig m, MonadIO m) => UserId -> m () deleteBrigUser buid = do - resp :: Response (Maybe LBS) <- + resp :: ResponseLBS <- call $ method DELETE . paths ["/i/users", toByteString' buid] - let sCode = statusCode resp - if - | sCode < 300 -> pure () - | inRange (400, 499) sCode -> - throwSpar $ SparBrigErrorWith (responseStatus resp) "failed to delete user" - | otherwise -> - throwSpar $ SparBrigError ("delete user failed with status " <> cs (show sCode)) + unless (statusCode resp == 202) $ + rethrow "brig" resp -- | Check that an id maps to an user on brig that is 'Active' (or optionally -- 'PendingInvitation') and has a team id. @@ -491,10 +465,8 @@ ensureReAuthorised (Just uid) secret = do pure () | sCode == 403 -> throwSpar SparReAuthRequired - | inRange (400, 499) sCode -> - throwSpar . SparBrigErrorWith (responseStatus resp) $ "reauthentication failed" | otherwise -> - throwSpar . SparBrigError . cs $ "reauthentication failed with status " <> show sCode + rethrow "brig" resp -- | Get persistent cookie from brig and redirect user past login process. -- @@ -502,22 +474,17 @@ ensureReAuthorised (Just uid) secret = do ssoLogin :: (HasCallStack, SAML.HasConfig m, MonadSparToBrig m) => UserId -> - m (Maybe SetCookie) + m SetCookie ssoLogin buid = do - resp :: Response (Maybe LBS) <- + resp :: ResponseLBS <- call $ method POST . path "/i/sso-login" . json (SsoLogin buid Nothing) . queryItem "persist" "true" - let sCode = statusCode resp - if - | sCode < 300 -> - Just <$> respToCookie resp - | inRange (400, 499) sCode -> - pure Nothing - | otherwise -> - throwSpar . SparBrigError . cs $ "sso-login failed with status " <> show sCode + if (statusCode resp == 200) + then respToCookie resp + else rethrow "brig" resp getStatus' :: (HasCallStack, MonadSparToBrig m) => UserId -> m ResponseLBS getStatus' uid = call $ method GET . paths ["/i/users", toByteString' uid, "status"] @@ -527,17 +494,17 @@ getStatus :: (HasCallStack, MonadSparToBrig m) => UserId -> m AccountStatus getStatus uid = do resp <- getStatus' uid case statusCode resp of - 200 -> fromAccountStatusResp <$> parseResponse @AccountStatusResp resp - _ -> rethrow resp + 200 -> fromAccountStatusResp <$> parseResponse @AccountStatusResp "brig" resp + _ -> rethrow "brig" resp -- | FUTUREWORK: this is probably unnecessary, and we can get the status info from 'UserAccount'. getStatusMaybe :: (HasCallStack, MonadSparToBrig m) => UserId -> m (Maybe AccountStatus) getStatusMaybe uid = do resp <- getStatus' uid case statusCode resp of - 200 -> Just . fromAccountStatusResp <$> parseResponse @AccountStatusResp resp + 200 -> Just . fromAccountStatusResp <$> parseResponse @AccountStatusResp "brig" resp 404 -> pure Nothing - _ -> rethrow resp + _ -> rethrow "brig" resp setStatus :: (HasCallStack, MonadSparToBrig m) => UserId -> AccountStatus -> m () setStatus uid status = do @@ -548,7 +515,7 @@ setStatus uid status = do . json (AccountStatusUpdate status) case statusCode resp of 200 -> pure () - _ -> throwSpar (SparBrigErrorWith (responseStatus resp) "Could not set status") + _ -> rethrow "brig" resp -- | If the user has no 'Handle', set it to its 'UserId' and update the user in brig. -- Return the handle the user now has (the old one if it existed, the newly created one @@ -572,17 +539,3 @@ giveDefaultHandle usr = case userHandle usr of uid = userId usr setBrigUserHandle uid handle pure handle - --- | If a call to brig fails, we often just want to respond with whatever brig said. --- --- FUTUREWORK: with servant, there will be a way for the type checker to confirm that we --- handle all exceptions that brig can legally throw! -rethrow :: (HasCallStack, MonadSparToBrig m) => ResponseLBS -> m a -rethrow resp = throwError err - where - err :: SparError - err = - responseJsonMaybe resp - & maybe - (SAML.CustomError . SparBrigError . cs . show $ (statusCode resp, responseBody resp)) - (SAML.CustomServant . waiToServant) diff --git a/services/spar/src/Spar/Intra/Galley.hs b/services/spar/src/Spar/Intra/Galley.hs index 7fdfa6670e4..30b8dab472e 100644 --- a/services/spar/src/Spar/Intra/Galley.hs +++ b/services/spar/src/Spar/Intra/Galley.hs @@ -23,35 +23,20 @@ module Spar.Intra.Galley where import Bilge import Control.Lens import Control.Monad.Except -import Data.Aeson (FromJSON, eitherDecode') import Data.ByteString.Conversion import Data.Id (TeamId, UserId) -import Data.String.Conversions -import Data.Typeable (typeRep) import Galley.Types.Teams import Imports import Network.HTTP.Types (status403) import Network.HTTP.Types.Method import Spar.Error +import qualified System.Logger.Class as Log import Wire.API.Team.Feature (TeamFeatureName (..), TeamFeatureStatus, TeamFeatureStatusNoConfig (..), TeamFeatureStatusValue (..)) ---------------------------------------------------------------------- -parseResponse :: forall a m. (FromJSON a, MonadError SparError m, Typeable a) => ResponseLBS -> m a -parseResponse resp = do - bdy <- maybe (throwSpar SparNoBodyInBrigResponse) pure $ responseBody resp - either err pure $ eitherDecode' bdy - where - err = throwSpar . SparCouldNotParseBrigResponse . (typeinfo <>) . cs - typeinfo = cs $ show (typeRep ([] @a)) <> ": " - ----------------------------------------------------------------------- - -class Monad m => MonadSparToGalley m where - call :: (Request -> Request) -> m (Response (Maybe LBS)) - -instance MonadSparToGalley m => MonadSparToGalley (ReaderT r m) where - call = lift . call +class (Monad m, Log.MonadLogger m) => MonadSparToGalley m where + call :: (Request -> Request) -> m ResponseLBS -- | Get all members of a team. getTeamMembers :: @@ -59,13 +44,13 @@ getTeamMembers :: TeamId -> m [TeamMember] getTeamMembers tid = do - resp :: Response (Maybe LBS) <- + resp :: ResponseLBS <- call $ method GET . paths ["i", "teams", toByteString' tid, "members"] - unless (statusCode resp == 200) $ - throwSpar (SparGalleyError "Could not retrieve team members") - (^. teamMembers) <$> parseResponse @TeamMemberList resp + if (statusCode resp == 200) + then (^. teamMembers) <$> parseResponse @TeamMemberList "galley" resp + else rethrow "galley" resp -- | If user is not owner, throw 'SparNotTeamOwner'. assertIsTeamOwner :: (HasCallStack, MonadError SparError m, MonadSparToGalley m) => TeamId -> UserId -> m () @@ -82,13 +67,13 @@ assertSSOEnabled :: TeamId -> m () assertSSOEnabled tid = do - resp :: Response (Maybe LBS) <- + resp :: ResponseLBS <- call $ method GET . paths ["i", "teams", toByteString' tid, "features", "sso"] unless (statusCode resp == 200) $ - throwSpar (SparGalleyError "Could not retrieve SSO config") - TeamFeatureStatusNoConfig status <- parseResponse resp + rethrow "galley" resp + TeamFeatureStatusNoConfig status <- parseResponse "galley" resp unless (status == TeamFeatureEnabled) $ throwSpar SparSSODisabled diff --git a/services/spar/test-integration/Test/Spar/APISpec.hs b/services/spar/test-integration/Test/Spar/APISpec.hs index 88738baaf84..24cf1dd79ad 100644 --- a/services/spar/test-integration/Test/Spar/APISpec.hs +++ b/services/spar/test-integration/Test/Spar/APISpec.hs @@ -1140,7 +1140,7 @@ specAux = do . header "Z-User" (toByteString' $ if tryowner then owner else newmember) . expect2xx ) - parsedResp <- either (error . show) pure $ selfUser <$> Intra.parseResponse @SelfProfile rawResp + parsedResp <- either (error . show) pure $ selfUser <$> Intra.parseResponse @SelfProfile "brig" rawResp liftIO $ userTeam parsedResp `shouldSatisfy` isJust permses :: [Galley.Permissions] permses = From 6679a8d2e0b49105acdfe79d4d0a03839d400e33 Mon Sep 17 00:00:00 2001 From: jschaul Date: Tue, 24 Nov 2020 17:36:18 +0100 Subject: [PATCH 32/34] changelog --- CHANGELOG.md | 34 ++++++++++++++++++++++++++++++++++ 1 file changed, 34 insertions(+) diff --git a/CHANGELOG.md b/CHANGELOG.md index 801b0ec7681..7a1100add56 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,37 @@ + + +# 2020-11-24 + +## Release Notes + +## Features + +* Make Content-MD5 header optional for asset upload (#1252) +* Add applock team feature (#1242, #1253) + +## Bug fixes + +* Fix content-type headers in saml responses (#1241) + +## Internal changes + +* parse exposed 'tracestate' header in nginz logs if present (#1244) +* Store SCIM tokens in hashed form (#1240) + # 2020-10-28 ## Features From 7e4e476884c434fb0ec24020636695596fe7c430 Mon Sep 17 00:00:00 2001 From: Stefan Matting Date: Wed, 25 Nov 2020 11:53:46 +0100 Subject: [PATCH 33/34] Update CHANGELOG.md with empty SAML contact list --- CHANGELOG.md | 2 ++ 1 file changed, 2 insertions(+) diff --git a/CHANGELOG.md b/CHANGELOG.md index 7a1100add56..8f223e5c7fb 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -22,6 +22,8 @@ * Make Content-MD5 header optional for asset upload (#1252) * Add applock team feature (#1242, #1253) +* Allow an empty SAML contact list, which is configed at `saml.contacts` in spar's config. + The contact list is exposed at the `/sso/metadata` endpoint. ## Bug fixes From c48003ecb93b39496166ef303e20f51ce4a9115f Mon Sep 17 00:00:00 2001 From: jschaul Date: Wed, 25 Nov 2020 15:13:15 +0100 Subject: [PATCH 34/34] update changelog --- CHANGELOG.md | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 8f223e5c7fb..c0114bd149f 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -18,12 +18,14 @@ ## Release Notes +* Allow an empty SAML contact list, which is configured at `saml.contacts` in spar's config. + The contact list is exposed at the `/sso/metadata` endpoint. + ## Features * Make Content-MD5 header optional for asset upload (#1252) * Add applock team feature (#1242, #1253) -* Allow an empty SAML contact list, which is configed at `saml.contacts` in spar's config. - The contact list is exposed at the `/sso/metadata` endpoint. +* /teams/[tid]/features endpoint ## Bug fixes @@ -33,6 +35,7 @@ * parse exposed 'tracestate' header in nginz logs if present (#1244) * Store SCIM tokens in hashed form (#1240) +* better error handling (#1251) # 2020-10-28