diff --git a/changelog.d/5-internal/various-fixes b/changelog.d/5-internal/various-fixes new file mode 100644 index 0000000000..0f58d5db2a --- /dev/null +++ b/changelog.d/5-internal/various-fixes @@ -0,0 +1,3 @@ +Various improvements and fixes around SAML/SCIM +* the error message when attempting to saml-authenticate with a user that should have been provisioned by scim, but wasn't, was confusing. we have a better one now, and the function has a clearer structure. +* is bumping saml2-web-sso to the latest master, and *shouldn't* change any behavior: saml2-web-sso is providing `CI.CI`-wrapped values in a few places (mostly email and NameID), and we just unpack it using `CI.original`, which recovers all casing information. in the future, we'll have the option to treat emails case-insensitively as we're supposed to. (there is currently another, more hacky way in which we do this, see [here](https://github.com/wireapp/wire-server/blob/de673a6fbb2e1a9dc9cdb928cd9b7c4a291470dd/services/spar/src/Spar/Data.hs#L281-L296) and [the internal issue](https://wearezeta.atlassian.net/browse/SQSERVICES-776).) diff --git a/libs/hscim/.gitignore b/libs/hscim/.gitignore index 691684e829..bda3c80678 100644 --- a/libs/hscim/.gitignore +++ b/libs/hscim/.gitignore @@ -25,3 +25,4 @@ cabal.project.local~ *~ *.el \#* +.ghci diff --git a/libs/hscim/src/Web/Scim/Test/Util.hs b/libs/hscim/src/Web/Scim/Test/Util.hs index ee77c1f602..9234eee695 100644 --- a/libs/hscim/src/Web/Scim/Test/Util.hs +++ b/libs/hscim/src/Web/Scim/Test/Util.hs @@ -101,6 +101,7 @@ shouldEventuallyRespondWith action matcher = data AcceptanceConfig tag = AcceptanceConfig { scimAppAndConfig :: IO (Application, AcceptanceQueryConfig tag), + -- TODO: add a destructor, something like: @destroy :: CustomEnv tag -> IO ()@, genUserName :: IO Text, -- | some acceptance tests match against a fully rendered -- response body, which will not work when running the test diff --git a/libs/types-common/src/Data/CommaSeparatedList.hs b/libs/types-common/src/Data/CommaSeparatedList.hs index 8f944bde33..4346769a13 100644 --- a/libs/types-common/src/Data/CommaSeparatedList.hs +++ b/libs/types-common/src/Data/CommaSeparatedList.hs @@ -41,6 +41,7 @@ instance FromByteString (List a) => FromHttpApiData (CommaSeparatedList a) where instance ToParamSchema (CommaSeparatedList a) where toParamSchema _ = mempty & type_ ?~ SwaggerString +-- | TODO: is this obsoleted by the instances in "Data.Range"? instance (ToParamSchema a, ToParamSchema (Range n m [a])) => ToParamSchema (Range n m (CommaSeparatedList a)) where toParamSchema _ = toParamSchema (Proxy @(Range n m [a])) diff --git a/libs/wire-api/src/Wire/API/User.hs b/libs/wire-api/src/Wire/API/User.hs index 24758723fe..ffef5aa676 100644 --- a/libs/wire-api/src/Wire/API/User.hs +++ b/libs/wire-api/src/Wire/API/User.hs @@ -101,6 +101,7 @@ import Control.Lens (over, view, (.~), (?~)) import Data.Aeson (FromJSON (..), ToJSON (..)) import qualified Data.Aeson.Types as A import Data.ByteString.Conversion +import qualified Data.CaseInsensitive as CI import qualified Data.Code as Code import qualified Data.Currency as Currency import Data.Domain (Domain (Domain)) @@ -413,7 +414,10 @@ userSCIMExternalId usr = userSSOId >=> ssoIdExtId $ usr ssoIdExtId :: UserSSOId -> Maybe Text ssoIdExtId (UserSSOId _ nameIdXML) = case userManagedBy usr of ManagedByWire -> Nothing - ManagedByScim -> SAML.unsafeShowNameID <$> either (const Nothing) pure (SAML.decodeElem (TL.fromStrict nameIdXML)) + ManagedByScim -> + -- FUTUREWORK: keep the CI value, store the original in the database, but always use + -- the CI value for processing. + CI.original . SAML.unsafeShowNameID <$> either (const Nothing) pure (SAML.decodeElem (TL.fromStrict nameIdXML)) ssoIdExtId (UserScimExternalId extId) = pure extId connectedProfile :: User -> UserLegalHoldStatus -> UserProfile diff --git a/libs/wire-api/src/Wire/API/User/RichInfo.hs b/libs/wire-api/src/Wire/API/User/RichInfo.hs index dfa65cce8e..a3c176771b 100644 --- a/libs/wire-api/src/Wire/API/User/RichInfo.hs +++ b/libs/wire-api/src/Wire/API/User/RichInfo.hs @@ -54,6 +54,7 @@ import qualified Data.HashMap.Strict as HashMap import Data.Hashable (Hashable) import Data.List.Extra (nubOrdOn) import qualified Data.Map as Map +import Data.String.Conversions (cs) import qualified Data.Swagger.Build.Api as Doc import qualified Data.Text as Text import Imports @@ -278,8 +279,8 @@ instance FromJSON RichField where instance Arbitrary RichField where arbitrary = RichField - <$> arbitrary - <*> (arbitrary `QC.suchThat` (/= "")) -- This is required because FromJSON calls @normalizeRichInfo@ and roundtrip tests fail + <$> (CI.mk . cs . QC.getPrintableString <$> arbitrary) + <*> (cs . QC.getPrintableString <$> arbitrary `QC.suchThat` (/= QC.PrintableString "")) -- This is required because FromJSON calls @normalizeRichInfo*@ and roundtrip tests fail -------------------------------------------------------------------------------- -- convenience functions diff --git a/services/galley/galley.cabal b/services/galley/galley.cabal index 54a109379f..0357c2adca 100644 --- a/services/galley/galley.cabal +++ b/services/galley/galley.cabal @@ -4,7 +4,7 @@ cabal-version: 1.12 -- -- see: https://github.com/sol/hpack -- --- hash: 8728b07d9aff8cd747ea5ca33259f9168c966ae28ca76825e0a073e166d43213 +-- hash: 0acb724202f4ba39242c1ebbe5f5db555404624b7a6be922d5a4148d38c5786d name: galley version: 0.83.0 @@ -89,6 +89,7 @@ library , brig-types >=0.73.1 , bytestring >=0.9 , bytestring-conversion >=0.2 + , case-insensitive , cassandra-util >=0.16.2 , cassava >=0.5.2 , cereal >=0.4 @@ -167,6 +168,7 @@ executable galley build-depends: HsOpenSSL , base + , case-insensitive , extended , galley , galley-types @@ -299,6 +301,7 @@ executable galley-migrate-data ghc-options: -O2 -Wall -Wincomplete-uni-patterns -Wincomplete-record-updates -Wpartial-fields -fwarn-tabs -optP-Wno-nonportable-include-path build-depends: base + , case-insensitive , cassandra-util , conduit , containers @@ -365,6 +368,7 @@ executable galley-schema ghc-options: -O2 -Wall -Wincomplete-uni-patterns -Wincomplete-record-updates -Wpartial-fields -fwarn-tabs -optP-Wno-nonportable-include-path build-depends: base + , case-insensitive , cassandra-util , extended , imports @@ -397,6 +401,7 @@ test-suite galley-types-tests build-depends: QuickCheck , base + , case-insensitive , containers , extended , galley diff --git a/services/galley/package.yaml b/services/galley/package.yaml index 4b3430c046..795fe273d0 100644 --- a/services/galley/package.yaml +++ b/services/galley/package.yaml @@ -11,6 +11,7 @@ license: AGPL-3 dependencies: - imports +- case-insensitive - extended - safe >=0.3 - ssl-util diff --git a/services/galley/src/Galley/API/Teams.hs b/services/galley/src/Galley/API/Teams.hs index 587d325ed0..b2f8e53e38 100644 --- a/services/galley/src/Galley/API/Teams.hs +++ b/services/galley/src/Galley/API/Teams.hs @@ -63,6 +63,7 @@ import Control.Lens import Control.Monad.Catch import Data.ByteString.Conversion hiding (fromList) import Data.ByteString.Lazy.Builder (lazyByteString) +import qualified Data.CaseInsensitive as CI import Data.Csv (EncodeOptions (..), Quoting (QuoteAll), encodeDefaultOrderedByNameWith) import qualified Data.Handle as Handle import Data.Id @@ -488,7 +489,7 @@ getTeamMembersCSVH (zusr ::: tid ::: _) = do samlNamedId :: User -> Maybe Text samlNamedId = userSSOId >=> \case - (UserSSOId _idp nameId) -> SAML.unsafeShowNameID <$> either (const Nothing) pure (SAML.decodeElem (cs nameId)) + (UserSSOId _idp nameId) -> CI.original . SAML.unsafeShowNameID <$> either (const Nothing) pure (SAML.decodeElem (cs nameId)) (UserScimExternalId _) -> Nothing bulkGetTeamMembersH :: UserId ::: TeamId ::: Range 1 Public.HardTruncationLimit Int32 ::: JsonRequest Public.UserIdList ::: JSON -> Galley Response diff --git a/services/spar/src/Spar/API.hs b/services/spar/src/Spar/API.hs index 4d8dccbc1e..7afadc45b3 100644 --- a/services/spar/src/Spar/API.hs +++ b/services/spar/src/Spar/API.hs @@ -173,10 +173,12 @@ authresp ckyraw arbody = logErrors $ SAML.authresp sparSPIssuer sparResponseURI where cky :: Maybe BindCookie cky = ckyraw >>= bindCookieFromHeader + go :: SAML.AuthnResponse -> SAML.AccessVerdict -> Spar Void go resp verdict = do result :: SAML.ResponseVerdict <- verdictHandler cky resp verdict throwError $ SAML.CustomServant result + logErrors :: Spar Void -> Spar Void logErrors = flip catchError $ \case e@(SAML.CustomServant _) -> throwError e diff --git a/services/spar/src/Spar/App.hs b/services/spar/src/Spar/App.hs index 340c8d5cf3..c3914ab363 100644 --- a/services/spar/src/Spar/App.hs +++ b/services/spar/src/Spar/App.hs @@ -29,8 +29,6 @@ module Spar.App getUserByUref, getUserByScimExternalId, insertUser, - autoprovisionSamlUser, - autoprovisionSamlUserWithId, validateEmailIfExists, errorPage, ) @@ -48,6 +46,7 @@ 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.CaseInsensitive as CI import Data.Id import Data.String.Conversions import Data.Text.Ascii (encodeBase64, toText) @@ -77,6 +76,7 @@ import SAML2.WebSSO uidTenant, ) import qualified SAML2.WebSSO as SAML +import qualified SAML2.WebSSO.Types.Email as SAMLEmail import Servant import qualified Servant.Multipart as Multipart import qualified Spar.Data as Data @@ -229,47 +229,53 @@ getUserByScimExternalId tid email = do -- FUTUREWORK: once we support , brig will refuse to delete -- users that have an sso id, unless the request comes from spar. then we can make users -- undeletable in the team admin page, and ask admins to go talk to their IdP system. -createSamlUserWithId :: UserId -> SAML.UserRef -> ManagedBy -> Spar () -createSamlUserWithId buid suid managedBy = do +createSamlUserWithId :: UserId -> SAML.UserRef -> Spar () +createSamlUserWithId buid suid = do teamid <- (^. idpExtraInfo . wiTeam) <$> getIdPConfigByIssuer (suid ^. uidTenant) uname <- either (throwSpar . SparBadUserName . cs) pure $ Intra.mkUserName Nothing (UrefOnly suid) - buid' <- Intra.createBrigUserSAML suid buid teamid uname managedBy + buid' <- Intra.createBrigUserSAML suid buid teamid uname ManagedByWire assert (buid == buid') $ pure () insertUser suid buid -- | If the team has no scim token, call 'createSamlUser'. Otherwise, raise "invalid -- credentials". -autoprovisionSamlUser :: SAML.UserRef -> ManagedBy -> Spar UserId -autoprovisionSamlUser suid managedBy = do +autoprovisionSamlUser :: SAML.UserRef -> Spar UserId +autoprovisionSamlUser suid = do buid <- Id <$> liftIO UUID.nextRandom - autoprovisionSamlUserWithId buid suid managedBy + autoprovisionSamlUserWithId buid suid pure buid -- | Like 'autoprovisionSamlUser', but for an already existing 'UserId'. -autoprovisionSamlUserWithId :: UserId -> SAML.UserRef -> ManagedBy -> Spar () -autoprovisionSamlUserWithId buid suid managedBy = do +autoprovisionSamlUserWithId :: UserId -> SAML.UserRef -> Spar () +autoprovisionSamlUserWithId buid suid = do idp <- getIdPConfigByIssuer (suid ^. uidTenant) - unless (isNothing $ idp ^. idpExtraInfo . wiReplacedBy) $ do - throwSpar $ SparCannotCreateUsersOnReplacedIdP (cs . SAML.idPIdToST $ idp ^. idpId) - let teamid = idp ^. idpExtraInfo . wiTeam - scimtoks <- wrapMonadClient $ Data.getScimTokens teamid - if null scimtoks - then do - createSamlUserWithId buid suid managedBy - validateEmailIfExists buid suid - else - throwError . SAML.Forbidden $ - "bad credentials (note that your team uses SCIM, " - <> "which disables saml auto-provisioning)" + guardReplacedIdP idp + guardScimTokens idp + createSamlUserWithId buid suid + validateEmailIfExists buid suid + where + -- Replaced IdPs are not allowed to create new wire accounts. + guardReplacedIdP :: IdP -> Spar () + guardReplacedIdP idp = do + unless (isNothing $ idp ^. idpExtraInfo . wiReplacedBy) $ do + throwSpar $ SparCannotCreateUsersOnReplacedIdP (cs . SAML.idPIdToST $ idp ^. idpId) + + -- IdPs in teams with scim tokens are not allowed to auto-provision. + guardScimTokens :: IdP -> Spar () + guardScimTokens idp = do + let teamid = idp ^. idpExtraInfo . wiTeam + scimtoks <- wrapMonadClient $ Data.getScimTokens teamid + unless (null scimtoks) $ do + throwSpar SparSamlCredentialsNotFound -- | If user's 'NameID' is an email address and the team has email validation for SSO enabled, -- make brig initiate the email validate procedure. validateEmailIfExists :: UserId -> SAML.UserRef -> Spar () validateEmailIfExists uid = \case - (SAML.UserRef _ (view SAML.nameID -> UNameIDEmail email)) -> doValidate email + (SAML.UserRef _ (view SAML.nameID -> UNameIDEmail email)) -> doValidate (CI.original email) _ -> pure () where - doValidate :: SAML.Email -> Spar () + doValidate :: SAMLEmail.Email -> Spar () doValidate email = do enabled <- do tid <- Intra.getBrigUserTeam Intra.NoPendingInvitations uid @@ -421,7 +427,7 @@ verdictHandlerResultCore bindCky = \case -- This is the first SSO authentication, so we auto-create a user. We know the user -- has not been created via SCIM because then we would've ended up in the -- "reauthentication" branch, so we pass 'ManagedByWire'. - (Nothing, Nothing, Nothing) -> autoprovisionSamlUser userref ManagedByWire + (Nothing, Nothing, Nothing) -> autoprovisionSamlUser userref -- If the user is only found under an old (previous) issuer, move it here. (Nothing, Nothing, Just (oldUserRef, uid)) -> moveUserToNewIssuer oldUserRef userref uid >> pure uid -- SSO re-authentication (the most common case). diff --git a/services/spar/src/Spar/Data.hs b/services/spar/src/Spar/Data.hs index a84d0b132f..3f0658518b 100644 --- a/services/spar/src/Spar/Data.hs +++ b/services/spar/src/Spar/Data.hs @@ -94,6 +94,7 @@ import Control.Arrow (Arrow ((&&&))) import Control.Lens import Control.Monad.Except import Data.CaseInsensitive (foldCase) +import qualified Data.CaseInsensitive as CI import Data.Id import Data.Json.Util (UTCTimeMillis, toUTCTimeMillis) import qualified Data.List.NonEmpty as NL @@ -104,8 +105,8 @@ import GHC.TypeLits (KnownSymbol) import Imports import SAML2.Util (renderURI) import qualified SAML2.WebSSO as SAML +import qualified SAML2.WebSSO.Types.Email as SAMLEmail import Spar.Data.Instances (VerdictFormatCon, VerdictFormatRow, fromVerdictFormat, toVerdictFormat) -import qualified Text.Email.Parser as Email import Text.RawString.QQ import URI.ByteString import qualified Web.Cookie as Cky @@ -283,7 +284,7 @@ normalizeUnqualifiedNameId = NormalizedUNameID . foldCase . nameIdTxt where nameIdTxt :: SAML.UnqualifiedNameID -> ST nameIdTxt (SAML.UNameIDUnspecified txt) = SAML.unsafeFromXmlText txt - nameIdTxt (SAML.UNameIDEmail (SAML.Email txt)) = cs $ Email.toByteString txt + nameIdTxt (SAML.UNameIDEmail email) = SAMLEmail.render $ CI.original email nameIdTxt (SAML.UNameIDX509 txt) = SAML.unsafeFromXmlText txt nameIdTxt (SAML.UNameIDWindows txt) = SAML.unsafeFromXmlText txt nameIdTxt (SAML.UNameIDKerberos txt) = SAML.unsafeFromXmlText txt diff --git a/services/spar/src/Spar/Error.hs b/services/spar/src/Spar/Error.hs index e9920b9be2..960b7de809 100644 --- a/services/spar/src/Spar/Error.hs +++ b/services/spar/src/Spar/Error.hs @@ -69,6 +69,7 @@ throwSpar = throwError . SAML.CustomError data SparCustomError = SparIdPNotFound + | SparSamlCredentialsNotFound | SparMissingZUsr | SparNotInTeam | SparNoPermission LT @@ -158,6 +159,7 @@ renderSparError SAML.BadSamlResponseNoAssertions = Right $ Wai.mkError status400 renderSparError SAML.BadSamlResponseAssertionWithoutID = Right $ Wai.mkError status400 "bad-response-saml" ("Bad response: assertion without ID") renderSparError (SAML.BadSamlResponseInvalidSignature msg) = Right $ Wai.mkError status400 "bad-response-signature" (cs msg) renderSparError (SAML.CustomError SparIdPNotFound) = Right $ Wai.mkError status404 "not-found" "Could not find IdP." +renderSparError (SAML.CustomError SparSamlCredentialsNotFound) = Right $ Wai.mkError status404 "not-found" "Could not find SAML credentials, and auto-provisioning is disabled." renderSparError (SAML.CustomError SparMissingZUsr) = Right $ Wai.mkError status400 "client-error" "[header] 'Z-User' required" renderSparError (SAML.CustomError SparNotInTeam) = Right $ Wai.mkError status403 "no-team-member" "Requesting user is not a team member or not a member of this team." renderSparError (SAML.CustomError (SparNoPermission perm)) = Right $ Wai.mkError status403 "insufficient-permissions" ("You need permission " <> cs perm <> ".") diff --git a/services/spar/src/Spar/Intra/Brig.hs b/services/spar/src/Spar/Intra/Brig.hs index 13e25bbf99..751911f3fd 100644 --- a/services/spar/src/Spar/Intra/Brig.hs +++ b/services/spar/src/Spar/Intra/Brig.hs @@ -67,6 +67,7 @@ import Brig.Types.User.Auth (SsoLogin (..)) import Control.Lens import Control.Monad.Except import Data.ByteString.Conversion +import qualified Data.CaseInsensitive as CI import Data.Handle (Handle (Handle, fromHandle)) import Data.Id (Id (Id), TeamId, UserId) import Data.Misc (PlainTextPassword) @@ -76,10 +77,10 @@ import Imports import Network.HTTP.Types.Method import qualified Network.Wai.Utilities.Error as Wai import qualified SAML2.WebSSO as SAML +import qualified SAML2.WebSSO.Types.Email as SAMLEmail import Spar.Error import Spar.Intra.Galley as Galley (MonadSparToGalley, assertHasPermission) import qualified System.Logger.Class as Log -import qualified Text.Email.Parser import Web.Cookie import Wire.API.User import Wire.API.User.RichInfo as RichInfo @@ -111,11 +112,11 @@ veidFromUserSSOId = \case (parseEmail email) urefToExternalId :: SAML.UserRef -> Maybe Text -urefToExternalId = SAML.shortShowNameID . view SAML.uidSubject +urefToExternalId = fmap CI.original . SAML.shortShowNameID . view SAML.uidSubject urefToEmail :: SAML.UserRef -> Maybe Email urefToEmail uref = case uref ^. SAML.uidSubject . SAML.nameID of - SAML.UNameIDEmail email -> Just $ emailFromSAML email + SAML.UNameIDEmail email -> Just . emailFromSAML . CI.original $ email _ -> Nothing -- | If the brig user has a 'UserSSOId', transform that into a 'ValidExternalId' (this is a @@ -140,7 +141,7 @@ mkUserName :: Maybe Text -> ValidExternalId -> Either String Name mkUserName (Just n) = const $ mkName n mkUserName Nothing = runValidExternalId - (\uref -> mkName (SAML.unsafeShowNameID $ uref ^. SAML.uidSubject)) + (\uref -> mkName (CI.original . SAML.unsafeShowNameID $ uref ^. SAML.uidSubject)) (\email -> mkName (fromEmail email)) renderValidExternalId :: ValidExternalId -> Maybe Text @@ -157,18 +158,11 @@ respToCookie resp = do unless (statusCode resp == 200) crash maybe crash (pure . parseSetCookie) $ getHeader "Set-Cookie" resp -emailFromSAML :: HasCallStack => SAML.Email -> Email -emailFromSAML = - fromJust . parseEmail . cs - . Text.Email.Parser.toByteString - . SAML.fromEmail +emailFromSAML :: HasCallStack => SAMLEmail.Email -> Email +emailFromSAML = fromJust . parseEmail . SAMLEmail.render -emailToSAML :: HasCallStack => Email -> SAML.Email -emailToSAML brigEmail = - SAML.Email $ - Text.Email.Parser.unsafeEmailAddress - (cs $ emailLocal brigEmail) - (cs $ emailDomain brigEmail) +emailToSAML :: HasCallStack => Email -> SAMLEmail.Email +emailToSAML = CI.original . fromRight (error "emailToSAML") . SAMLEmail.validate . toByteString -- | FUTUREWORK(fisx): if saml2-web-sso exported the 'NameID' constructor, we could make this -- function total without all that praying and hoping. @@ -177,7 +171,7 @@ emailToSAMLNameID = fromRight (error "impossible") . SAML.emailNameID . fromEmai emailFromSAMLNameID :: HasCallStack => SAML.NameID -> Maybe Email emailFromSAMLNameID nid = case nid ^. SAML.nameID of - SAML.UNameIDEmail email -> Just $ emailFromSAML email + SAML.UNameIDEmail email -> Just . emailFromSAML . CI.original $ email _ -> Nothing ---------------------------------------------------------------------- diff --git a/services/spar/test-integration/Test/Spar/APISpec.hs b/services/spar/test-integration/Test/Spar/APISpec.hs index 0aef29526a..1103a4ce24 100644 --- a/services/spar/test-integration/Test/Spar/APISpec.hs +++ b/services/spar/test-integration/Test/Spar/APISpec.hs @@ -438,20 +438,24 @@ specBindingUsers = describe "binding existing users to sso identities" $ do liftIO $ ('s', ssoidViaSelf) `shouldBe` ('s', ssoidViaAuthResp) Just uidViaSpar <- ssoToUidSpar tid ssoidViaAuthResp liftIO $ ('u', uidViaSpar) `shouldBe` ('u', uid) + checkGrantingAuthnResp' :: HasCallStack => ResponseLBS -> TestSpar () checkGrantingAuthnResp' sparresp = do liftIO $ do (cs @_ @String . fromJust . responseBody $ sparresp) `shouldContain` "wire:sso:success" hasPersistentCookieHeader sparresp `shouldBe` Right () + checkDenyingAuthnResp :: HasCallStack => ResponseLBS -> ST -> TestSpar () checkDenyingAuthnResp sparresp errorlabel = do liftIO $ do (cs @_ @String . fromJust . responseBody $ sparresp) `shouldContain` ("wire:sso:error:" <> cs errorlabel <> "") hasPersistentCookieHeader sparresp `shouldBe` Left "no set-cookie header" + initialBind :: HasCallStack => UserId -> IdP -> SignPrivCreds -> TestSpar (NameID, SignedAuthnResponse, ResponseLBS) initialBind = initialBind' Just + initialBind' :: HasCallStack => (Cky.Cookies -> Maybe Cky.Cookies) -> @@ -463,8 +467,10 @@ specBindingUsers = describe "binding existing users to sso identities" $ do subj <- nextSubject (authnResp, sparAuthnResp) <- reBindSame' tweakcookies uid idp privcreds subj pure (subj, authnResp, sparAuthnResp) + reBindSame :: HasCallStack => UserId -> IdP -> SignPrivCreds -> NameID -> TestSpar (SignedAuthnResponse, ResponseLBS) reBindSame = reBindSame' Just + reBindSame' :: HasCallStack => (Cky.Cookies -> Maybe Cky.Cookies) -> @@ -484,6 +490,7 @@ specBindingUsers = describe "binding existing users to sso identities" $ do sparAuthnResp :: ResponseLBS <- submitAuthnResponse' cookiehdr authnResp pure (authnResp, sparAuthnResp) + reBindDifferent :: HasCallStack => UserId -> TestSpar (SignedAuthnResponse, ResponseLBS) reBindDifferent uid = do env <- ask @@ -1156,6 +1163,7 @@ specDeleteCornerCases = describe "delete corner cases" $ do samlUserShouldSatisfy uref property = do muid <- getUserIdViaRef' uref liftIO $ muid `shouldSatisfy` property + createViaSamlResp :: HasCallStack => IdP -> SignPrivCreds -> SAML.UserRef -> TestSpar ResponseLBS createViaSamlResp idp privCreds (SAML.UserRef _ subj) = do authnReq <- negotiateAuthnRequest idp @@ -1164,6 +1172,7 @@ specDeleteCornerCases = describe "delete corner cases" $ do createResp <- submitAuthnResponse authnResp liftIO $ responseStatus createResp `shouldBe` status200 pure createResp + createViaSaml :: HasCallStack => IdP -> SignPrivCreds -> SAML.UserRef -> TestSpar (Maybe UserId) createViaSaml idp privcreds uref = do resp <- createViaSamlResp idp privcreds uref @@ -1171,6 +1180,7 @@ specDeleteCornerCases = describe "delete corner cases" $ do maybe (error "no body") cs (responseBody resp) `shouldContain` "wire:sso:success" getUserIdViaRef' uref + deleteViaBrig :: UserId -> TestSpar () deleteViaBrig uid = do brig <- view teBrig diff --git a/services/spar/test-integration/Test/Spar/Scim/UserSpec.hs b/services/spar/test-integration/Test/Spar/Scim/UserSpec.hs index 21865f2be1..8b742be0a6 100644 --- a/services/spar/test-integration/Test/Spar/Scim/UserSpec.hs +++ b/services/spar/test-integration/Test/Spar/Scim/UserSpec.hs @@ -46,6 +46,7 @@ import Data.Aeson.QQ (aesonQQ) import Data.Aeson.Types (fromJSON, toJSON) import qualified Data.Bifunctor as Bifunctor import Data.ByteString.Conversion +import qualified Data.CaseInsensitive as CI import qualified Data.Csv as Csv import Data.Handle (Handle (Handle), fromHandle) import Data.Id (TeamId, UserId, randomId) @@ -260,7 +261,7 @@ testCsvData tid owner uid mbeid mbsaml = do let haveSubject :: Text haveSubject = case mbsaml of - Just (UserSSOId _ subject) -> either (error . show) SAML.unsafeShowNameID $ SAML.decodeElem (cs subject) + Just (UserSSOId _ subject) -> either (error . show) (CI.original . SAML.unsafeShowNameID) $ SAML.decodeElem (cs subject) Just (UserScimExternalId _) -> "" Nothing -> "" ('n', CsvExport.tExportSAMLNamedId export) `shouldBe` ('n', haveSubject) @@ -359,6 +360,11 @@ testCreateUserNoIdP = do let eid = Scim.User.externalId scimUser sml = Nothing in testCsvData tid owner userid eid sml + + -- members table contains an entry + -- (this really shouldn't be tested here, but by the type system!) + members <- getTeamMembers userid tid + liftIO $ members `shouldContain` [userid] where -- cloned from brig's integration tests @@ -431,6 +437,11 @@ testCreateUserWithSamlIdP = do sml = fromJust $ userIdentity >=> ssoIdentity $ brigUser in testCsvData tid owner uid eid (Just sml) + -- members table contains an entry + -- (this really shouldn't be tested here, but by the type system!) + members <- getTeamMembers userid tid + liftIO $ members `shouldContain` [userid] + -- | Test that Wire-specific schemas are added to the SCIM user record, even if the schemas -- were not present in the original record during creation. testSchemaIsAdded :: TestSpar () @@ -670,6 +681,7 @@ testScimCreateVsUserRef = do samlUserShouldSatisfy uref property = do muid <- getUserIdViaRef' uref liftIO $ muid `shouldSatisfy` property + createViaSamlResp :: HasCallStack => IdP -> SAML.SignPrivCreds -> SAML.UserRef -> TestSpar ResponseLBS createViaSamlResp idp privCreds (SAML.UserRef _ subj) = do authnReq <- negotiateAuthnRequest idp @@ -678,12 +690,14 @@ testScimCreateVsUserRef = do runSimpleSP $ SAML.mkAuthnResponseWithSubj subj privCreds idp spmeta authnReq True submitAuthnResponse authnResp IdP -> SAML.SignPrivCreds -> SAML.UserRef -> TestSpar () createViaSamlFails idp privCreds uref = do resp <- createViaSamlResp idp privCreds uref liftIO $ do maybe (error "no body") cs (responseBody resp) - `shouldContain` "wire:sso:error:forbidden" + `shouldNotContain` "wire:sso:error:success" + createViaSaml :: HasCallStack => IdP -> SAML.SignPrivCreds -> SAML.UserRef -> TestSpar (Maybe UserId) createViaSaml idp privCreds uref = do resp <- createViaSamlResp idp privCreds uref @@ -691,6 +705,7 @@ testScimCreateVsUserRef = do maybe (error "no body") cs (responseBody resp) `shouldContain` "wire:sso:success" getUserIdViaRef' uref + deleteViaBrig :: UserId -> TestSpar () deleteViaBrig uid = do brig <- view teBrig @@ -821,7 +836,7 @@ testFindSamlAutoProvisionedUserMigratedWithEmailInTeamWithSSO = do veidToText :: MonadError String m => ValidExternalId -> m Text veidToText veid = runValidExternalId - (\(SAML.UserRef _ subj) -> maybe (throwError "bad uref from brig") pure $ SAML.shortShowNameID subj) + (\(SAML.UserRef _ subj) -> maybe (throwError "bad uref from brig") (pure . CI.original) $ SAML.shortShowNameID subj) (pure . fromEmail) veid diff --git a/stack.yaml b/stack.yaml index 6a3b6f8b11..7eb20da383 100644 --- a/stack.yaml +++ b/stack.yaml @@ -70,7 +70,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: ac88b934bb4a91d4d4bb90c620277188e4087043 # https://github.com/wireapp/saml2-web-sso/pull/73 (Feb 18, 2021) + commit: f56b5ffc10ec5ceab9a508cbb9f8fbaa017bbf2c # https://github.com/wireapp/saml2-web-sso/pull/74 (Apr 30, 2021) - git: https://github.com/kim/hs-collectd commit: 885da222be2375f78c7be36127620ed772b677c9 diff --git a/stack.yaml.lock b/stack.yaml.lock index ba806b6b8c..3cd6d32d24 100644 --- a/stack.yaml.lock +++ b/stack.yaml.lock @@ -22,12 +22,12 @@ packages: version: '0.18' git: https://github.com/wireapp/saml2-web-sso pantry-tree: - size: 4815 - sha256: 04b922847a5e37d578bb9b43c4ea0694e0b731c710362957b12ac19f49b95264 - commit: ac88b934bb4a91d4d4bb90c620277188e4087043 + size: 4887 + sha256: 12be9a699749b9ebe63fb2e04113c2f2160a63494e8a2ba005792a02d0571f47 + commit: f56b5ffc10ec5ceab9a508cbb9f8fbaa017bbf2c original: git: https://github.com/wireapp/saml2-web-sso - commit: ac88b934bb4a91d4d4bb90c620277188e4087043 + commit: f56b5ffc10ec5ceab9a508cbb9f8fbaa017bbf2c - completed: name: collectd version: 0.0.0.2