diff --git a/changelog.d/2-features/send-email-on-idp-change b/changelog.d/2-features/send-email-on-idp-change new file mode 100644 index 00000000000..8bd6a7679c5 --- /dev/null +++ b/changelog.d/2-features/send-email-on-idp-change @@ -0,0 +1,3 @@ +Send an email to team admins and owners when an IdP is changed via API (create, +update, delete). This behaviour is for now only enabled for multi-ingress +setups. diff --git a/libs/extended/src/Data/X509/Extended.hs b/libs/extended/src/Data/X509/Extended.hs index 964c2ee3028..a635c5a2d86 100644 --- a/libs/extended/src/Data/X509/Extended.hs +++ b/libs/extended/src/Data/X509/Extended.hs @@ -1,4 +1,6 @@ -module Data.X509.Extended (certToString) where +{-# LANGUAGE RecordWildCards #-} + +module Data.X509.Extended (certToString, certDescription, CertDescription (..)) where import Crypto.Hash import Data.ASN1.OID @@ -12,21 +14,36 @@ import Imports certToString :: SignedCertificate -> String certToString signedCert = + let desc = certDescription signedCert + in -- Split into pairs and join with ':' + mconcat . intersperse "; " $ + [ "Issuer: " <> desc.issuer, + "Subject: " <> desc.subject, + desc.fingerprintAlgorithm <> " Fingerprint: " <> desc.fingerprint + ] + +data CertDescription = CertDescription + { fingerprintAlgorithm :: String, + fingerprint :: String, + subject :: String, + issuer :: String + } + deriving (Eq, Show) + +-- | Extract structured certificate description information +certDescription :: SignedCertificate -> CertDescription +certDescription signedCert = let cert = getCertificate signedCert issuer = dnToString $ certIssuerDN cert subject = dnToString $ certSubjectDN cert der = encodeSignedObject signedCert - fingerprint :: ByteString = BAE.convertToBase BAE.Base16 (hash der :: Digest SHA1) - -- Split into pairs and join with ':' - fingerprintStr = - let hex = (T.decodeUtf8 fingerprint) + fingerprintBS :: ByteString = BAE.convertToBase BAE.Base16 (hash der :: Digest SHA1) + fingerprint = + let hex = (T.decodeUtf8 fingerprintBS) pairs = T.unpack <$> T.chunksOf 2 hex in map toUpper (intercalate ":" pairs) - in mconcat . intersperse "; " $ - [ "Issuer: " <> issuer, - "Subject: " <> subject, - "SHA1 Fingerprint: " <> fingerprintStr - ] + fingerprintAlgorithm = "SHA1" + in CertDescription {..} dnToString :: DistinguishedName -> String dnToString (getDistinguishedElements -> es) = diff --git a/libs/extended/test/Test/Data/X509/ExtendedSpec.hs b/libs/extended/test/Test/Data/X509/ExtendedSpec.hs index 21d5316799e..0c63713099f 100644 --- a/libs/extended/test/Test/Data/X509/ExtendedSpec.hs +++ b/libs/extended/test/Test/Data/X509/ExtendedSpec.hs @@ -22,15 +22,47 @@ spec = expected = "Issuer: CN=accounts.accesscontrol.windows.net; Subject: CN=accounts.accesscontrol.windows.net; SHA1 Fingerprint: 15:28:A6:B8:5A:C5:36:80:B4:B0:95:C6:9A:FD:77:9C:D6:5C:78:37" checkDecodingWithPEMFile pemFilePath expected + describe "certDescription" $ do + it "should extract certificate description from stars' Keycloak certificate" $ do + let pemFilePath = "test/data/" <> "sven-test.pem" + expected = + CertDescription + { fingerprintAlgorithm = "SHA1", + fingerprint = "F4:A2:73:D7:B7:2E:EA:66:E1:CB:81:E9:58:BC:1A:E9:CF:3C:95:C4", + subject = "CN=sven-test", + issuer = "CN=sven-test" + } + checkCertDescriptionWithPEMFile pemFilePath expected + + it "should extract certificate description from unit test data (saml2-web-sso)" $ do + let pemFilePath = "test/data/" <> "test-cert.pem" + expected = + CertDescription + { fingerprintAlgorithm = "SHA1", + fingerprint = "15:28:A6:B8:5A:C5:36:80:B4:B0:95:C6:9A:FD:77:9C:D6:5C:78:37", + subject = "CN=accounts.accesscontrol.windows.net", + issuer = "CN=accounts.accesscontrol.windows.net" + } + checkCertDescriptionWithPEMFile pemFilePath expected + checkDecodingWithPEMFile :: FilePath -> String -> IO () checkDecodingWithPEMFile pemFilePath expected = do + cert <- loadSignedCertificate pemFilePath + certToString cert `shouldBe` expected + +checkCertDescriptionWithPEMFile :: FilePath -> CertDescription -> IO () +checkCertDescriptionWithPEMFile pemFilePath expected = do + cert <- loadSignedCertificate pemFilePath + certDescription cert `shouldBe` expected + +-- | Load and decode a SignedCertificate from a PEM file +loadSignedCertificate :: FilePath -> IO SignedCertificate +loadSignedCertificate pemFilePath = do -- sanity check if the file even exists exists <- doesFileExist pemFilePath exists `shouldBe` True file <- BS.readFile pemFilePath - let decoded :: SignedCertificate = either error id $ do - pemBS <- pemContent . fromMaybe (error "Empty PEM list") . listToMaybe <$> pemParseBS file - decodeSignedCertificate pemBS - - certToString decoded `shouldBe` expected + pure . either error id $ do + pemBS <- pemContent . fromMaybe (error "Empty PEM list") . listToMaybe <$> pemParseBS file + decodeSignedCertificate pemBS diff --git a/libs/saml2-web-sso/default.nix b/libs/saml2-web-sso/default.nix index e4d714b7145..d09f6565fcb 100644 --- a/libs/saml2-web-sso/default.nix +++ b/libs/saml2-web-sso/default.nix @@ -48,6 +48,7 @@ , memory , mtl , network-uri +, openapi3 , pretty-show , process , QuickCheck @@ -127,6 +128,7 @@ mkDerivation { memory mtl network-uri + openapi3 pretty-show process QuickCheck diff --git a/libs/saml2-web-sso/saml2-web-sso.cabal b/libs/saml2-web-sso/saml2-web-sso.cabal index da09daed9ed..ce29601401e 100644 --- a/libs/saml2-web-sso/saml2-web-sso.cabal +++ b/libs/saml2-web-sso/saml2-web-sso.cabal @@ -121,6 +121,7 @@ library , memory >=0.14.18 , mtl >=2.2.2 , network-uri >=2.6.1.0 + , openapi3 , pretty-show >=1.9.5 , process >=1.6.5.0 , QuickCheck >=2.13.2 diff --git a/libs/saml2-web-sso/src/SAML2/WebSSO/Config.hs b/libs/saml2-web-sso/src/SAML2/WebSSO/Config.hs index 9d7c46a5a8f..a1a3d92a212 100644 --- a/libs/saml2-web-sso/src/SAML2/WebSSO/Config.hs +++ b/libs/saml2-web-sso/src/SAML2/WebSSO/Config.hs @@ -24,6 +24,7 @@ import Control.Lens hiding (Level, element, enum, (.=)) import Control.Monad (when) import Data.Aeson qualified as A import Data.Domain +import Data.Either import Data.Map import Data.Map qualified as Map import Data.Schema @@ -68,6 +69,9 @@ data MultiIngressDomainConfig = MultiIngressDomainConfig deriving (Eq, Show, Generic) deriving (A.ToJSON, A.FromJSON) via Schema MultiIngressDomainConfig +isMultiIngressConfig :: Config -> Bool +isMultiIngressConfig = isRight . _cfgDomainConfigs + ---------------------------------------------------------------------- -- schema-profunctor diff --git a/libs/saml2-web-sso/src/SAML2/WebSSO/Orphans.hs b/libs/saml2-web-sso/src/SAML2/WebSSO/Orphans.hs index 63de8700733..a19e16c1117 100644 --- a/libs/saml2-web-sso/src/SAML2/WebSSO/Orphans.hs +++ b/libs/saml2-web-sso/src/SAML2/WebSSO/Orphans.hs @@ -11,10 +11,10 @@ import Data.Aeson import Data.ByteString import Data.ByteString.Builder import Data.Schema as Schema -import Data.String.Conversions import Data.Text (Text) import Data.Text qualified as Text import Data.Text.Encoding qualified as Text +import Data.Text.Lazy qualified as TL import Data.X509 as X509 import Data.Yaml.Aeson qualified as A import SAML2.Util (normURI, parseURI', renderURI) @@ -37,11 +37,18 @@ instance ToHttpApiData URI where instance FromHttpApiData URI where parseUrlPiece = either (Left . Text.pack) pure . parseURI' <=< parseUrlPiece -instance FromJSON X509.SignedCertificate where - parseJSON = withText "KeyInfo element" $ either fail pure . parseKeyInfo False . cs +instance Schema.ToSchema SignedCertificate where + schema = serialize Schema..= Schema.parsedText "SignedCertificate" parse + where + parse :: Text.Text -> Either String SignedCertificate + parse = parseKeyInfo False . TL.fromStrict + + serialize :: SignedCertificate -> Text.Text + serialize = TL.toStrict . renderKeyInfo + +deriving via (Schema.Schema SignedCertificate) instance FromJSON SignedCertificate -instance ToJSON X509.SignedCertificate where - toJSON = String . cs . renderKeyInfo +deriving via (Schema.Schema SignedCertificate) instance ToJSON SignedCertificate -- This can unfortunately not live in wire-api, because wire-api depends on -- saml2-web-sso. @@ -69,3 +76,14 @@ instance ToSchema Level where deriving instance Enum Level deriving instance Bounded Level + +-- | Used in tests to have no @extra@ in @IdPConfig extra@ +instance Schema.ToSchema () where + schema = Schema.named "unit" $ Schema.null_ + +-- | Used in tests to have JSON as @extra@ in @IdPConfig extra@ +instance Schema.ToSchema A.Value where + schema = + Schema.named (Text.pack "Value") $ + id + Schema..= Schema.jsonValue diff --git a/libs/saml2-web-sso/src/SAML2/WebSSO/Types.hs b/libs/saml2-web-sso/src/SAML2/WebSSO/Types.hs index 21c57322871..93039ca76d7 100644 --- a/libs/saml2-web-sso/src/SAML2/WebSSO/Types.hs +++ b/libs/saml2-web-sso/src/SAML2/WebSSO/Types.hs @@ -161,7 +161,6 @@ module SAML2.WebSSO.Types where import Control.Lens -import Control.Monad ((<=<)) import Control.Monad.Except import Data.Aeson import Data.Aeson.TH @@ -171,6 +170,7 @@ import Data.List qualified as L import Data.List.NonEmpty (NonEmpty ((:|))) import Data.List.NonEmpty qualified as NL import Data.Maybe +import Data.OpenApi qualified as S import Data.Schema qualified as Schema import Data.String.Conversions (ST, cs) import Data.Text (Text) @@ -230,14 +230,15 @@ data UserRef = UserRef {_uidTenant :: Issuer, _uidSubject :: NameID} -- | More correctly, an 'Issuer' is a 'NameID', but we only support 'URI'. newtype Issuer = Issuer {_fromIssuer :: URI} deriving (Eq, Ord, Show, Generic) + deriving (FromJSON, ToJSON, S.ToSchema) via Schema.Schema Issuer -instance FromJSON Issuer where - parseJSON = withText "Issuer" $ \uri -> case parseURI' uri of - Right i -> pure $ Issuer i - Left msg -> fail $ "Issuer: " <> show msg - -instance ToJSON Issuer where - toJSON = toJSON . renderURI . _fromIssuer +instance Schema.ToSchema Issuer where + schema = + Issuer + <$> _fromIssuer Schema..= uriSchema + where + uriSchema :: Schema.ValueSchema Schema.NamedSwaggerDoc URI + uriSchema = renderURI Schema..= Schema.parsedText "URI" parseURI' ---------------------------------------------------------------------- -- meta [4/2.3.2] @@ -307,11 +308,33 @@ data IdPMetadata = IdPMetadata _edCertAuthnResponse :: NonEmpty X509.SignedCertificate } deriving (Eq, Show, Generic) + deriving (FromJSON, ToJSON, S.ToSchema) via (Schema.Schema IdPMetadata) + +instance Schema.ToSchema IdPMetadata where + schema = + Schema.object "IdPMetadata" $ + IdPMetadata + <$> (_edIssuer Schema..= Schema.field "issuer" Schema.schema) + <*> (_edRequestURI Schema..= Schema.field "requestURI" Schema.schema) + <*> (_edCertAuthnResponse Schema..= Schema.field "certAuthnResponse" (Schema.nonEmptyArray Schema.schema)) ---------------------------------------------------------------------- -- idp info -newtype IdPId = IdPId {fromIdPId :: UUID} deriving (Eq, Show, Generic, Ord) +newtype IdPId = IdPId {fromIdPId :: UUID} + deriving (Eq, Show, Generic, Ord) + deriving (FromJSON, ToJSON, S.ToSchema) via Schema.Schema IdPId + +instance Schema.ToSchema IdPId where + schema = + IdPId + <$> fromIdPId Schema..= idpIdSchema + where + idpIdSchema :: Schema.ValueSchema Schema.NamedSwaggerDoc UUID + idpIdSchema = UUID.toText Schema..= Schema.parsedText "URI" parseUUID + + parseUUID :: Text -> Either String UUID + parseUUID = maybe (Left "Cannot parse UUID") Right . UUID.fromText type IdPConfig_ = IdPConfig () @@ -321,6 +344,15 @@ data IdPConfig extra = IdPConfig _idpExtraInfo :: extra } deriving (Eq, Show, Generic) + deriving (FromJSON, ToJSON, S.ToSchema) via (Schema.Schema (IdPConfig extra)) + +instance (Schema.ToSchema extra) => Schema.ToSchema (IdPConfig extra) where + schema = + Schema.object "IdPConfig" $ + IdPConfig + <$> (_idpId Schema..= Schema.field "id" Schema.schema) + <*> (_idpMetadata Schema..= Schema.field "metadata" Schema.schema) + <*> (_idpExtraInfo Schema..= Schema.field "extraInfo" Schema.schema) ---------------------------------------------------------------------- -- request, response @@ -721,18 +753,6 @@ makePrisms ''Statement makePrisms ''UnqualifiedNameID -deriveJSON deriveJSONOptions ''IdPMetadata - -deriveJSON deriveJSONOptions ''IdPConfig - -instance FromJSON IdPId where - parseJSON value = ((maybe unerror (pure . IdPId) . UUID.fromText) <=< parseJSON) value - where - unerror = fail ("could not parse config: " <> (show value)) - -instance ToJSON IdPId where - toJSON = toJSON . UUID.toText . fromIdPId - idPIdToST :: IdPId -> ST idPIdToST = UUID.toText . fromIdPId diff --git a/libs/saml2-web-sso/test/Test/SAML2/WebSSO/RoundtripSpec.hs b/libs/saml2-web-sso/test/Test/SAML2/WebSSO/RoundtripSpec.hs index a9aba125691..dce765a26a8 100644 --- a/libs/saml2-web-sso/test/Test/SAML2/WebSSO/RoundtripSpec.hs +++ b/libs/saml2-web-sso/test/Test/SAML2/WebSSO/RoundtripSpec.hs @@ -32,6 +32,7 @@ import Hedgehog import Hedgehog.Gen as Gen import SAML2.Core qualified as HS import SAML2.WebSSO +import SAML2.WebSSO.Orphans () import SAML2.WebSSO.Test.Arbitrary import SAML2.WebSSO.Test.Util import Servant diff --git a/libs/wire-api/src/Wire/API/Routes/Internal/Brig.hs b/libs/wire-api/src/Wire/API/Routes/Internal/Brig.hs index a4ecd447cd1..9324c553124 100644 --- a/libs/wire-api/src/Wire/API/Routes/Internal/Brig.hs +++ b/libs/wire-api/src/Wire/API/Routes/Internal/Brig.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE TemplateHaskell #-} + -- This file is part of the Wire Server implementation. -- -- Copyright (C) 2022 Wire Swiss GmbH @@ -43,10 +45,12 @@ module Wire.API.Routes.Internal.Brig module Wire.API.Routes.Internal.Brig.EJPD, FoundInvitationCode (..), EnterpriseLoginApi, + SAMLIdPAPI, + IdpChangedNotification (..), ) where -import Control.Lens ((.~), (?~)) +import Control.Lens (makePrisms, (.~), (?~), _1) import Data.Aeson (FromJSON, ToJSON, Value (Null)) import Data.Code qualified as Code import Data.CommaSeparatedList @@ -96,6 +100,8 @@ import Wire.API.User.Auth.LegalHold import Wire.API.User.Auth.ReAuth import Wire.API.User.Auth.Sso import Wire.API.User.Client +import Wire.API.User.IdentityProvider +import Wire.API.User.Orphans () import Wire.API.User.RichInfo import Wire.API.UserGroup import Wire.API.UserGroup.Pagination @@ -713,6 +719,18 @@ type API = :<|> FederationRemotesAPI :<|> ProviderAPI :<|> EnterpriseLoginApi + :<|> SAMLIdPAPI + ) + +type SAMLIdPAPI = + "idp" + :> ( Named + "send-idp-changed-email" + ( Summary "Send an email about IdP creation, deletion or update to all team admins and owners" + :> "send-idp-changed-email" + :> ReqBody '[Servant.JSON] IdpChangedNotification + :> Post '[Servant.JSON] () + ) ) type IStatusAPI = @@ -985,6 +1003,73 @@ instance S.ToSchema GetRichInfoMultiResponse where S.NamedSchema (Just $ "GetRichInfoMultiResponse") $ mempty & S.description ?~ "List of pairs of UserId and RichInfo" +data IdpChangedNotificationTag = IdPCreatedTag | IdPDeletedTag | IdPUpdatedTag + deriving (Eq, Enum, Bounded) + +data IdpChangedNotification = IdPCreated (Maybe UserId) IdP | IdPDeleted UserId IdP | IdPUpdated UserId IdP IdP + deriving (Eq, Show, Generic) + +makePrisms ''IdpChangedNotification + +instance Data.Schema.ToSchema IdpChangedNotification where + schema = + object "IdpChangedNotification" $ + fromTagged + <$> toTagged + .= bind + (fst .= field "tag" tagSchema) + (snd .= fieldOver _1 "value" untaggedSchema) + where + toTagged :: IdpChangedNotification -> (IdpChangedNotificationTag, IdpChangedNotification) + toTagged d@(IdPCreated {}) = (IdPCreatedTag, d) + toTagged d@(IdPDeleted {}) = (IdPDeletedTag, d) + toTagged d@(IdPUpdated {}) = (IdPUpdatedTag, d) + + fromTagged :: (IdpChangedNotificationTag, IdpChangedNotification) -> IdpChangedNotification + fromTagged = snd + + untaggedSchema = dispatch $ \case + IdPCreatedTag -> tag _IdPCreated (Data.Schema.unnamed createdSchema) + IdPDeletedTag -> tag _IdPDeleted (Data.Schema.unnamed deletedSchema) + IdPUpdatedTag -> tag _IdPUpdated (Data.Schema.unnamed updatedSchema) + + tagSchema :: ValueSchema NamedSwaggerDoc IdpChangedNotificationTag + tagSchema = + enum @Text "Detail Tag" $ + mconcat [element "created" IdPCreatedTag, element "deleted" IdPDeletedTag, element "updated" IdPUpdatedTag] + + createdSchema :: ValueSchema NamedSwaggerDoc (Maybe UserId, IdP) + createdSchema = + object "IdPCreated" $ + (,) + <$> fst .= maybe_ (optField "user" schema) + <*> snd .= field "idp" schema + + deletedSchema :: ValueSchema NamedSwaggerDoc (UserId, IdP) + deletedSchema = + object "IdPDeleted" $ + (,) + <$> fst .= field "user" schema + <*> snd .= field "idp" schema + + updatedSchema :: ValueSchema NamedSwaggerDoc (UserId, IdP, IdP) + updatedSchema = + object "IdPUpdated" $ + (,,) + <$> fst3 .= field "user" schema + <*> snd3 .= field "old" schema + <*> thd3 .= field "new" schema + + fst3 (a, _, _) = a + snd3 (_, b, _) = b + thd3 (_, _, c) = c + +deriving via (Schema IdpChangedNotification) instance FromJSON IdpChangedNotification + +deriving via (Schema IdpChangedNotification) instance ToJSON IdpChangedNotification + +deriving via (Schema IdpChangedNotification) instance S.ToSchema IdpChangedNotification + swaggerDoc :: OpenApi swaggerDoc = brigSwaggerDoc diff --git a/libs/wire-api/src/Wire/API/User/IdentityProvider.hs b/libs/wire-api/src/Wire/API/User/IdentityProvider.hs index 441d5dc1a3b..c65d4b66eeb 100644 --- a/libs/wire-api/src/Wire/API/User/IdentityProvider.hs +++ b/libs/wire-api/src/Wire/API/User/IdentityProvider.hs @@ -50,6 +50,7 @@ import Data.HashMap.Strict.InsOrd qualified as InsOrdHashMap import Data.Id (TeamId) import Data.OpenApi import Data.Proxy (Proxy (Proxy)) +import Data.Schema qualified as Schema import Data.Text.Encoding import Data.Text.Encoding.Error import Data.Text.Lazy qualified as LT @@ -58,10 +59,8 @@ import Network.HTTP.Media ((//)) import SAML2.WebSSO (IdPConfig) import SAML2.WebSSO qualified as SAML import SAML2.WebSSO.Test.Arbitrary () -import SAML2.WebSSO.Types.TH (deriveJSONOptions) import Servant.API as Servant hiding (MkLink, URI (..)) import Wire.API.Routes.Public (ZHostValue) -import Wire.API.User.Orphans (samlSchemaOptions) import Wire.API.Util.Aeson (defaultOptsDropChar) import Wire.Arbitrary (Arbitrary, GenericUniform (GenericUniform)) @@ -70,7 +69,7 @@ type IdP = IdPConfig WireIdP -- | Unique human-readable IdP name. newtype IdPHandle = IdPHandle {unIdPHandle :: Text} - deriving (Eq, Ord, Show, FromJSON, ToJSON, ToSchema, Arbitrary, Generic) + deriving (Eq, Ord, Show, FromJSON, ToJSON, ToSchema, Schema.ToSchema, Arbitrary, Generic) data WireIdP = WireIdP { _team :: TeamId, @@ -89,6 +88,19 @@ data WireIdP = WireIdP deriving (Eq, Show, Generic) deriving (Arbitrary) via (GenericUniform WireIdP) +instance Schema.ToSchema WireIdP where + schema = + Schema.object + "WireIdP" + ( WireIdP + <$> _team Schema..= Schema.field "team" Schema.schema + <*> _apiVersion Schema..= Schema.maybe_ (Schema.optField "apiVersion" Schema.schema) + <*> _oldIssuers Schema..= Schema.field "oldIssuers" (Schema.array Schema.schema) + <*> _replacedBy Schema..= Schema.maybe_ (Schema.optField "replacedBy" Schema.schema) + <*> _handle Schema..= Schema.field "handle" Schema.schema + <*> _domain Schema..= Schema.maybe_ (Schema.optField "domain" Schema.schema) + ) + data WireIdPAPIVersion = -- | initial API WireIdPAPIV1 @@ -96,6 +108,15 @@ data WireIdPAPIVersion WireIdPAPIV2 deriving stock (Eq, Show, Enum, Bounded, Generic) deriving (Arbitrary) via (GenericUniform WireIdPAPIVersion) + deriving (FromJSON, ToJSON, ToSchema) via (Schema.Schema WireIdPAPIVersion) + +instance Schema.ToSchema WireIdPAPIVersion where + schema = + Schema.enum @Text "WireIdPAPIVersion" $ + mconcat + [ Schema.element "v1" WireIdPAPIV1, + Schema.element "v2" WireIdPAPIV2 + ] -- | (Internal issue for making v2 the default: -- https://wearezeta.atlassian.net/browse/SQSERVICES-781. BEWARE: We probably shouldn't ever @@ -106,8 +127,6 @@ defWireIdPAPIVersion = WireIdPAPIV1 makeLenses ''WireIdP -deriveJSON deriveJSONOptions ''WireIdPAPIVersion - -- Changing the encoder since we've dropped the field prefixes deriveJSON (defaultOptsDropChar '_') ''WireIdP @@ -211,9 +230,6 @@ idPMetadataToInfo = instance ToSchema IdPList where declareNamedSchema = genericDeclareNamedSchema $ fromAesonOptions $ defaultOptsDropChar '_' -instance ToSchema WireIdPAPIVersion where - declareNamedSchema = genericDeclareNamedSchema samlSchemaOptions - instance ToSchema WireIdP where -- We don't want to use `samlSchemaOptions`, as it pulls from saml2-web-sso json options which -- as a `dropWhile not . isUpper` modifier. All we need is to drop the underscore prefix and diff --git a/libs/wire-api/src/Wire/API/User/Orphans.hs b/libs/wire-api/src/Wire/API/User/Orphans.hs index 794d4d36437..c3d44c7084e 100644 --- a/libs/wire-api/src/Wire/API/User/Orphans.hs +++ b/libs/wire-api/src/Wire/API/User/Orphans.hs @@ -118,15 +118,6 @@ instance O.ToSchema Void where instance (HasOpenApi route) => HasOpenApi (SM.MultipartForm SM.Mem resp :> route) where toOpenApi _proxy = toOpenApi (Proxy @route) -instance O.ToSchema SAML.IdPId where - declareNamedSchema _ = declareNamedSchema (Proxy @UUID) - -instance (O.ToSchema a) => O.ToSchema (SAML.IdPConfig a) where - declareNamedSchema = genericDeclareNamedSchema samlSchemaOptions - -instance O.ToSchema SAML.Issuer where - declareNamedSchema _ = declareNamedSchema (Proxy @String) - instance O.ToSchema URI where declareNamedSchema _ = declareNamedSchema (Proxy @String) @@ -136,9 +127,6 @@ instance O.ToParamSchema URI where instance O.ToSchema X509.SignedCertificate where declareNamedSchema _ = declareNamedSchema (Proxy @String) -instance O.ToSchema SAML.IdPMetadata where - declareNamedSchema = genericDeclareNamedSchema samlSchemaOptions - instance S.ToSchema Currency.Alpha where schema = S.enum @Text "Currency.Alpha" cases & S.doc' . O.schema %~ swaggerTweaks where diff --git a/libs/wire-subsystems/default.nix b/libs/wire-subsystems/default.nix index cf381ee0da6..12d832b4fce 100644 --- a/libs/wire-subsystems/default.nix +++ b/libs/wire-subsystems/default.nix @@ -28,6 +28,8 @@ , contravariant , cql , crypton +, crypton-x509 +, crypton-x509-store , currency-codes , data-default , data-timeout @@ -37,6 +39,7 @@ , extended , extra , file-embed +, filepath , galley-types , generics-sop , gitignoreSource @@ -156,6 +159,7 @@ mkDerivation { contravariant cql crypton + crypton-x509 currency-codes data-default data-timeout @@ -272,6 +276,8 @@ mkDerivation { contravariant cql crypton + crypton-x509 + crypton-x509-store currency-codes data-default data-timeout @@ -281,6 +287,7 @@ mkDerivation { extended extra file-embed + filepath galley-types generics-sop hashable diff --git a/libs/wire-subsystems/src/Wire/EmailSubsystem.hs b/libs/wire-subsystems/src/Wire/EmailSubsystem.hs index fa9f1bc7653..8a4c2221c92 100644 --- a/libs/wire-subsystems/src/Wire/EmailSubsystem.hs +++ b/libs/wire-subsystems/src/Wire/EmailSubsystem.hs @@ -21,8 +21,11 @@ module Wire.EmailSubsystem where import Data.Code qualified as Code import Data.Id +import Data.X509.Extended (CertDescription) import Imports import Polysemy +import SAML2.WebSSO +import URI.ByteString (URI) import Wire.API.Locale import Wire.API.User import Wire.API.User.Activation (ActivationCode, ActivationKey) @@ -45,5 +48,6 @@ data EmailSubsystem m a where SendTeamInvitationMailPersonalUser :: EmailAddress -> TeamId -> EmailAddress -> InvitationCode -> Maybe Locale -> EmailSubsystem m Text SendMemberWelcomeEmail :: EmailAddress -> TeamId -> Text -> Maybe Locale -> EmailSubsystem m () SendNewTeamOwnerWelcomeEmail :: EmailAddress -> TeamId -> Text -> Maybe Locale -> Name -> EmailSubsystem m () + SendSAMLIdPChanged :: EmailAddress -> TeamId -> Maybe UserId -> [CertDescription] -> [CertDescription] -> IdPId -> Issuer -> URI -> Maybe Locale -> EmailSubsystem m () makeSem ''EmailSubsystem diff --git a/libs/wire-subsystems/src/Wire/EmailSubsystem/Interpreter.hs b/libs/wire-subsystems/src/Wire/EmailSubsystem/Interpreter.hs index 3225190c16a..2d0161d6d5a 100644 --- a/libs/wire-subsystems/src/Wire/EmailSubsystem/Interpreter.hs +++ b/libs/wire-subsystems/src/Wire/EmailSubsystem/Interpreter.hs @@ -24,15 +24,22 @@ import Data.Id import Data.Json.Util import Data.Map as Map import Data.Range (fromRange) +import Data.Text qualified as T import Data.Text qualified as Text import Data.Text.Ascii qualified as Ascii +import Data.Text.Encoding qualified as T import Data.Text.Lazy (toStrict) +import Data.Text.Lazy qualified as TL import Data.Text.Template +import Data.UUID (toText) +import Data.X509.Extended import Imports import Network.Mail.Mime import Polysemy import Polysemy.Output (Output) import Polysemy.TinyLog (TinyLog) +import SAML2.WebSSO +import URI.ByteString (URI, serializeURIRef') import Wire.API.Locale import Wire.API.User import Wire.API.User.Activation @@ -67,6 +74,8 @@ emailSubsystemInterpreter userTpls teamTpls branding = interpret \case SendTeamInvitationMailPersonalUser email tid from code loc -> sendTeamInvitationMailPersonalUserImpl teamTpls branding email tid from code loc SendMemberWelcomeEmail email tid teamName loc -> sendMemberWelcomeEmailImpl teamTpls branding email tid teamName loc SendNewTeamOwnerWelcomeEmail email tid teamName loc name -> sendNewTeamOwnerWelcomeEmailImpl teamTpls branding email tid teamName loc name + SendSAMLIdPChanged email tid mbUid addedCerts removedCerts idPId iss requestUri mLocale -> + sendSAMLIdPChangedImpl teamTpls branding email tid mbUid addedCerts removedCerts idPId iss requestUri mLocale ------------------------------------------------------------------------------- -- Verification Email for @@ -587,6 +596,95 @@ renderNewTeamOwnerWelcomeEmail emailTo tid teamName profileName NewTeamOwnerWelc from = Address (Just newTeamOwnerWelcomeEmailSenderName) (fromEmail newTeamOwnerWelcomeEmailSender) to = Address Nothing (fromEmail emailTo) +------------------------------------------------------------------------------- +-- IdP change email for team admins and owners + +sendSAMLIdPChangedImpl :: + (Member EmailSending r, Member TinyLog r) => + Localised TeamTemplates -> + Map Text Text -> + EmailAddress -> + TeamId -> + Maybe UserId -> + [CertDescription] -> + [CertDescription] -> + IdPId -> + Issuer -> + URI -> + Maybe Locale -> + Sem r () +sendSAMLIdPChangedImpl teamTemplates branding to tid mbUid addedCerts removedCerts idPId issuer endpoint mLocale = do + let tpl = idpConfigChangeEmail . snd $ forLocale mLocale teamTemplates + mail <- + logEmailRenderErrors "idp config change email" $ + renderIdPConfigChangeEmail to tpl branding addedCerts removedCerts tid mbUid idPId issuer endpoint + sendMail mail + +renderIdPConfigChangeEmail :: + (Member (Output Text) r) => + EmailAddress -> + IdPConfigChangeEmailTemplate -> + Map Text Text -> + [CertDescription] -> + [CertDescription] -> + TeamId -> + Maybe UserId -> + IdPId -> + Issuer -> + URI -> + Sem r Mail +renderIdPConfigChangeEmail email IdPConfigChangeEmailTemplate {..} branding addedCerts removedCerts tid uid idPId issuer endpoint = do + idpDetailsAddedText :: Text <- + (TL.toStrict . TL.unlines) + <$> mapM (renderTextWithBrandingSem idpConfigChangeEmailIdPDetailsAddedText . idpDetailsToMap) addedCerts + idpDetailsAddedHtml :: Text <- + (TL.toStrict . TL.unlines) + <$> mapM (renderTextWithBrandingSem idpConfigChangeEmailIdPDetailsAddedHtml . idpDetailsToMap) addedCerts + idpDetailsRemovedText :: Text <- + (TL.toStrict . TL.unlines) + <$> mapM (renderTextWithBrandingSem idpConfigChangeEmailIdPDetailsRemovedText . idpDetailsToMap) removedCerts + idpDetailsRemovedHtml :: Text <- + (TL.toStrict . TL.unlines) + <$> mapM (renderTextWithBrandingSem idpConfigChangeEmailIdPDetailsRemovedHtml . idpDetailsToMap) removedCerts + + let replace = + branding + & Map.insert "team_id" ((toText . toUUID) tid) + & Map.insert "user_id" (maybe "None" (toText . toUUID) uid) + & Map.insert "idp_issuer" ((T.decodeUtf8 . serializeURIRef' . _fromIssuer) issuer) + & Map.insert "idp_endpoint" ((T.decodeUtf8 . serializeURIRef') endpoint) + & Map.insert "idp_id" ((toText . fromIdPId) idPId) + replaceHtml = + replace + & Map.insert "certificates_details" ((T.unlines . Imports.filter (not . T.null)) [idpDetailsAddedHtml, idpDetailsRemovedHtml]) + replaceText = + replace + & Map.insert "certificates_details" ((T.unlines . Imports.filter (not . T.null)) [idpDetailsAddedText, idpDetailsRemovedText]) + + txt <- renderTextWithBrandingSem idpConfigChangeEmailBodyText replaceText + html <- renderHtmlWithBrandingSem idpConfigChangeEmailBodyHtml replaceHtml + subj <- renderTextWithBrandingSem idpConfigChangeEmailSubject replace + pure + (emptyMail from) + { mailTo = [to], + mailHeaders = + [ ("Subject", toStrict subj), + ("X-Zeta-Purpose", "IdPConfigChange") + ], + mailParts = [[plainPart txt, htmlPart html]] + } + where + from = Address (Just idpConfigChangeEmailSenderName) (fromEmail idpConfigChangeEmailSender) + to = Address Nothing (fromEmail email) + + idpDetailsToMap :: CertDescription -> Map Text Text + idpDetailsToMap d = + empty @Text @Text + & Map.insert "algorithm" (T.pack d.fingerprintAlgorithm) + & Map.insert "fingerprint" (T.pack d.fingerprint) + & Map.insert "subject" (T.pack d.subject) + & Map.insert "issuer" (T.pack d.issuer) + ------------------------------------------------------------------------------- -- MIME Conversions diff --git a/libs/wire-subsystems/src/Wire/EmailSubsystem/Template.hs b/libs/wire-subsystems/src/Wire/EmailSubsystem/Template.hs index cfdecce899a..5e9e8059987 100644 --- a/libs/wire-subsystems/src/Wire/EmailSubsystem/Template.hs +++ b/libs/wire-subsystems/src/Wire/EmailSubsystem/Template.hs @@ -19,18 +19,25 @@ module Wire.EmailSubsystem.Template where +import Control.Exception +import Data.Aeson (FromJSON) +import Data.ByteString qualified as BS import Data.Map qualified as Map +import Data.Text (pack, unpack) import Data.Text.Encoding qualified as T import Data.Text.Lazy qualified as Lazy import Data.Text.Template import HTMLEntities.Text qualified as HTML -import Imports +import Imports hiding (readFile) import Polysemy import Polysemy.Output import Polysemy.TinyLog (TinyLog) import Polysemy.TinyLog qualified as Log +import System.IO.Error (isDoesNotExistError) import System.Logger (field, msg, val) import Wire.API.Locale +import Wire.API.User.EmailAddress (EmailAddress) +import Wire.EmailSubsystem.Templates.Team -- | Lookup a localised item from a 'Localised' structure. forLocale :: @@ -97,3 +104,151 @@ logEmailRenderErrors tplName = . field "template_name" (val (T.encodeUtf8 tplName)) . field "unreplaced_variable" (val (T.encodeUtf8 warn)) ) + +readLocalesDir :: + -- | Default locale. + Locale -> + -- | Base directory. + FilePath -> + -- | Template directory (user, provider, team) + FilePath -> + -- | Handler to load the templates for a locale. + (FilePath -> IO a) -> + IO (Localised a) +readLocalesDir defLocale base typ load = do + def <- load (basePath defLocaleDir) + Localised (defLocale, def) <$> do + -- Ignore locales if no such directory exist for the locale + ls <- + filterM (doesDirectoryExist . basePath) + . filter (/= defLocaleDir) + =<< listDirectory base + Map.fromList . zip (map readLocale ls) <$> mapM (load . basePath) ls + where + basePath :: FilePath -> FilePath + basePath loc = base <> "/" <> loc <> "/" <> typ + defLocaleDir :: FilePath + defLocaleDir = unpack (locToText defLocale) + readLocale :: FilePath -> Locale + readLocale l = + fromMaybe (error ("Invalid locale: " ++ show l)) $ + parseLocale (pack l) + +readTemplateWithDefault :: + FilePath -> + Locale -> + FilePath -> + String -> + FilePath -> + IO Template +readTemplateWithDefault = readWithDefault readTemplate + +readTemplate :: FilePath -> IO Template +readTemplate f = template <$> readText f + +readFile :: FilePath -> IO Text +readFile f = T.decodeUtf8 <$> BS.readFile f + +readTextWithDefault :: + FilePath -> + Locale -> + FilePath -> + String -> + FilePath -> + IO Text +readTextWithDefault = readWithDefault readText + +readText :: FilePath -> IO Text +readText f = + catchJust + (\e -> if isDoesNotExistError e then Just () else Nothing) + (readFile f) + (\_ -> error $ "Missing file: '" ++ f) + +readWithDefault :: + (String -> IO a) -> + FilePath -> + Locale -> + FilePath -> + String -> + FilePath -> + IO a +readWithDefault readFn baseDir defLoc typ prefix name = do + exists <- doesFileExist fileToLoad + if exists + then readFn fileToLoad + else readFn fallback + where + fileToLoad = prefix <> "/" <> name + fallback = + baseDir + <> "/" + <> unpack (locToText defLoc) + <> "/" + <> typ + <> "/" + <> name + +data TeamOpts = TeamOpts + { -- | Team Invitation URL template + tInvitationUrl :: !Text, + -- | Existing User Invitation URL template + tExistingUserInvitationUrl :: !Text, + -- | Team Activation URL template + tActivationUrl :: !Text, + -- | Team Creator Welcome URL + tCreatorWelcomeUrl :: !Text, + -- | Team Member Welcome URL + tMemberWelcomeUrl :: !Text + } + deriving (Show, Generic) + +instance FromJSON TeamOpts + +loadTeamTemplates :: TeamOpts -> FilePath -> Locale -> EmailAddress -> IO (Localised TeamTemplates) +loadTeamTemplates tOptions templatesDir defLocale sender = readLocalesDir defLocale templatesDir "team" $ \fp -> + TeamTemplates + <$> ( InvitationEmailTemplate tUrl + <$> readTemplate fp "email/invitation-subject.txt" + <*> readTemplate fp "email/invitation.txt" + <*> readTemplate fp "email/invitation.html" + <*> pure sender + <*> readText fp "email/sender.txt" + ) + <*> ( InvitationEmailTemplate tExistingUrl + <$> readTemplate fp "email/migration-subject.txt" + <*> readTemplate fp "email/migration.txt" + <*> readTemplate fp "email/migration.html" + <*> pure sender + <*> readText fp "email/sender.txt" + ) + <*> ( MemberWelcomeEmailTemplate (tMemberWelcomeUrl tOptions) + <$> readTemplate fp "email/new-member-welcome-subject.txt" + <*> readTemplate fp "email/new-member-welcome.txt" + <*> readTemplate fp "email/new-member-welcome.html" + <*> pure sender + <*> readText fp "email/sender.txt" + ) + <*> ( NewTeamOwnerWelcomeEmailTemplate (tCreatorWelcomeUrl tOptions) + <$> readTemplate fp "email/new-team-owner-welcome-subject.txt" + <*> readTemplate fp "email/new-team-owner-welcome.txt" + <*> readTemplate fp "email/new-team-owner-welcome.html" + <*> pure sender + <*> readText fp "email/sender.txt" + ) + <*> ( IdPConfigChangeEmailTemplate + <$> readTemplate fp "../partials/idp-certificate-added.html" + <*> readTemplate fp "../partials/idp-certificate-added.txt" + <*> readTemplate fp "../partials/idp-certificate-removed.html" + <*> readTemplate fp "../partials/idp-certificate-removed.txt" + <*> readTemplate fp "email/idp-config-change-subject.txt" + <*> readTemplate fp "email/idp-config-change.txt" + <*> readTemplate fp "email/idp-config-change.html" + <*> pure sender + <*> readText fp "email/sender.txt" + ) + where + tUrl = template tOptions.tInvitationUrl + tExistingUrl = template tOptions.tExistingUserInvitationUrl + readTemplate = readTemplateWithDefault templatesDir defLocale "team" + readText = readTextWithDefault templatesDir defLocale "team" diff --git a/libs/wire-subsystems/src/Wire/EmailSubsystem/Templates/Team.hs b/libs/wire-subsystems/src/Wire/EmailSubsystem/Templates/Team.hs index 76187fe56de..996b30729cd 100644 --- a/libs/wire-subsystems/src/Wire/EmailSubsystem/Templates/Team.hs +++ b/libs/wire-subsystems/src/Wire/EmailSubsystem/Templates/Team.hs @@ -50,9 +50,22 @@ data NewTeamOwnerWelcomeEmailTemplate = NewTeamOwnerWelcomeEmailTemplate newTeamOwnerWelcomeEmailSenderName :: !Text } +data IdPConfigChangeEmailTemplate = IdPConfigChangeEmailTemplate + { idpConfigChangeEmailIdPDetailsAddedHtml :: !Template, + idpConfigChangeEmailIdPDetailsAddedText :: !Template, + idpConfigChangeEmailIdPDetailsRemovedHtml :: !Template, + idpConfigChangeEmailIdPDetailsRemovedText :: !Template, + idpConfigChangeEmailSubject :: !Template, + idpConfigChangeEmailBodyText :: !Template, + idpConfigChangeEmailBodyHtml :: !Template, + idpConfigChangeEmailSender :: !EmailAddress, + idpConfigChangeEmailSenderName :: !Text + } + data TeamTemplates = TeamTemplates { invitationEmail :: !InvitationEmailTemplate, existingUserInvitationEmail :: !InvitationEmailTemplate, memberWelcomeEmail :: !MemberWelcomeEmailTemplate, - newTeamOwnerWelcomeEmail :: !NewTeamOwnerWelcomeEmailTemplate + newTeamOwnerWelcomeEmail :: !NewTeamOwnerWelcomeEmailTemplate, + idpConfigChangeEmail :: !IdPConfigChangeEmailTemplate } diff --git a/libs/wire-subsystems/src/Wire/SAMLEmailSubsystem.hs b/libs/wire-subsystems/src/Wire/SAMLEmailSubsystem.hs new file mode 100644 index 00000000000..7204b12ccfa --- /dev/null +++ b/libs/wire-subsystems/src/Wire/SAMLEmailSubsystem.hs @@ -0,0 +1,11 @@ +{-# LANGUAGE TemplateHaskell #-} + +module Wire.SAMLEmailSubsystem where + +import Polysemy +import Wire.API.Routes.Internal.Brig (IdpChangedNotification) + +data SAMLEmailSubsystem m a where + SendSAMLIdPChanged :: IdpChangedNotification -> SAMLEmailSubsystem m () + +makeSem ''SAMLEmailSubsystem diff --git a/libs/wire-subsystems/src/Wire/SAMLEmailSubsystem/Interpreter.hs b/libs/wire-subsystems/src/Wire/SAMLEmailSubsystem/Interpreter.hs new file mode 100644 index 00000000000..f858ba63552 --- /dev/null +++ b/libs/wire-subsystems/src/Wire/SAMLEmailSubsystem/Interpreter.hs @@ -0,0 +1,98 @@ +module Wire.SAMLEmailSubsystem.Interpreter + ( samlEmailSubsystemInterpreter, + ) +where + +import Control.Lens ((^.), (^..)) +import Data.Id (UserId) +import Data.List.NonEmpty qualified as NE +import Data.X509 qualified as X509 +import Data.X509.Extended (certDescription) +import Imports +import Polysemy +import SAML2.WebSSO.Types +import Text.Email.Parser +import Wire.API.Locale +import Wire.API.Routes.Internal.Brig +import Wire.API.Team.Member +import Wire.API.User.IdentityProvider +import Wire.EmailSubsystem qualified as Email +import Wire.SAMLEmailSubsystem +import Wire.StoredUser +import Wire.TeamSubsystem +import Wire.UserStore + +samlEmailSubsystemInterpreter :: + ( Member TeamSubsystem r, + Member UserStore r, + Member Email.EmailSubsystem r + ) => + InterpreterFor SAMLEmailSubsystem r +samlEmailSubsystemInterpreter = interpret \case + SendSAMLIdPChanged idp -> sendSAMLIdPChangedImpl idp + +type Receiver = (EmailAddress, Maybe Locale) + +sendSAMLIdPChangedImpl :: + ( Member TeamSubsystem r, + Member UserStore r, + Member Email.EmailSubsystem r + ) => + IdpChangedNotification -> + Sem r () +sendSAMLIdPChangedImpl notif = do + receivers <- getReceivers origIdP + mapM_ delegate receivers + where + delegate :: (Member Email.EmailSubsystem r) => Receiver -> Sem r () + delegate (email, loc) = do + let endpoint = origIdP._idpMetadata._edRequestURI + iss = origIdP._idpMetadata._edIssuer + idPId = origIdP._idpId + tid = origIdP ^. idpExtraInfo . team + (addedCerts, removedCerts) = bimap (certDescription <$>) (certDescription <$>) certsChanges + Email.sendSAMLIdPChanged email tid mbUserId addedCerts removedCerts idPId iss endpoint loc + + origIdP :: IdP + origIdP = case notif of + IdPCreated _userId idp -> idp + IdPDeleted _userId idp -> idp + IdPUpdated _userId old _new -> old + + mbUserId :: Maybe UserId + mbUserId = case notif of + IdPCreated nofifUid _idp -> nofifUid + IdPDeleted nofifUid _idp -> Just nofifUid + IdPUpdated nofifUid _old _new -> Just nofifUid + + certsChanges :: ([X509.SignedCertificate], [X509.SignedCertificate]) + certsChanges = case notif of + IdPCreated _uid idp -> (toList idp._idpMetadata._edCertAuthnResponse, []) + IdPDeleted _uid idp -> ([], toList idp._idpMetadata._edCertAuthnResponse) + IdPUpdated _uid old new -> + bimap toList toList $ + compareNonEmpty new._idpMetadata._edCertAuthnResponse old._idpMetadata._edCertAuthnResponse + + compareNonEmpty :: (Eq a) => NE.NonEmpty a -> NE.NonEmpty a -> ([a], [a]) + compareNonEmpty xs ys = + let l = nub . toList $ xs + r = nub . toList $ ys + onlyL = l \\ r + onlyR = r \\ l + in (onlyL, onlyR) + +getReceivers :: + ( Member TeamSubsystem r, + Member UserStore r + ) => + IdP -> + Sem r [Receiver] +getReceivers idp = do + admins <- internalGetTeamAdmins idp._idpExtraInfo._team + let adminUids = admins ^.. teamMembers . traverse . userId + catMaybes <$> (toReceiver <$$> getUsers adminUids) + where + toReceiver :: StoredUser -> Maybe Receiver + toReceiver u = + let loc = flip Locale u.country <$> u.language + in (,loc) <$> (u.email) diff --git a/libs/wire-subsystems/templates/de/partials/idp-certificate-added.html b/libs/wire-subsystems/templates/de/partials/idp-certificate-added.html new file mode 100644 index 00000000000..aa8f5ee9c84 --- /dev/null +++ b/libs/wire-subsystems/templates/de/partials/idp-certificate-added.html @@ -0,0 +1 @@ +

Hinzugefügt:

${algorithm} Fingerabdruck:
${fingerprint}

Betreff:
${subject}

Aussteller:
${issuer}

 \ No newline at end of file diff --git a/libs/wire-subsystems/templates/de/partials/idp-certificate-added.txt b/libs/wire-subsystems/templates/de/partials/idp-certificate-added.txt new file mode 100644 index 00000000000..341ae1d59ae --- /dev/null +++ b/libs/wire-subsystems/templates/de/partials/idp-certificate-added.txt @@ -0,0 +1,13 @@ +Hinzugefügt: + +${algorithm} Fingerabdruck: +${fingerprint} + +Betreff: +${subject} + +Aussteller: +${issuer} + + +-------------------------------------------------------------------------------- \ No newline at end of file diff --git a/libs/wire-subsystems/templates/de/partials/idp-certificate-removed.html b/libs/wire-subsystems/templates/de/partials/idp-certificate-removed.html new file mode 100644 index 00000000000..f7e5c964d42 --- /dev/null +++ b/libs/wire-subsystems/templates/de/partials/idp-certificate-removed.html @@ -0,0 +1 @@ +

Entfernt:

${algorithm} Fingerabdruck:
${fingerprint}

Betreff:
${subject}

Aussteller:
${issuer}

 \ No newline at end of file diff --git a/libs/wire-subsystems/templates/de/partials/idp-certificate-removed.txt b/libs/wire-subsystems/templates/de/partials/idp-certificate-removed.txt new file mode 100644 index 00000000000..5469a02b7c1 --- /dev/null +++ b/libs/wire-subsystems/templates/de/partials/idp-certificate-removed.txt @@ -0,0 +1,13 @@ +Entfernt: + +${algorithm} Fingerabdruck: +${fingerprint} + +Betreff: +${subject} + +Aussteller: +${issuer} + + +-------------------------------------------------------------------------------- \ No newline at end of file diff --git a/libs/wire-subsystems/templates/de/team/email/idp-config-change-subject.txt b/libs/wire-subsystems/templates/de/team/email/idp-config-change-subject.txt new file mode 100644 index 00000000000..dff03eba7d3 --- /dev/null +++ b/libs/wire-subsystems/templates/de/team/email/idp-config-change-subject.txt @@ -0,0 +1 @@ +Die Konfiguration des Identity Providers Ihres Teams hat sich geändert \ No newline at end of file diff --git a/libs/wire-subsystems/templates/de/team/email/idp-config-change.html b/libs/wire-subsystems/templates/de/team/email/idp-config-change.html new file mode 100644 index 00000000000..1f2fd3078c5 --- /dev/null +++ b/libs/wire-subsystems/templates/de/team/email/idp-config-change.html @@ -0,0 +1 @@ +Die Konfiguration des Identity Providers Ihres Teams hat sich geändert

${brand_label_url}

Änderung in der Konfiguration Ihres Identity Providers

Etwas hat sich in der IdP-Konfiguration für Ihr Team geändert.

Team-ID:
${team_id}

Benutzer-ID:
${user_id}

Details:

IdP-Aussteller:
${idp_issuer}

IdP-Endpunkt:
${idp_endpoint}

IdP-ID:
${idp_id}

${certificates_details}

Wenn Sie diese Änderung nicht veranlasst haben, wenden Sie sich bitte an den Wire Support.

 

Datenschutzerklärung und Nutzungsbedingungen · Missbrauch melden
${copyright}. Alle Rechte vorbehalten.

                                                           
\ No newline at end of file diff --git a/libs/wire-subsystems/templates/de/team/email/idp-config-change.txt b/libs/wire-subsystems/templates/de/team/email/idp-config-change.txt new file mode 100644 index 00000000000..3c2707fab92 --- /dev/null +++ b/libs/wire-subsystems/templates/de/team/email/idp-config-change.txt @@ -0,0 +1,36 @@ +[${brand_logo}] + +${brand_label_url} [${brand_url}] + +ÄNDERUNG IN DER KONFIGURATION IHRES IDENTITY PROVIDERS +Etwas hat sich in der IdP-Konfiguration für Ihr Team geändert. + +Team-ID: +${team_id} + +Benutzer-ID: +${user_id} + + +-------------------------------------------------------------------------------- + +Details: + +IdP-Aussteller: +${idp_issuer} + +IdP-Endpunkt: +${idp_endpoint} + +IdP-ID: +${idp_id} + + +-------------------------------------------------------------------------------- + +${certificates_details}Wenn Sie diese Änderung nicht veranlasst haben, wenden Sie sich bitte an den +Wire Support. [${support}] + +Datenschutzerklärung und Nutzungsbedingungen [${legal}]· Missbrauch melden +[${misuse}] +${copyright}. Alle Rechte vorbehalten. \ No newline at end of file diff --git a/libs/wire-subsystems/templates/en/partials/idp-certificate-added.html b/libs/wire-subsystems/templates/en/partials/idp-certificate-added.html new file mode 100644 index 00000000000..59b8f33a020 --- /dev/null +++ b/libs/wire-subsystems/templates/en/partials/idp-certificate-added.html @@ -0,0 +1 @@ +

Added:

${algorithm} fingerprint:
${fingerprint}

Subject:
${subject}

Issuer:
${issuer}

 \ No newline at end of file diff --git a/libs/wire-subsystems/templates/en/partials/idp-certificate-added.txt b/libs/wire-subsystems/templates/en/partials/idp-certificate-added.txt new file mode 100644 index 00000000000..cf8d585f9dc --- /dev/null +++ b/libs/wire-subsystems/templates/en/partials/idp-certificate-added.txt @@ -0,0 +1,13 @@ +Added: + +${algorithm} fingerprint: +${fingerprint} + +Subject: +${subject} + +Issuer: +${issuer} + + +-------------------------------------------------------------------------------- \ No newline at end of file diff --git a/libs/wire-subsystems/templates/en/partials/idp-certificate-removed.html b/libs/wire-subsystems/templates/en/partials/idp-certificate-removed.html new file mode 100644 index 00000000000..7a952614d29 --- /dev/null +++ b/libs/wire-subsystems/templates/en/partials/idp-certificate-removed.html @@ -0,0 +1 @@ +

Removed:

${algorithm} fingerprint:
${fingerprint}

Subject:
${subject}

Issuer:
${issuer}

 \ No newline at end of file diff --git a/libs/wire-subsystems/templates/en/partials/idp-certificate-removed.txt b/libs/wire-subsystems/templates/en/partials/idp-certificate-removed.txt new file mode 100644 index 00000000000..4a092a0381f --- /dev/null +++ b/libs/wire-subsystems/templates/en/partials/idp-certificate-removed.txt @@ -0,0 +1,13 @@ +Removed: + +${algorithm} fingerprint: +${fingerprint} + +Subject: +${subject} + +Issuer: +${issuer} + + +-------------------------------------------------------------------------------- \ No newline at end of file diff --git a/libs/wire-subsystems/templates/en/team/email/idp-config-change-subject.txt b/libs/wire-subsystems/templates/en/team/email/idp-config-change-subject.txt new file mode 100644 index 00000000000..e31e5528a25 --- /dev/null +++ b/libs/wire-subsystems/templates/en/team/email/idp-config-change-subject.txt @@ -0,0 +1 @@ +Your team's identity provider configuration has changed \ No newline at end of file diff --git a/libs/wire-subsystems/templates/en/team/email/idp-config-change.html b/libs/wire-subsystems/templates/en/team/email/idp-config-change.html new file mode 100644 index 00000000000..bd60a2dca4a --- /dev/null +++ b/libs/wire-subsystems/templates/en/team/email/idp-config-change.html @@ -0,0 +1 @@ +Your team's identity provider configuration has changed

${brand_label_url}

Change in your Identity Provider configuration

Something has changed in the IdP configuration for your team.

Team ID:
${team_id}

User ID:
${user_id}

Details:

IdP Issuer:
${idp_issuer}

IdP Endpoint:
${idp_endpoint}

IdP ID:
${idp_id}

${certificates_details}

If you did not initiate this change, please reach out to the Wire support.

 

Privacy Policy and Terms of Use · Report misuse
${copyright}. All rights reserved.

                                                           
\ No newline at end of file diff --git a/libs/wire-subsystems/templates/en/team/email/idp-config-change.txt b/libs/wire-subsystems/templates/en/team/email/idp-config-change.txt new file mode 100644 index 00000000000..75fcd408d64 --- /dev/null +++ b/libs/wire-subsystems/templates/en/team/email/idp-config-change.txt @@ -0,0 +1,35 @@ +[${brand_logo}] + +${brand_label_url} [${brand_url}] + +CHANGE IN YOUR IDENTITY PROVIDER CONFIGURATION +Something has changed in the IdP configuration for your team. + +Team ID: +${team_id} + +User ID: +${user_id} + + +-------------------------------------------------------------------------------- + +Details: + +IdP Issuer: +${idp_issuer} + +IdP Endpoint: +${idp_endpoint} + +IdP ID: +${idp_id} + + +-------------------------------------------------------------------------------- + +${certificates_details}If you did not initiate this change, please reach out to the Wire support. +[${support}] + +Privacy Policy and Terms of Use [${legal}]· Report misuse [${misuse}] +${copyright}. All rights reserved. \ No newline at end of file diff --git a/libs/wire-subsystems/test/resources/mails/created_de.txt b/libs/wire-subsystems/test/resources/mails/created_de.txt new file mode 100644 index 00000000000..fb648c54957 --- /dev/null +++ b/libs/wire-subsystems/test/resources/mails/created_de.txt @@ -0,0 +1,50 @@ +[https://wire.example.com/p/img/email/logo-email-black.png] + +wire.example.com [https://wire.example.com] + +ÄNDERUNG IN DER KONFIGURATION IHRES IDENTITY PROVIDERS +Etwas hat sich in der IdP-Konfiguration für Ihr Team geändert. + +Team-ID: +99f552d8-9dad-60c1-4be9-c88fb532893a + +Benutzer-ID: +4a1ce4ea-5c99-d01e-018f-4dc9d08f787a + + +-------------------------------------------------------------------------------- + +Details: + +IdP-Aussteller: +https://issuer.example.com/realm + +IdP-Endpunkt: +https://saml-endpoint.example.com/auth + +IdP-ID: +574ddfb0-4e50-2bff-e924-33ee2b9f7064 + + +-------------------------------------------------------------------------------- + +Hinzugefügt: + +SHA1 Fingerabdruck: +15:28:A6:B8:5A:C5:36:80:B4:B0:95:C6:9A:FD:77:9C:D6:5C:78:37 + +Betreff: +CN=accounts.accesscontrol.windows.net + +Aussteller: +CN=accounts.accesscontrol.windows.net + + +-------------------------------------------------------------------------------- + +Wenn Sie diese Änderung nicht veranlasst haben, wenden Sie sich bitte an den +Wire Support. [https://support.wire.com/] + +Datenschutzerklärung und Nutzungsbedingungen [https://wire.example.com/legal/]· Missbrauch melden +[misuse@wire.example.com] +© WIRE SWISS GmbH. Alle Rechte vorbehalten. diff --git a/libs/wire-subsystems/test/resources/mails/created_en.txt b/libs/wire-subsystems/test/resources/mails/created_en.txt new file mode 100644 index 00000000000..c1eb08a1a89 --- /dev/null +++ b/libs/wire-subsystems/test/resources/mails/created_en.txt @@ -0,0 +1,49 @@ +[https://wire.example.com/p/img/email/logo-email-black.png] + +wire.example.com [https://wire.example.com] + +CHANGE IN YOUR IDENTITY PROVIDER CONFIGURATION +Something has changed in the IdP configuration for your team. + +Team ID: +99f552d8-9dad-60c1-4be9-c88fb532893a + +User ID: +4a1ce4ea-5c99-d01e-018f-4dc9d08f787a + + +-------------------------------------------------------------------------------- + +Details: + +IdP Issuer: +https://issuer.example.com/realm + +IdP Endpoint: +https://saml-endpoint.example.com/auth + +IdP ID: +574ddfb0-4e50-2bff-e924-33ee2b9f7064 + + +-------------------------------------------------------------------------------- + +Added: + +SHA1 fingerprint: +15:28:A6:B8:5A:C5:36:80:B4:B0:95:C6:9A:FD:77:9C:D6:5C:78:37 + +Subject: +CN=accounts.accesscontrol.windows.net + +Issuer: +CN=accounts.accesscontrol.windows.net + + +-------------------------------------------------------------------------------- + +If you did not initiate this change, please reach out to the Wire support. +[https://support.wire.com/] + +Privacy Policy and Terms of Use [https://wire.example.com/legal/]· Report misuse [misuse@wire.example.com] +© WIRE SWISS GmbH. All rights reserved. diff --git a/libs/wire-subsystems/test/resources/mails/deleted_de.txt b/libs/wire-subsystems/test/resources/mails/deleted_de.txt new file mode 100644 index 00000000000..29a4a6c8b96 --- /dev/null +++ b/libs/wire-subsystems/test/resources/mails/deleted_de.txt @@ -0,0 +1,50 @@ +[https://wire.example.com/p/img/email/logo-email-black.png] + +wire.example.com [https://wire.example.com] + +ÄNDERUNG IN DER KONFIGURATION IHRES IDENTITY PROVIDERS +Etwas hat sich in der IdP-Konfiguration für Ihr Team geändert. + +Team-ID: +99f552d8-9dad-60c1-4be9-c88fb532893a + +Benutzer-ID: +4a1ce4ea-5c99-d01e-018f-4dc9d08f787a + + +-------------------------------------------------------------------------------- + +Details: + +IdP-Aussteller: +https://issuer.example.com/realm + +IdP-Endpunkt: +https://saml-endpoint.example.com/auth + +IdP-ID: +574ddfb0-4e50-2bff-e924-33ee2b9f7064 + + +-------------------------------------------------------------------------------- + +Entfernt: + +SHA1 Fingerabdruck: +15:28:A6:B8:5A:C5:36:80:B4:B0:95:C6:9A:FD:77:9C:D6:5C:78:37 + +Betreff: +CN=accounts.accesscontrol.windows.net + +Aussteller: +CN=accounts.accesscontrol.windows.net + + +-------------------------------------------------------------------------------- + +Wenn Sie diese Änderung nicht veranlasst haben, wenden Sie sich bitte an den +Wire Support. [https://support.wire.com/] + +Datenschutzerklärung und Nutzungsbedingungen [https://wire.example.com/legal/]· Missbrauch melden +[misuse@wire.example.com] +© WIRE SWISS GmbH. Alle Rechte vorbehalten. diff --git a/libs/wire-subsystems/test/resources/mails/deleted_en.txt b/libs/wire-subsystems/test/resources/mails/deleted_en.txt new file mode 100644 index 00000000000..c70c157d2f3 --- /dev/null +++ b/libs/wire-subsystems/test/resources/mails/deleted_en.txt @@ -0,0 +1,49 @@ +[https://wire.example.com/p/img/email/logo-email-black.png] + +wire.example.com [https://wire.example.com] + +CHANGE IN YOUR IDENTITY PROVIDER CONFIGURATION +Something has changed in the IdP configuration for your team. + +Team ID: +99f552d8-9dad-60c1-4be9-c88fb532893a + +User ID: +4a1ce4ea-5c99-d01e-018f-4dc9d08f787a + + +-------------------------------------------------------------------------------- + +Details: + +IdP Issuer: +https://issuer.example.com/realm + +IdP Endpoint: +https://saml-endpoint.example.com/auth + +IdP ID: +574ddfb0-4e50-2bff-e924-33ee2b9f7064 + + +-------------------------------------------------------------------------------- + +Removed: + +SHA1 fingerprint: +15:28:A6:B8:5A:C5:36:80:B4:B0:95:C6:9A:FD:77:9C:D6:5C:78:37 + +Subject: +CN=accounts.accesscontrol.windows.net + +Issuer: +CN=accounts.accesscontrol.windows.net + + +-------------------------------------------------------------------------------- + +If you did not initiate this change, please reach out to the Wire support. +[https://support.wire.com/] + +Privacy Policy and Terms of Use [https://wire.example.com/legal/]· Report misuse [misuse@wire.example.com] +© WIRE SWISS GmbH. All rights reserved. diff --git a/libs/wire-subsystems/test/resources/mails/subject_de.txt b/libs/wire-subsystems/test/resources/mails/subject_de.txt new file mode 100644 index 00000000000..dff03eba7d3 --- /dev/null +++ b/libs/wire-subsystems/test/resources/mails/subject_de.txt @@ -0,0 +1 @@ +Die Konfiguration des Identity Providers Ihres Teams hat sich geändert \ No newline at end of file diff --git a/libs/wire-subsystems/test/resources/mails/subject_en.txt b/libs/wire-subsystems/test/resources/mails/subject_en.txt new file mode 100644 index 00000000000..e31e5528a25 --- /dev/null +++ b/libs/wire-subsystems/test/resources/mails/subject_en.txt @@ -0,0 +1 @@ +Your team's identity provider configuration has changed \ No newline at end of file diff --git a/libs/wire-subsystems/test/resources/mails/updated_de.txt b/libs/wire-subsystems/test/resources/mails/updated_de.txt new file mode 100644 index 00000000000..324c24d42d7 --- /dev/null +++ b/libs/wire-subsystems/test/resources/mails/updated_de.txt @@ -0,0 +1,77 @@ +[https://wire.example.com/p/img/email/logo-email-black.png] + +wire.example.com [https://wire.example.com] + +ÄNDERUNG IN DER KONFIGURATION IHRES IDENTITY PROVIDERS +Etwas hat sich in der IdP-Konfiguration für Ihr Team geändert. + +Team-ID: +99f552d8-9dad-60c1-4be9-c88fb532893a + +Benutzer-ID: +4a1ce4ea-5c99-d01e-018f-4dc9d08f787a + + +-------------------------------------------------------------------------------- + +Details: + +IdP-Aussteller: +https://issuer.example.com/realm + +IdP-Endpunkt: +https://saml-endpoint.example.com/auth + +IdP-ID: +574ddfb0-4e50-2bff-e924-33ee2b9f7064 + + +-------------------------------------------------------------------------------- + +Hinzugefügt: + +SHA1 Fingerabdruck: +11:DE:AC:24:34:30:3D:05:81:02:77:26:41:3D:FC:09:01:92:E4:40 + +Betreff: +Country=US,O=ExampleOrg,OU=Dev1,CN=CertOne,Email Address=one@example.com + +Aussteller: +Country=US,O=ExampleOrg,OU=Dev1,CN=CertOne,Email Address=one@example.com + + +-------------------------------------------------------------------------------- +Hinzugefügt: + +SHA1 Fingerabdruck: +DF:CB:99:7D:C7:1A:4A:AC:D3:F6:94:22:97:07:6D:59:7B:BF:7B:57 + +Betreff: +Country=DE,O=ExampleOrg,OU=Dev2,CN=CertTwo,Email Address=two@example.com + +Aussteller: +Country=DE,O=ExampleOrg,OU=Dev2,CN=CertTwo,Email Address=two@example.com + + +-------------------------------------------------------------------------------- + +Entfernt: + +SHA1 Fingerabdruck: +15:28:A6:B8:5A:C5:36:80:B4:B0:95:C6:9A:FD:77:9C:D6:5C:78:37 + +Betreff: +CN=accounts.accesscontrol.windows.net + +Aussteller: +CN=accounts.accesscontrol.windows.net + + +-------------------------------------------------------------------------------- + +Wenn Sie diese Änderung nicht veranlasst haben, wenden Sie sich bitte an den +Wire Support. [https://support.wire.com/] + +Datenschutzerklärung und Nutzungsbedingungen [https://wire.example.com/legal/]· Missbrauch melden +[misuse@wire.example.com] +© WIRE SWISS GmbH. Alle Rechte vorbehalten. diff --git a/libs/wire-subsystems/test/resources/mails/updated_en.txt b/libs/wire-subsystems/test/resources/mails/updated_en.txt new file mode 100644 index 00000000000..640dc8ae862 --- /dev/null +++ b/libs/wire-subsystems/test/resources/mails/updated_en.txt @@ -0,0 +1,76 @@ +[https://wire.example.com/p/img/email/logo-email-black.png] + +wire.example.com [https://wire.example.com] + +CHANGE IN YOUR IDENTITY PROVIDER CONFIGURATION +Something has changed in the IdP configuration for your team. + +Team ID: +99f552d8-9dad-60c1-4be9-c88fb532893a + +User ID: +4a1ce4ea-5c99-d01e-018f-4dc9d08f787a + + +-------------------------------------------------------------------------------- + +Details: + +IdP Issuer: +https://issuer.example.com/realm + +IdP Endpoint: +https://saml-endpoint.example.com/auth + +IdP ID: +574ddfb0-4e50-2bff-e924-33ee2b9f7064 + + +-------------------------------------------------------------------------------- + +Added: + +SHA1 fingerprint: +11:DE:AC:24:34:30:3D:05:81:02:77:26:41:3D:FC:09:01:92:E4:40 + +Subject: +Country=US,O=ExampleOrg,OU=Dev1,CN=CertOne,Email Address=one@example.com + +Issuer: +Country=US,O=ExampleOrg,OU=Dev1,CN=CertOne,Email Address=one@example.com + + +-------------------------------------------------------------------------------- +Added: + +SHA1 fingerprint: +DF:CB:99:7D:C7:1A:4A:AC:D3:F6:94:22:97:07:6D:59:7B:BF:7B:57 + +Subject: +Country=DE,O=ExampleOrg,OU=Dev2,CN=CertTwo,Email Address=two@example.com + +Issuer: +Country=DE,O=ExampleOrg,OU=Dev2,CN=CertTwo,Email Address=two@example.com + + +-------------------------------------------------------------------------------- + +Removed: + +SHA1 fingerprint: +15:28:A6:B8:5A:C5:36:80:B4:B0:95:C6:9A:FD:77:9C:D6:5C:78:37 + +Subject: +CN=accounts.accesscontrol.windows.net + +Issuer: +CN=accounts.accesscontrol.windows.net + + +-------------------------------------------------------------------------------- + +If you did not initiate this change, please reach out to the Wire support. +[https://support.wire.com/] + +Privacy Policy and Terms of Use [https://wire.example.com/legal/]· Report misuse [misuse@wire.example.com] +© WIRE SWISS GmbH. All rights reserved. diff --git a/libs/wire-subsystems/test/resources/saml/cert1.pem b/libs/wire-subsystems/test/resources/saml/cert1.pem new file mode 100644 index 00000000000..5d47da663ea --- /dev/null +++ b/libs/wire-subsystems/test/resources/saml/cert1.pem @@ -0,0 +1,22 @@ +-----BEGIN CERTIFICATE----- +MIIDpzCCAo+gAwIBAgIUGPNyUrrhoMIonvkYvigqvqFF/3gwDQYJKoZIhvcNAQEL +BQAwYzELMAkGA1UEBhMCVVMxEzARBgNVBAoMCkV4YW1wbGVPcmcxDTALBgNVBAsM +BERldjExEDAOBgNVBAMMB0NlcnRPbmUxHjAcBgkqhkiG9w0BCQEWD29uZUBleGFt +cGxlLmNvbTAeFw0yNjAxMjcxNjE2MzFaFw0zNjAxMjUxNjE2MzFaMGMxCzAJBgNV +BAYTAlVTMRMwEQYDVQQKDApFeGFtcGxlT3JnMQ0wCwYDVQQLDAREZXYxMRAwDgYD +VQQDDAdDZXJ0T25lMR4wHAYJKoZIhvcNAQkBFg9vbmVAZXhhbXBsZS5jb20wggEi +MA0GCSqGSIb3DQEBAQUAA4IBDwAwggEKAoIBAQDxC0fakb82wXpg6b5rhjJT1tcX +hn+zY7HTs7oJxIGGmC/QZf9hTFkkp/ECQ6c3S7heSFjL3Rm7rH5+e4Oidfr6OCn4 +8sGR55a2i2gOkOKczyOOuOqshXVMzZvon358WuzDq7jWC4chmhliax6wLS3qZOYN +1tJ2hUFs2rchJVms1DOQl3bzldgdCn1U3Vr2JQfseuifrQxdkqJyCnyOzyLumRYf +4Jpakdbk0enmjRu9E/0utIhQ5pgS2Jt/rsSXOXxuW4SG2tTpJkhtrpPERSjlOnG6 +CRuY5ITbNhIqFI1nW8U7Duiie1qzxiO9rTGSEFH4kjQv365A2q1Ya+NjKZQlAgMB +AAGjUzBRMB0GA1UdDgQWBBTn6D8HS6JX+OK+GIf+PGKzFP7nfjAfBgNVHSMEGDAW +gBTn6D8HS6JX+OK+GIf+PGKzFP7nfjAPBgNVHRMBAf8EBTADAQH/MA0GCSqGSIb3 +DQEBCwUAA4IBAQBqCvchFQztrnCTLcr5fDVngbYzAw2YVnbxj6ufbU+rY+NsZM8T +RIybUmSntyiHoJ58H15ITkAu+dhwtBbEQ2iKMgBBvtAk152y+07weL1eFyTMnn2k +IYd8V+gvowidPcOL9TVgtZU57vwQ4hLngyl/scTbtbeYg4Nojpb4Wznyoliar0Ro +/uItPYd8I/ls4MIs429i3J22dybUQhiugqFsiAwus3NOwU8I7sr48DUQlGu84LdQ +ggGMYx//tNn4PH8HYAAP2icgypvKsLsiagSBbXB0AnJ7Ui8RPTm4880oeFTDJNKu +87XeJwRhFbVQZzubnw/4sf45ZdUfwtnVdbKW +-----END CERTIFICATE----- diff --git a/libs/wire-subsystems/test/resources/saml/cert2.pem b/libs/wire-subsystems/test/resources/saml/cert2.pem new file mode 100644 index 00000000000..fd1cc362f7b --- /dev/null +++ b/libs/wire-subsystems/test/resources/saml/cert2.pem @@ -0,0 +1,22 @@ +-----BEGIN CERTIFICATE----- +MIIDpzCCAo+gAwIBAgIUPo/JjMajp0dK6m94JFl6f7k/FkUwDQYJKoZIhvcNAQEL +BQAwYzELMAkGA1UEBhMCREUxEzARBgNVBAoMCkV4YW1wbGVPcmcxDTALBgNVBAsM +BERldjIxEDAOBgNVBAMMB0NlcnRUd28xHjAcBgkqhkiG9w0BCQEWD3R3b0BleGFt +cGxlLmNvbTAeFw0yNjAxMjcxNjE2MzFaFw0zNjAxMjUxNjE2MzFaMGMxCzAJBgNV +BAYTAkRFMRMwEQYDVQQKDApFeGFtcGxlT3JnMQ0wCwYDVQQLDAREZXYyMRAwDgYD +VQQDDAdDZXJ0VHdvMR4wHAYJKoZIhvcNAQkBFg90d29AZXhhbXBsZS5jb20wggEi +MA0GCSqGSIb3DQEBAQUAA4IBDwAwggEKAoIBAQDxC0fakb82wXpg6b5rhjJT1tcX +hn+zY7HTs7oJxIGGmC/QZf9hTFkkp/ECQ6c3S7heSFjL3Rm7rH5+e4Oidfr6OCn4 +8sGR55a2i2gOkOKczyOOuOqshXVMzZvon358WuzDq7jWC4chmhliax6wLS3qZOYN +1tJ2hUFs2rchJVms1DOQl3bzldgdCn1U3Vr2JQfseuifrQxdkqJyCnyOzyLumRYf +4Jpakdbk0enmjRu9E/0utIhQ5pgS2Jt/rsSXOXxuW4SG2tTpJkhtrpPERSjlOnG6 +CRuY5ITbNhIqFI1nW8U7Duiie1qzxiO9rTGSEFH4kjQv365A2q1Ya+NjKZQlAgMB +AAGjUzBRMB0GA1UdDgQWBBTn6D8HS6JX+OK+GIf+PGKzFP7nfjAfBgNVHSMEGDAW +gBTn6D8HS6JX+OK+GIf+PGKzFP7nfjAPBgNVHRMBAf8EBTADAQH/MA0GCSqGSIb3 +DQEBCwUAA4IBAQCW/X6PE9cLIHUkBbEBmar0X3GAjUIYuFnPem1ljKbk7G+1h2Q9 +Yr9ETBw4+1IfuiML6AgVKFzpxlP36Y5+pJ5sVr4z/O/mfN2NLMFlAyY9x9FPsP3/ +E9NptyMssZhc0L4JSw3XU8KqhZvC9FYOa61XPnpXh4veXXTY9CLslz0WG/G/Iprf +j5kkjpaw1Mt1A6hpyfhqokx4EgJENWWh70Txy+tPnuyL9LDF24CMuwgL9HugATQ+ +uZ4SyucS3OzPMciaY69xRP8afxqKczzdqv60cXhVJzf5PZmtgHQIuEawWX+cULsM +eSLnQV58FsPqgebqNpm0EQWAwYIKedhkul1B +-----END CERTIFICATE----- diff --git a/libs/wire-subsystems/test/resources/saml/certs.store b/libs/wire-subsystems/test/resources/saml/certs.store new file mode 100644 index 00000000000..0ce78139974 --- /dev/null +++ b/libs/wire-subsystems/test/resources/saml/certs.store @@ -0,0 +1,44 @@ +-----BEGIN CERTIFICATE----- +MIIDpzCCAo+gAwIBAgIUGPNyUrrhoMIonvkYvigqvqFF/3gwDQYJKoZIhvcNAQEL +BQAwYzELMAkGA1UEBhMCVVMxEzARBgNVBAoMCkV4YW1wbGVPcmcxDTALBgNVBAsM +BERldjExEDAOBgNVBAMMB0NlcnRPbmUxHjAcBgkqhkiG9w0BCQEWD29uZUBleGFt +cGxlLmNvbTAeFw0yNjAxMjcxNjE2MzFaFw0zNjAxMjUxNjE2MzFaMGMxCzAJBgNV +BAYTAlVTMRMwEQYDVQQKDApFeGFtcGxlT3JnMQ0wCwYDVQQLDAREZXYxMRAwDgYD +VQQDDAdDZXJ0T25lMR4wHAYJKoZIhvcNAQkBFg9vbmVAZXhhbXBsZS5jb20wggEi +MA0GCSqGSIb3DQEBAQUAA4IBDwAwggEKAoIBAQDxC0fakb82wXpg6b5rhjJT1tcX +hn+zY7HTs7oJxIGGmC/QZf9hTFkkp/ECQ6c3S7heSFjL3Rm7rH5+e4Oidfr6OCn4 +8sGR55a2i2gOkOKczyOOuOqshXVMzZvon358WuzDq7jWC4chmhliax6wLS3qZOYN +1tJ2hUFs2rchJVms1DOQl3bzldgdCn1U3Vr2JQfseuifrQxdkqJyCnyOzyLumRYf +4Jpakdbk0enmjRu9E/0utIhQ5pgS2Jt/rsSXOXxuW4SG2tTpJkhtrpPERSjlOnG6 +CRuY5ITbNhIqFI1nW8U7Duiie1qzxiO9rTGSEFH4kjQv365A2q1Ya+NjKZQlAgMB +AAGjUzBRMB0GA1UdDgQWBBTn6D8HS6JX+OK+GIf+PGKzFP7nfjAfBgNVHSMEGDAW +gBTn6D8HS6JX+OK+GIf+PGKzFP7nfjAPBgNVHRMBAf8EBTADAQH/MA0GCSqGSIb3 +DQEBCwUAA4IBAQBqCvchFQztrnCTLcr5fDVngbYzAw2YVnbxj6ufbU+rY+NsZM8T +RIybUmSntyiHoJ58H15ITkAu+dhwtBbEQ2iKMgBBvtAk152y+07weL1eFyTMnn2k +IYd8V+gvowidPcOL9TVgtZU57vwQ4hLngyl/scTbtbeYg4Nojpb4Wznyoliar0Ro +/uItPYd8I/ls4MIs429i3J22dybUQhiugqFsiAwus3NOwU8I7sr48DUQlGu84LdQ +ggGMYx//tNn4PH8HYAAP2icgypvKsLsiagSBbXB0AnJ7Ui8RPTm4880oeFTDJNKu +87XeJwRhFbVQZzubnw/4sf45ZdUfwtnVdbKW +-----END CERTIFICATE----- +-----BEGIN CERTIFICATE----- +MIIDpzCCAo+gAwIBAgIUPo/JjMajp0dK6m94JFl6f7k/FkUwDQYJKoZIhvcNAQEL +BQAwYzELMAkGA1UEBhMCREUxEzARBgNVBAoMCkV4YW1wbGVPcmcxDTALBgNVBAsM +BERldjIxEDAOBgNVBAMMB0NlcnRUd28xHjAcBgkqhkiG9w0BCQEWD3R3b0BleGFt +cGxlLmNvbTAeFw0yNjAxMjcxNjE2MzFaFw0zNjAxMjUxNjE2MzFaMGMxCzAJBgNV +BAYTAkRFMRMwEQYDVQQKDApFeGFtcGxlT3JnMQ0wCwYDVQQLDAREZXYyMRAwDgYD +VQQDDAdDZXJ0VHdvMR4wHAYJKoZIhvcNAQkBFg90d29AZXhhbXBsZS5jb20wggEi +MA0GCSqGSIb3DQEBAQUAA4IBDwAwggEKAoIBAQDxC0fakb82wXpg6b5rhjJT1tcX +hn+zY7HTs7oJxIGGmC/QZf9hTFkkp/ECQ6c3S7heSFjL3Rm7rH5+e4Oidfr6OCn4 +8sGR55a2i2gOkOKczyOOuOqshXVMzZvon358WuzDq7jWC4chmhliax6wLS3qZOYN +1tJ2hUFs2rchJVms1DOQl3bzldgdCn1U3Vr2JQfseuifrQxdkqJyCnyOzyLumRYf +4Jpakdbk0enmjRu9E/0utIhQ5pgS2Jt/rsSXOXxuW4SG2tTpJkhtrpPERSjlOnG6 +CRuY5ITbNhIqFI1nW8U7Duiie1qzxiO9rTGSEFH4kjQv365A2q1Ya+NjKZQlAgMB +AAGjUzBRMB0GA1UdDgQWBBTn6D8HS6JX+OK+GIf+PGKzFP7nfjAfBgNVHSMEGDAW +gBTn6D8HS6JX+OK+GIf+PGKzFP7nfjAPBgNVHRMBAf8EBTADAQH/MA0GCSqGSIb3 +DQEBCwUAA4IBAQCW/X6PE9cLIHUkBbEBmar0X3GAjUIYuFnPem1ljKbk7G+1h2Q9 +Yr9ETBw4+1IfuiML6AgVKFzpxlP36Y5+pJ5sVr4z/O/mfN2NLMFlAyY9x9FPsP3/ +E9NptyMssZhc0L4JSw3XU8KqhZvC9FYOa61XPnpXh4veXXTY9CLslz0WG/G/Iprf +j5kkjpaw1Mt1A6hpyfhqokx4EgJENWWh70Txy+tPnuyL9LDF24CMuwgL9HugATQ+ +uZ4SyucS3OzPMciaY69xRP8afxqKczzdqv60cXhVJzf5PZmtgHQIuEawWX+cULsM +eSLnQV58FsPqgebqNpm0EQWAwYIKedhkul1B +-----END CERTIFICATE----- diff --git a/libs/wire-subsystems/test/resources/saml/generate-certs.sh b/libs/wire-subsystems/test/resources/saml/generate-certs.sh new file mode 100755 index 00000000000..f9eea1b4b88 --- /dev/null +++ b/libs/wire-subsystems/test/resources/saml/generate-certs.sh @@ -0,0 +1,10 @@ +#!/usr/bin/env sh + +# Generate a key and certs for testing +openssl genpkey -algorithm RSA -out mykey.pem -pkeyopt rsa_keygen_bits:2048 +openssl req -new -x509 -key mykey.pem -out cert1.pem -days 3650 \ + -subj "/C=US/O=ExampleOrg/OU=Dev1/CN=CertOne/emailAddress=one@example.com" +openssl req -new -x509 -key mykey.pem -out cert2.pem -days 3650 \ + -subj "/C=DE/O=ExampleOrg/OU=Dev2/CN=CertTwo/emailAddress=two@example.com" + +cat cert1.pem cert2.pem > certs.store diff --git a/libs/wire-subsystems/test/resources/saml/mykey.pem b/libs/wire-subsystems/test/resources/saml/mykey.pem new file mode 100644 index 00000000000..a44cc6bd0dc --- /dev/null +++ b/libs/wire-subsystems/test/resources/saml/mykey.pem @@ -0,0 +1,28 @@ +-----BEGIN PRIVATE KEY----- +MIIEvAIBADANBgkqhkiG9w0BAQEFAASCBKYwggSiAgEAAoIBAQDxC0fakb82wXpg +6b5rhjJT1tcXhn+zY7HTs7oJxIGGmC/QZf9hTFkkp/ECQ6c3S7heSFjL3Rm7rH5+ +e4Oidfr6OCn48sGR55a2i2gOkOKczyOOuOqshXVMzZvon358WuzDq7jWC4chmhli +ax6wLS3qZOYN1tJ2hUFs2rchJVms1DOQl3bzldgdCn1U3Vr2JQfseuifrQxdkqJy +CnyOzyLumRYf4Jpakdbk0enmjRu9E/0utIhQ5pgS2Jt/rsSXOXxuW4SG2tTpJkht +rpPERSjlOnG6CRuY5ITbNhIqFI1nW8U7Duiie1qzxiO9rTGSEFH4kjQv365A2q1Y +a+NjKZQlAgMBAAECggEABVZdxnILZ7UmtmZRRZnom7ZPoqE4oFUY9xpCiHyAmRAz +StbfWJ0IrPOdC2hKbRfbosF7rzPw9xi4NP5w0+mZ35gxHGaVBlvi7fLYoINGc/jF +jZ+m7qAGkLyiyFFedcwg9FTlQwlpT23/7uUhU6mvG8K/3KxA58fxQsL1uCGsF9QQ +uTlDhmVh7ONYsB0KZQKXYHmturWqHQI4sLJHQ+simDld0jeUXIdZncPolLA4IIgG +qTTGdZk0h65j9nsIyuQYqPK9wS0b70bW52y8DKGe1MhmZrLJr4ZZ6NAPXpPnlpD1 +NyDbOJO2tq+kJVz08Maz8iJxsQHcgRRLRlZu3Ge2IQKBgQD+JaaQvi7M41JKWVPt +X/lHTBMDjcvV9HvmLyZvt0He0E6WtGMqO0X+m5zLJDiDMyPfoANiXNCGeV5WeIzd +ags0N0jC68/qE3V4De2O+76sy7n4g0WGqY/j/82h3SaH1IIAXZr1PSjXf4h1Pid9 +FO/1ruGVkNmK8Llb1pcm06Ub0QKBgQDyzSyR8dqYKJbYI3uUGALQ37onY+ZNBOrN +vYfS8eJDjhy9pfzDOLiEYf0bmJYEhCXyAIRXIqEdpRNtPh0uE7WMzSCRk/OVD5fK +au56adn99EwismxeGsAS0XnA5T2ctAHw1a2iSdfixuwBDqGcx4RB6fK+xAgEgrUH +TblbpuiMFQKBgDlA6iE5dvmZTHSLYyjasiGpta7bRsxQY4kbniEUu7YiX1H8GUru +R3pwPAZXhpOn9bDvL1P9bMyeku4QAkvvE88TlUS0Mwack54UJSxM8kujKaYejI8l +q9DFU+HfHEsFSLQkYkBVItpJVMh01BiNmvFSEGfNVfTC/j7+PNb2Xv/BAoGAU09R +Jracsa7jqz/pjDP861yIzDE7+VthkbyhmSDD6Tge5nfI1ddlgI76wPhHKT+KoZHJ +1vgb3kcg9k/kxUWf+rL7pNfmMVRLWfn83+XoFXo4kYM1Kcj19L8JjsVZsaYWMGOx +E0lRGQ/2NJqnm1reJ5u1Xf13XszWfq4NlsQbcM0CgYAx4oSxX6c+c9HmaAg1L5ZV +zCHMtQdoxoel4tFNpu4lTz5RBMZPQM02I2IlsP7hTRv66QA92C/kIs8JXvm7lPR4 +Ys+kMK2XNoIcMDzLQw74SldqVS+BQXPp/9QOdMAhae3mmeuWkrk34O/TW19OJWSX +DuYvVKofnhdVpIYS/38I2g== +-----END PRIVATE KEY----- diff --git a/libs/wire-subsystems/test/resources/saml/okta-keyinfo-1.xml b/libs/wire-subsystems/test/resources/saml/okta-keyinfo-1.xml new file mode 100644 index 00000000000..5eacdb59013 --- /dev/null +++ b/libs/wire-subsystems/test/resources/saml/okta-keyinfo-1.xml @@ -0,0 +1,21 @@ + + +MIIDpDCCAoygAwIBAgIGAWSx7x1HMA0GCSqGSIb3DQEBCwUAMIGSMQswCQYDVQQGEwJVUzETMBEG +A1UECAwKQ2FsaWZvcm5pYTEWMBQGA1UEBwwNU2FuIEZyYW5jaXNjbzENMAsGA1UECgwET2t0YTEU +MBIGA1UECwwLU1NPUHJvdmlkZXIxEzARBgNVBAMMCmRldi01MDA1MDgxHDAaBgkqhkiG9w0BCQEW +DWluZm9Ab2t0YS5jb20wHhcNMTgwNzE5MDk0NTM1WhcNMjgwNzE5MDk0NjM0WjCBkjELMAkGA1UE +BhMCVVMxEzARBgNVBAgMCkNhbGlmb3JuaWExFjAUBgNVBAcMDVNhbiBGcmFuY2lzY28xDTALBgNV +BAoMBE9rdGExFDASBgNVBAsMC1NTT1Byb3ZpZGVyMRMwEQYDVQQDDApkZXYtNTAwNTA4MRwwGgYJ +KoZIhvcNAQkBFg1pbmZvQG9rdGEuY29tMIIBIjANBgkqhkiG9w0BAQEFAAOCAQ8AMIIBCgKCAQEA +hUaQm/3dgPws1A5IjFK9ZQpj170vIqENuDG0tapAzkvk6+9vyhduGckHTeZF3k5MMlW9iix2Eg0q +a1oS/Wrq/aBf7+BH6y1MJlQnaKQ3hPL+OFvYzbnrN8k2uC2LivP7Y90dXwtN3P63rA4QSyDPYEMv +dKSubUKX/HNsUg4I2PwHmpfWBNgoMkqe0bxQILBv+84L62IYSd6k77XXnCFb/usHpG/gY6sJsTQ2 +aFl9FuJ51uf67AOj8RzPXstgtUaXbdJI0kAqKIb3j9Zv3mpPCy/GHnyB3PMalvtc1uaz1ZnwO2el +iqhwB6/8W6CPutFo1Bhq1glQIX+1OD7906iORwIDAQABMA0GCSqGSIb3DQEBCwUAA4IBAQB0h6vK +AywJwH3g0RnocOpBvT42QW57TZ3Wzm9gbg6dQL0rB+NHDx2V0VIh51E3YHL1os9W09MreM7I74D/ +fX27r1Q3+qAsL1v3CN8WIVh9eYitBCtF7DwZmL2UXTia+GWPrabO14qAztFmTXfqNuCZej7gJd/K +2r0KBiZtZ6o58WBREW2F70a6nN6Nk1yjzBkDTJMMf8OMXHphTaalMBXojN9W6HEDpGBE0qY7c70P +qvfUEzd8wHWcDxo6+3jajajelk0V4rg7Cqxccr+WwjYtENEuQypNG2mbI52iPZked0QWKy0WzhSM +w5wjJ+QDG31vJInAB2769C2KmhPDyNhU + + diff --git a/libs/wire-subsystems/test/unit/Wire/MockInterpreters/EmailSending.hs b/libs/wire-subsystems/test/unit/Wire/MockInterpreters/EmailSending.hs index 2c50f4c9d2c..a0f63bfc937 100644 --- a/libs/wire-subsystems/test/unit/Wire/MockInterpreters/EmailSending.hs +++ b/libs/wire-subsystems/test/unit/Wire/MockInterpreters/EmailSending.hs @@ -18,10 +18,17 @@ module Wire.MockInterpreters.EmailSending where import Imports +import Network.Mail.Mime (Mail) import Polysemy +import Polysemy.State import Wire.EmailSending noopEmailSendingInterpreter :: InterpreterFor EmailSending r noopEmailSendingInterpreter = interpret \case SendMail _ -> pure () + +recordingEmailSendingInterpreter :: (Member (State [Mail]) r) => InterpreterFor EmailSending r +recordingEmailSendingInterpreter = + interpret \case + SendMail mail -> modify (mail :) diff --git a/libs/wire-subsystems/test/unit/Wire/MockInterpreters/EmailSubsystem.hs b/libs/wire-subsystems/test/unit/Wire/MockInterpreters/EmailSubsystem.hs index fcb8cb27168..305bebed550 100644 --- a/libs/wire-subsystems/test/unit/Wire/MockInterpreters/EmailSubsystem.hs +++ b/libs/wire-subsystems/test/unit/Wire/MockInterpreters/EmailSubsystem.hs @@ -57,3 +57,4 @@ noopEmailSubsystemInterpreter = interpret \case SendTeamInvitationMailPersonalUser {} -> pure "" SendMemberWelcomeEmail {} -> pure () SendNewTeamOwnerWelcomeEmail {} -> pure () + SendSAMLIdPChanged {} -> pure () diff --git a/libs/wire-subsystems/test/unit/Wire/SAMLEmailSubsystem/InterpreterSpec.hs b/libs/wire-subsystems/test/unit/Wire/SAMLEmailSubsystem/InterpreterSpec.hs new file mode 100644 index 00000000000..85def35b0fc --- /dev/null +++ b/libs/wire-subsystems/test/unit/Wire/SAMLEmailSubsystem/InterpreterSpec.hs @@ -0,0 +1,358 @@ +module Wire.SAMLEmailSubsystem.InterpreterSpec (spec) where + +import Data.Default +import Data.Id +import Data.LegalHold (UserLegalHoldStatus (..)) +import Data.List.NonEmpty qualified as NE +import Data.Map qualified as Map +import Data.Set qualified as Set +import Data.Text.Lazy qualified as TL +import Data.Text.Lazy.Encoding (decodeUtf8) +import Data.Text.Lazy.IO qualified as TL +import Data.UUID qualified as UUID +import Data.X509.CertificateStore qualified as X509 +import Imports +import Network.Mail.Mime (Address (..), Mail (..), Part (..), PartContent (..)) +import Polysemy +import Polysemy.State +import SAML2.WebSSO +import System.FilePath +import System.Logger qualified as Logger +import Test.Hspec +import Test.Hspec.QuickCheck +import Test.QuickCheck +import Text.Email.Parser (unsafeEmailAddress) +import URI.ByteString +import Wire.API.Locale +import Wire.API.Routes.Internal.Brig (IdpChangedNotification (..)) +import Wire.API.Team.Member +import Wire.API.Team.Permission (fullPermissions) +import Wire.API.Team.Role (Role (..)) +import Wire.API.User.EmailAddress (fromEmail) +import Wire.API.User.IdentityProvider +import Wire.EmailSending +import Wire.EmailSubsystem qualified as Email +import Wire.EmailSubsystem.Interpreter +import Wire.EmailSubsystem.Template +import Wire.EmailSubsystem.Templates.Team +import Wire.GalleyAPIAccess +import Wire.MockInterpreters +import Wire.SAMLEmailSubsystem +import Wire.SAMLEmailSubsystem.Interpreter (samlEmailSubsystemInterpreter) +import Wire.Sem.Logger +import Wire.Sem.Logger.TinyLog +import Wire.StoredUser (StoredUser (..)) +import Wire.TeamSubsystem +import Wire.TeamSubsystem.GalleyAPI (interpretTeamSubsystemToGalleyAPI) +import Wire.UserStore + +data RenderedTextParts = RenderedTextParts + { created :: LText, + deleted :: LText, + updated :: LText, + subject :: LText + } + +spec :: Spec +spec = do + let createTextParts lang = + RenderedTextParts + <$> readTextPartFile ("created_" <> lang <> ".txt") + <*> readTextPartFile ("deleted_" <> lang <> ".txt") + <*> readTextPartFile ("updated_" <> lang <> ".txt") + <*> readTextPartFile ("subject_" <> lang <> ".txt") + + enTextParts <- runIO $ createTextParts "en" + deTextParts <- runIO $ createTextParts "de" + let -- We don't test all locals such that we do not have to adjust this test + -- for every new translation. So far, there are translations for German + -- and English. There's none for Spanish (falls back to English). + testLocals :: [(Locale, RenderedTextParts)] = + flip zip ((replicate 5 enTextParts) ++ (replicate 2 deTextParts)) $ + parseLocalUnsafe <$> ["en", "en-EN", "en-GB", "es", "es-ES", "de", "de_DE"] + parseLocalUnsafe = fromMaybe (error "Unknown locale") . parseLocale + teamOpts = + TeamOpts + { tInvitationUrl = "https://example.com/join/?team-code=${code}", + tExistingUserInvitationUrl = "https://example.com/accept-invitation/?team-code=${code}", + tActivationUrl = "https://example.com/verify/?key=${key}&code=${code}", + tCreatorWelcomeUrl = "https://example.com/creator-welcome-website", + tMemberWelcomeUrl = "https://example.com/member-welcome-website" + } + defLocale = Locale ((fromJust . parseLanguage) "en") Nothing + emailSender = unsafeEmailAddress "wire" "example.com" + branding = + Map.fromList + [ ("brand", "Wire Test"), + ("brand_url", "https://wire.example.com"), + ("brand_label_url", "wire.example.com"), + ("brand_logo", "https://wire.example.com/p/img/email/logo-email-black.png"), + ("brand_service", "Wire Service Provider"), + ("copyright", "© WIRE SWISS GmbH"), + ("misuse", "misuse@wire.example.com"), + ("legal", "https://wire.example.com/legal/"), + ("forgot", "https://wire.example.com/forgot/"), + ("support", "https://support.wire.com/") + ] + + -- Run duplicated IO tasks here to save some time + teamTemplates :: Localised TeamTemplates <- runIO $ loadTeamTemplates teamOpts "templates" defLocale emailSender + newCerts <- runIO $ X509.readCertificates "test/resources/saml/certs.store" + + describe "SendSAMLIdPChanged" $ do + describe "localized emails" $ forM_ testLocals $ \(userLocale :: Locale, textParts) -> do + let uid :: UserId = either error Imports.id $ parseIdFromText "4a1ce4ea-5c99-d01e-018f-4dc9d08f787a" + teamId :: TeamId = either error Imports.id $ parseIdFromText "99f552d8-9dad-60c1-4be9-c88fb532893a" + teamMember :: TeamMember = mkTeamMember uid fullPermissions Nothing UserLegalHoldDisabled + teamMap :: Map TeamId [TeamMember] = Map.singleton teamId [teamMember] + context ("locale: " ++ show userLocale) do + it "should send an email on IdPCreated" $ do + idp :: IdP <- liftIO $ generate arbitrary + storedUser :: StoredUser <- liftIO . generate $ arbitrary `suchThat` (isJust . (.email)) + let idp' = patchIdP idp teamId + storedUser' = patchStoredUser storedUser teamId userLocale uid + notif = IdPCreated (Just uid) idp' + + (mails, logs, _res) <- runInterpreters [storedUser'] teamMap teamTemplates branding $ do + sendSAMLIdPChanged notif + + assertNoWarnLogs logs + + length mails `shouldBe` 1 + let mail = head mails + assertCommonMailAttributes mail textParts.subject + assertMailTextPartWithFile mail textParts.created + + it "should send an email on IdPDeleted" $ do + idp :: IdP <- liftIO $ generate arbitrary + storedUser :: StoredUser <- liftIO . generate $ arbitrary `suchThat` (isJust . (.email)) + let idp' = patchIdP idp teamId + storedUser' = patchStoredUser storedUser teamId userLocale uid + notif = IdPDeleted uid idp' + (mails, logs, _res) <- runInterpreters [storedUser'] teamMap teamTemplates branding $ do + sendSAMLIdPChanged notif + + assertNoWarnLogs logs + + length mails `shouldBe` 1 + let mail = head mails + assertCommonMailAttributes mail textParts.subject + assertMailTextPartWithFile mail textParts.deleted + + it "should send an email on IdPUpdated" $ do + idpOld :: IdP <- liftIO $ generate arbitrary + idpNew :: IdP <- liftIO $ generate arbitrary + storedUser :: StoredUser <- liftIO . generate $ arbitrary `suchThat` (isJust . (.email)) + let idpOld' = patchIdP idpOld teamId + idpNew' = + (patchIdP idpNew teamId) + { _idpMetadata = + idpNew._idpMetadata + { _edCertAuthnResponse = NE.fromList newCerts + } + } + storedUser' = patchStoredUser storedUser teamId userLocale uid + notif = IdPUpdated uid idpOld' idpNew' + (mails, logs, _res) <- runInterpreters [storedUser'] teamMap teamTemplates branding $ do + sendSAMLIdPChanged notif + + assertNoWarnLogs logs + + length mails `shouldBe` 1 + let mail = head mails + assertCommonMailAttributes mail textParts.subject + assertMailTextPartWithFile mail textParts.updated + + describe "logic" $ do + prop "should not send to non-management roles" $ + \idp (StoredUserWithEmail storedUser) (OtherTeamRole role) uid teamId -> do + let idp' = patchIdP idp teamId + storedUser' = patchStoredUser storedUser teamId (parseLocalUnsafe "en") uid + notif = IdPCreated (Just uid) idp' + teamMember :: TeamMember = mkTeamMember uid (rolePermissions role) Nothing UserLegalHoldDisabled + teamMap :: Map TeamId [TeamMember] = Map.singleton teamId [teamMember] + + (mails, logs, _res) <- runInterpreters [storedUser'] teamMap teamTemplates branding $ do + sendSAMLIdPChanged notif + + assertNoWarnLogs logs + + length mails `shouldBe` 0 + + prop "should send to team managers" $ + \idp (StoredUserWithEmail storedUser) (TeamManagementRole role) uid teamId -> do + let idp' = patchIdP idp teamId + storedUser' = patchStoredUser storedUser teamId (parseLocalUnsafe "en") uid + notif = IdPCreated (Just uid) idp' + teamMember :: TeamMember = mkTeamMember uid (rolePermissions role) Nothing UserLegalHoldDisabled + teamMap :: Map TeamId [TeamMember] = Map.singleton teamId [teamMember] + + (mails, logs, _res) <- runInterpreters [storedUser'] teamMap teamTemplates branding $ do + sendSAMLIdPChanged notif + + assertNoWarnLogs logs + + length mails `shouldBe` 1 + + prop ("can send to multiple receivers") $ + \idp (TestTeam tid users) uid -> do + let idp' = patchIdP idp tid + notif = IdPCreated (Just uid) idp' + teamMap :: Map TeamId [TeamMember] = Map.singleton tid (snd <$> users) + adminsAndOwners :: [(StoredUser, TeamMember)] = + filter + ( \(_u, tm) -> + permissionsRole (Wire.API.Team.Member.getPermissions tm) `elem` (Just <$> teamManagementRoles) + ) + users + + (mails, logs, _res) <- runInterpreters (fst <$> users) teamMap teamTemplates branding $ do + sendSAMLIdPChanged notif + + assertNoWarnLogs logs + + length mails `shouldBe` length adminsAndOwners + let receiverAddresses :: [Text] = addressEmail <$> concatMap (.mailTo) mails + expectedAddresses :: [Text] = fromEmail . fromJust . email . fst <$> adminsAndOwners + length receiverAddresses `shouldBe` length adminsAndOwners + Set.fromList receiverAddresses `shouldBe` Set.fromList expectedAddresses + +-- Templating issues are logged on level `Warn` +assertNoWarnLogs :: (Show b, Eq b) => [(Level, b)] -> Expectation +assertNoWarnLogs logs = filter (\(level, _) -> level > Info) logs `shouldBe` mempty + +newtype OtherTeamRole = OtherTeamRole Role + deriving (Show) + +instance Arbitrary OtherTeamRole where + arbitrary = OtherTeamRole <$> elements ([minBound .. maxBound] \\ [RoleAdmin, RoleOwner]) + +newtype TeamManagementRole = TeamManagementRole Role + deriving (Show) + +instance Arbitrary TeamManagementRole where + arbitrary = TeamManagementRole <$> elements teamManagementRoles + +teamManagementRoles :: [Role] +teamManagementRoles = [RoleAdmin, RoleOwner] + +data TestTeam = TestTeam TeamId [(StoredUser, TeamMember)] + deriving (Show) + +instance Arbitrary TestTeam where + arbitrary = do + teamId :: TeamId <- arbitrary + users :: [StoredUserWithEmail] <- + (\(StoredUserWithEmail r) -> StoredUserWithEmail r {teamId = Just teamId}) + <$$> arbitrary + teamMbrs <- mapM (\(StoredUserWithEmail u) -> makeTeamMember u) users + pure $ TestTeam teamId (zip (getStoredUser <$> users) teamMbrs) + where + makeTeamMember :: StoredUser -> Gen TeamMember + makeTeamMember user = do + userRole :: Role <- arbitrary + mkTeamMember user.id (rolePermissions userRole) <$> arbitrary <*> arbitrary + +newtype StoredUserWithEmail = StoredUserWithEmail {getStoredUser :: StoredUser} + deriving (Show) + +instance Arbitrary StoredUserWithEmail where + arbitrary = + StoredUserWithEmail + <$> arbitrary + `suchThat` (isJust . (.email)) + +patchIdP :: IdPConfig WireIdP -> TeamId -> IdPConfig WireIdP +patchIdP idp teamId = + idp + { _idpId = IdPId . fromJust . UUID.fromString $ "574ddfb0-4e50-2bff-e924-33ee2b9f7064", + _idpMetadata = + idp._idpMetadata + { _edIssuer = Issuer . either (error . show) Imports.id $ parseURI strictURIParserOptions "https://issuer.example.com/realm", + _edRequestURI = either (error . show) Imports.id $ parseURI strictURIParserOptions "https://saml-endpoint.example.com/auth" + }, + _idpExtraInfo = + idp._idpExtraInfo + { _team = teamId + } + } + +patchStoredUser :: StoredUser -> TeamId -> Locale -> UserId -> StoredUser +patchStoredUser storedUser teamId userLocale uid = + (storedUser :: StoredUser) + { id = uid, + teamId = Just teamId, + language = Just userLocale.lLanguage, + country = userLocale.lCountry, + email = Just $ unsafeEmailAddress "some-user" "example.com" + } + +readTextPartFile :: FilePath -> IO TL.Text +readTextPartFile file = TL.stripEnd <$> TL.readFile ("test" "resources" "mails" file) + +assertCommonMailAttributes :: Mail -> LText -> IO () +assertCommonMailAttributes mail expectedSubject = do + mail.mailFrom + `shouldBe` Address + { addressName = Just "Wire", + addressEmail = "wire@example.com" + } + mail.mailTo + `shouldBe` [ Address + { addressName = Nothing, + addressEmail = "some-user@example.com" + } + ] + mail.mailCc `shouldBe` [] + mail.mailBcc `shouldBe` [] + Set.fromList mail.mailHeaders + `shouldBe` Set.fromList + [ ("Subject", TL.toStrict expectedSubject), + ("X-Zeta-Purpose", "IdPConfigChange") + ] + +assertMailTextPartWithFile :: Mail -> LText -> IO () +assertMailTextPartWithFile mail expectedTextPart = do + let textPart = + fromMaybe (error "No text part found") $ + find (\p -> p.partType == "text/plain; charset=utf-8") (head mail.mailParts) + case textPart.partContent of + PartContent content -> (decodeUtf8 content) `shouldBe` expectedTextPart + NestedParts ns -> error $ "Enexpected NestedParts: " ++ show ns + +-- | Records logs and mails +runInterpreters :: + [StoredUser] -> + Map TeamId [TeamMember] -> + Localised TeamTemplates -> + Map Text Text -> + Sem + '[ SAMLEmailSubsystem, + TeamSubsystem, + Email.EmailSubsystem, + UserStore, + State [StoredUser], + GalleyAPIAccess, + Logger (Logger.Msg -> Logger.Msg), + EmailSending, + State [Mail], + Embed IO + ] + a -> + IO ([Mail], [(Level, LByteString)], a) +runInterpreters users teamMap teamTemplates branding action = do + lr <- newLogRecorder + (mails, (_userState, res)) <- + runM + . runState @[Mail] [] -- Use runState to capture and return the Mail state + . recordingEmailSendingInterpreter + . recordLogs lr + . miniGalleyAPIAccess teamMap def + . runState @[StoredUser] users + . inMemoryUserStoreInterpreter + . emailSubsystemInterpreter undefined teamTemplates branding + . interpretTeamSubsystemToGalleyAPI + . samlEmailSubsystemInterpreter + $ action + logs <- readIORef lr.recordedLogs + pure (mails, logs, res) diff --git a/libs/wire-subsystems/wire-subsystems.cabal b/libs/wire-subsystems/wire-subsystems.cabal index 000f00229ed..ec8fb5eba2b 100644 --- a/libs/wire-subsystems/wire-subsystems.cabal +++ b/libs/wire-subsystems/wire-subsystems.cabal @@ -317,6 +317,8 @@ library Wire.RateLimit Wire.RateLimit.Interpreter Wire.Rpc + Wire.SAMLEmailSubsystem + Wire.SAMLEmailSubsystem.Interpreter Wire.ScimSubsystem Wire.ScimSubsystem.Error Wire.ScimSubsystem.Interpreter @@ -397,6 +399,7 @@ library , containers , cql , crypton + , crypton-x509 , currency-codes , data-default , data-timeout @@ -522,6 +525,7 @@ test-suite wire-subsystems-tests Wire.NotificationSubsystem.InterpreterSpec Wire.PropertySubsystem.InterpreterSpec Wire.RateLimited.InterpreterSpec + Wire.SAMLEmailSubsystem.InterpreterSpec Wire.ScimSubsystem.InterpreterSpec Wire.TeamCollaboratorsSubsystem.InterpreterSpec Wire.TeamInvitationSubsystem.InterpreterSpec @@ -536,6 +540,9 @@ test-suite wire-subsystems-tests build-tool-depends: hspec-discover:hspec-discover build-depends: + , crypton-x509 + , crypton-x509-store + , filepath , hspec , QuickCheck , quickcheck-instances diff --git a/services/brig/src/Brig/API/Internal.hs b/services/brig/src/Brig/API/Internal.hs index f025c414859..53a74652d96 100644 --- a/services/brig/src/Brig/API/Internal.hs +++ b/services/brig/src/Brig/API/Internal.hs @@ -122,6 +122,7 @@ import Wire.PasswordResetCodeStore (PasswordResetCodeStore) import Wire.PropertySubsystem import Wire.RateLimit import Wire.Rpc +import Wire.SAMLEmailSubsystem (SAMLEmailSubsystem, sendSAMLIdPChanged) import Wire.Sem.Concurrency import Wire.Sem.Now (Now) import Wire.Sem.Random (Random) @@ -180,7 +181,8 @@ servantSitemap :: Member (Input AuthenticationSubsystemConfig) r, Member Now r, Member CryptoSign r, - Member Random r + Member Random r, + Member SAMLEmailSubsystem r ) => ServerT BrigIRoutes.API (Handler r) servantSitemap = @@ -198,6 +200,7 @@ servantSitemap = :<|> federationRemotesAPI :<|> Provider.internalProviderAPI :<|> enterpriseLoginApi + :<|> samlIdPApi istatusAPI :: forall r. ServerT BrigIRoutes.IStatusAPI (Handler r) istatusAPI = Named @"get-status" (pure NoContent) @@ -517,6 +520,9 @@ enterpriseLoginApi = :<|> Named @"domain-registration-delete" (fmap (const NoContent) . lift . liftSem . deleteDomain) :<|> Named @"domain-registration-get" getDomainRegistrationH +samlIdPApi :: (Member SAMLEmailSubsystem r) => ServerT SAMLIdPAPI (Handler r) +samlIdPApi = Named @"send-idp-changed-email" (lift . liftSem . sendSAMLIdPChanged) + --------------------------------------------------------------------------- -- Handlers diff --git a/services/brig/src/Brig/App.hs b/services/brig/src/Brig/App.hs index cbdcbe1469f..20cb7da4257 100644 --- a/services/brig/src/Brig/App.hs +++ b/services/brig/src/Brig/App.hs @@ -114,7 +114,7 @@ import Brig.Queue.Stomp qualified as Stomp import Brig.Queue.Types import Brig.Schema.Run qualified as Migrations import Brig.Team.Template -import Brig.Template (InvitationUrlTemplates (..), Localised, genTemplateBranding, genTemplateBrandingMap) +import Brig.Template (InvitationUrlTemplates (..), genTemplateBranding, genTemplateBrandingMap) import Brig.User.Search.Index (IndexEnv (..), MonadIndexIO (..), runIndexIO) import Brig.User.Template import Cassandra (runClient) @@ -165,7 +165,7 @@ import Wire.API.User.Identity import Wire.AuthenticationSubsystem.Config (ZAuthEnv) import Wire.AuthenticationSubsystem.Config qualified as AuthenticationSubsystem import Wire.EmailSending.SMTP qualified as SMTP -import Wire.EmailSubsystem.Template (TemplateBranding, forLocale) +import Wire.EmailSubsystem.Template (Localised, TemplateBranding, forLocale) import Wire.EmailSubsystem.Templates.User import Wire.ExternalAccess.External import Wire.RateLimit.Interpreter @@ -239,7 +239,7 @@ newEnv opts = do ext <- initExtGetManager utp <- loadUserTemplates opts ptp <- loadProviderTemplates opts - ttp <- loadTeamTemplates opts + ttp <- loadTeamTemplatesWithBrigOpts opts let branding = genTemplateBranding . Opt.templateBranding . Opt.general . Opt.emailSMS $ opts brandingAsMap = genTemplateBrandingMap . Opt.templateBranding . Opt.general . Opt.emailSMS $ opts (emailAWSOpts, emailSMTP) <- emailConn lgr $ Opt.email (Opt.emailSMS opts) diff --git a/services/brig/src/Brig/CanonicalInterpreter.hs b/services/brig/src/Brig/CanonicalInterpreter.hs index 727526a406b..1ebea4fe9d1 100644 --- a/services/brig/src/Brig/CanonicalInterpreter.hs +++ b/services/brig/src/Brig/CanonicalInterpreter.hs @@ -109,6 +109,8 @@ import Wire.PropertySubsystem.Interpreter import Wire.RateLimit import Wire.RateLimit.Interpreter import Wire.Rpc +import Wire.SAMLEmailSubsystem +import Wire.SAMLEmailSubsystem.Interpreter import Wire.Sem.Concurrency import Wire.Sem.Concurrency.IO import Wire.Sem.Delay @@ -163,7 +165,8 @@ type BrigCanonicalEffects = -- | These effects have interpreters which don't depend on each other type BrigLowerLevelEffects = - '[ TeamSubsystem, + '[ SAMLEmailSubsystem, + TeamSubsystem, TeamCollaboratorsStore, AppStore, EmailSubsystem, @@ -393,6 +396,7 @@ runBrigToIO e (AppT ma) = do . interpretAppStoreToPostgres . interpretTeamCollaboratorsStoreToPostgres . interpretTeamSubsystemToGalleyAPI + . samlEmailSubsystemInterpreter . interpretTeamCollaboratorsSubsystem . userSubsystemInterpreter . interpretUserGroupSubsystem diff --git a/services/brig/src/Brig/Options.hs b/services/brig/src/Brig/Options.hs index 2738d88c31a..8f01ca8394c 100644 --- a/services/brig/src/Brig/Options.hs +++ b/services/brig/src/Brig/Options.hs @@ -58,6 +58,7 @@ import Wire.API.User import Wire.AuthenticationSubsystem.Config (ZAuthSettings) import Wire.AuthenticationSubsystem.Cookie.Limit import Wire.EmailSending.SMTP (SMTPConnType (..)) +import Wire.EmailSubsystem.Template (TeamOpts) import Wire.RateLimit.Interpreter data ElasticSearchOpts = ElasticSearchOpts @@ -222,22 +223,6 @@ data ProviderOpts = ProviderOpts instance FromJSON ProviderOpts -data TeamOpts = TeamOpts - { -- | Team Invitation URL template - tInvitationUrl :: !Text, - -- | Existing User Invitation URL template - tExistingUserInvitationUrl :: !Text, - -- | Team Activation URL template - tActivationUrl :: !Text, - -- | Team Creator Welcome URL - tCreatorWelcomeUrl :: !Text, - -- | Team Member Welcome URL - tMemberWelcomeUrl :: !Text - } - deriving (Show, Generic) - -instance FromJSON TeamOpts - data EmailOpts = EmailAWS EmailAWSOpts | EmailSMTP EmailSMTPOpts diff --git a/services/brig/src/Brig/Provider/Template.hs b/services/brig/src/Brig/Provider/Template.hs index 50a0eab4c93..7de713abb89 100644 --- a/services/brig/src/Brig/Provider/Template.hs +++ b/services/brig/src/Brig/Provider/Template.hs @@ -26,13 +26,13 @@ module Brig.Provider.Template where import Brig.Options -import Brig.Template import Data.ByteString.Conversion (fromByteString) import Data.Misc (HttpsUrl) import Data.Text.Encoding (encodeUtf8) import Data.Text.Template import Imports import Wire.API.User.Identity +import Wire.EmailSubsystem.Template hiding (readTemplate, readText) import Wire.EmailSubsystem.Templates.User data ProviderTemplates = ProviderTemplates diff --git a/services/brig/src/Brig/Team/Template.hs b/services/brig/src/Brig/Team/Template.hs index 2d2526d558e..caffd40e85d 100644 --- a/services/brig/src/Brig/Team/Template.hs +++ b/services/brig/src/Brig/Team/Template.hs @@ -19,52 +19,21 @@ module Brig.Team.Template ( TeamTemplates (..), InvitationEmailTemplate (..), MemberWelcomeEmailTemplate (..), - loadTeamTemplates, + loadTeamTemplatesWithBrigOpts, ) where import Brig.Options -import Brig.Template -import Data.Text.Template import Imports +import Wire.EmailSubsystem.Template import Wire.EmailSubsystem.Templates.Team -loadTeamTemplates :: Opts -> IO (Localised TeamTemplates) -loadTeamTemplates o = readLocalesDir defLocale (templateDir gOptions) "team" $ \fp -> - TeamTemplates - <$> ( InvitationEmailTemplate tUrl - <$> readTemplate fp "email/invitation-subject.txt" - <*> readTemplate fp "email/invitation.txt" - <*> readTemplate fp "email/invitation.html" - <*> pure (emailSender gOptions) - <*> readText fp "email/sender.txt" - ) - <*> ( InvitationEmailTemplate tExistingUrl - <$> readTemplate fp "email/migration-subject.txt" - <*> readTemplate fp "email/migration.txt" - <*> readTemplate fp "email/migration.html" - <*> pure (emailSender gOptions) - <*> readText fp "email/sender.txt" - ) - <*> ( MemberWelcomeEmailTemplate (tMemberWelcomeUrl tOptions) - <$> readTemplate fp "email/new-member-welcome-subject.txt" - <*> readTemplate fp "email/new-member-welcome.txt" - <*> readTemplate fp "email/new-member-welcome.html" - <*> pure (emailSender gOptions) - <*> readText fp "email/sender.txt" - ) - <*> ( NewTeamOwnerWelcomeEmailTemplate (tCreatorWelcomeUrl tOptions) - <$> readTemplate fp "email/new-team-owner-welcome-subject.txt" - <*> readTemplate fp "email/new-team-owner-welcome.txt" - <*> readTemplate fp "email/new-team-owner-welcome.html" - <*> pure (emailSender gOptions) - <*> readText fp "email/sender.txt" - ) - where - gOptions = o.emailSMS.general - tOptions = o.emailSMS.team - tUrl = template tOptions.tInvitationUrl - tExistingUrl = template tOptions.tExistingUserInvitationUrl - defLocale = defaultTemplateLocale o.settings - readTemplate = readTemplateWithDefault (templateDir gOptions) defLocale "team" - readText = readTextWithDefault (templateDir gOptions) defLocale "team" +-- FUTUREWORK: This can be inlined once the `API.Template` have been migrated +-- to wire-subsystem unit tests. +loadTeamTemplatesWithBrigOpts :: Opts -> IO (Localised TeamTemplates) +loadTeamTemplatesWithBrigOpts o = + loadTeamTemplates + o.emailSMS.team + o.emailSMS.general.templateDir + (defaultTemplateLocale o.settings) + (emailSender o.emailSMS.general) diff --git a/services/brig/src/Brig/Template.hs b/services/brig/src/Brig/Template.hs index 778c59815a3..0b530261d05 100644 --- a/services/brig/src/Brig/Template.hs +++ b/services/brig/src/Brig/Template.hs @@ -20,26 +20,15 @@ -- | Common templating utilities. module Brig.Template ( InvitationUrlTemplates (..), - Localised, - readLocalesDir, - readTemplateWithDefault, - readTextWithDefault, genTemplateBranding, genTemplateBrandingMap, ) where import Brig.Options -import Control.Exception (catchJust) -import Data.ByteString qualified as BS import Data.Map.Strict qualified as Map -import Data.Text (pack, unpack) -import Data.Text.Encoding qualified as T -import Data.Text.Template (Template, template) -import Imports hiding (readFile) -import System.IO.Error (isDoesNotExistError) -import Wire.API.User -import Wire.EmailSubsystem.Template (Localised (Localised)) +import Data.Text.Template (Template) +import Imports data InvitationUrlTemplates = InvitationUrlTemplates { personalUser :: Template, @@ -49,90 +38,6 @@ data InvitationUrlTemplates = InvitationUrlTemplates -- | See 'genTemplateBranding'. type TemplateBranding = Text -> Text -readLocalesDir :: - -- | Default locale. - Locale -> - -- | Base directory. - FilePath -> - -- | Template directory (user, provider, team) - FilePath -> - -- | Handler to load the templates for a locale. - (FilePath -> IO a) -> - IO (Localised a) -readLocalesDir defLocale base typ load = do - def <- load (basePath defLocaleDir) - Localised (defLocale, def) <$> do - -- Ignore locales if no such directory exist for the locale - ls <- - filterM (doesDirectoryExist . basePath) - . filter (/= defLocaleDir) - =<< listDirectory base - Map.fromList . zip (map readLocale ls) <$> mapM (load . basePath) ls - where - basePath :: FilePath -> FilePath - basePath loc = base <> "/" <> loc <> "/" <> typ - defLocaleDir :: FilePath - defLocaleDir = unpack (locToText defLocale) - readLocale :: FilePath -> Locale - readLocale l = - fromMaybe (error ("Invalid locale: " ++ show l)) $ - parseLocale (pack l) - -readTemplateWithDefault :: - FilePath -> - Locale -> - FilePath -> - String -> - FilePath -> - IO Template -readTemplateWithDefault = readWithDefault readTemplate - -readTemplate :: FilePath -> IO Template -readTemplate f = template <$> readText f - -readFile :: FilePath -> IO Text -readFile f = T.decodeUtf8 <$> BS.readFile f - -readTextWithDefault :: - FilePath -> - Locale -> - FilePath -> - String -> - FilePath -> - IO Text -readTextWithDefault = readWithDefault readText - -readText :: FilePath -> IO Text -readText f = - catchJust - (\e -> if isDoesNotExistError e then Just () else Nothing) - (readFile f) - (\_ -> error $ "Missing file: '" ++ f) - -readWithDefault :: - (String -> IO a) -> - FilePath -> - Locale -> - FilePath -> - String -> - FilePath -> - IO a -readWithDefault readFn baseDir defLoc typ prefix name = do - exists <- doesFileExist fileToLoad - if exists - then readFn fileToLoad - else readFn fallback - where - fileToLoad = prefix <> "/" <> name - fallback = - baseDir - <> "/" - <> unpack (locToText defLoc) - <> "/" - <> typ - <> "/" - <> name - -- | Function to be applied everywhere where email/sms/call -- templating is used (ensures that placeholders are replaced -- by the appropriate branding, typically Wire) diff --git a/services/brig/src/Brig/User/Template.hs b/services/brig/src/Brig/User/Template.hs index ff5304519e9..ea7193faadf 100644 --- a/services/brig/src/Brig/User/Template.hs +++ b/services/brig/src/Brig/User/Template.hs @@ -18,9 +18,9 @@ module Brig.User.Template (loadUserTemplates) where import Brig.Options qualified as Opt -import Brig.Template import Data.Text.Template import Imports +import Wire.EmailSubsystem.Template hiding (readTemplate, readText) import Wire.EmailSubsystem.Templates.User loadUserTemplates :: Opt.Opts -> IO (Localised UserTemplates) diff --git a/services/brig/test/integration/API/Template.hs b/services/brig/test/integration/API/Template.hs index d5ef52cc0e2..4c697b88ed5 100644 --- a/services/brig/test/integration/API/Template.hs +++ b/services/brig/test/integration/API/Template.hs @@ -2,7 +2,7 @@ module API.Template (tests) where import Bilge import Brig.Options -import Brig.Team.Template (loadTeamTemplates) +import Brig.Team.Template (loadTeamTemplatesWithBrigOpts) import Brig.Template import Brig.User.Template (loadUserTemplates) import Data.Code @@ -33,9 +33,12 @@ import Wire.EmailSubsystem.Template import Wire.EmailSubsystem.Templates.Team import Wire.EmailSubsystem.Templates.User +-- FUTUREWORK: This does not have to be an integration test. It could be +-- covered by unit tests in wire-subsystems. Then, the helper functions can be +-- privatized. tests :: Opts -> Manager -> IO TestTree tests opts m = do - team <- liftIO $ loadTeamTemplates opts + team <- liftIO $ loadTeamTemplatesWithBrigOpts opts user <- liftIO $ loadUserTemplates opts let teamTemplates = Map.assocs $ uncurry Map.insert team.locDefault team.locOther userTemplates = Map.assocs $ uncurry Map.insert user.locDefault user.locOther diff --git a/services/spar/src/Spar/API.hs b/services/spar/src/Spar/API.hs index f36f6f80660..bb90d150117 100644 --- a/services/spar/src/Spar/API.hs +++ b/services/spar/src/Spar/API.hs @@ -121,6 +121,7 @@ import qualified Spar.Sem.VerdictFormatStore as VerdictFormatStore import System.Logger (Msg) import qualified System.Logger as Log import qualified URI.ByteString as URI +import Wire.API.Routes.Internal.Brig (IdpChangedNotification (IdPCreated, IdPDeleted, IdPUpdated)) import Wire.API.Routes.Internal.Spar import Wire.API.Routes.Named import Wire.API.Routes.Public (ZHostValue) @@ -244,7 +245,7 @@ apiIDP opts = :<|> Named @"idp-create@v7" (idpCreateV7 opts.saml) :<|> Named @"idp-create" (idpCreate opts.saml) -- post, created :<|> Named @"idp-update" (idpUpdate opts.saml) -- put, okay - :<|> Named @"idp-delete" idpDelete -- delete, no content + :<|> Named @"idp-delete" (idpDelete opts.saml) -- delete, no content apiINTERNAL :: ( Member ScimTokenStore r, @@ -565,11 +566,12 @@ idpDelete :: Member IdPRawMetadataStore r, Member (Error SparError) r ) => + SAML.Config -> Maybe UserId -> SAML.IdPId -> Maybe Bool -> Sem r NoContent -idpDelete mbzusr idpid (fromMaybe False -> purge) = withDebugLog "idpDelete" (const Nothing) $ do +idpDelete samlConfig mbzusr idpid (fromMaybe False -> purge) = withDebugLog "idpDelete" (const Nothing) $ do idp <- IdPConfigStore.getConfig idpid (zusr, teamId) <- authorizeIdP mbzusr idp let issuer = idp ^. SAML.idpMetadata . SAML.edIssuer @@ -587,6 +589,9 @@ idpDelete mbzusr idpid (fromMaybe False -> purge) = withDebugLog "idpDelete" (co do IdPConfigStore.deleteConfig idp IdPRawMetadataStore.delete idpid + when (SAML.isMultiIngressConfig samlConfig) $ + BrigAccess.sendSAMLIdPChangedEmail $ + IdPDeleted zusr idp logIdPAction "IdP deleted" idp @@ -673,6 +678,9 @@ idpCreate samlConfig tid zUser uncheckedMbHost (IdPMetadataValue rawIdpMetadata IdPConfigStore.insertConfig idp forM_ mReplaces $ \replaces -> IdPConfigStore.setReplacedBy (Replaced replaces) (Replacing (idp ^. SAML.idpId)) + when (SAML.isMultiIngressConfig samlConfig) $ + BrigAccess.sendSAMLIdPChangedEmail $ + IdPCreated zUser idp logIdPAction "IdP created" idp @@ -835,7 +843,7 @@ idpUpdate :: Sem r IdP idpUpdate samlConfig zusr uncheckedMbHost (IdPMetadataValue raw xml) = let mbHost = filterMultiIngressZHost (samlConfig._cfgDomainConfigs) uncheckedMbHost - in idpUpdateXML zusr mbHost raw xml + in idpUpdateXML samlConfig zusr mbHost raw xml idpUpdateXML :: ( Member Random r, @@ -846,6 +854,7 @@ idpUpdateXML :: Member IdPRawMetadataStore r, Member (Error SparError) r ) => + SAML.Config -> Maybe UserId -> Maybe ZHostValue -> Text -> @@ -853,8 +862,8 @@ idpUpdateXML :: SAML.IdPId -> Maybe (Range 1 32 Text) -> Sem r IdP -idpUpdateXML zusr mDomain raw idpmeta idpid mHandle = withDebugLog "idpUpdateXML" (Just . show . (^. SAML.idpId)) $ do - (teamid, idp, previousIdP) <- validateIdPUpdate zusr idpmeta idpid +idpUpdateXML samlConfig mbZUsr mDomain raw idpmeta idpid mHandle = withDebugLog "idpUpdateXML" (Just . show . (^. SAML.idpId)) $ do + (zUsr, teamid, idp, previousIdP) <- validateIdPUpdate mbZUsr idpmeta idpid GalleyAccess.assertSSOEnabled teamid guardMultiIngressDuplicateDomain teamid mDomain idpid IdPRawMetadataStore.store (idp ^. SAML.idpId) raw @@ -872,7 +881,10 @@ idpUpdateXML zusr mDomain raw idpmeta idpid mHandle = withDebugLog "idpUpdateXML WireIdPAPIV1 -> Nothing WireIdPAPIV2 -> Just teamid forM_ (idp'' ^. SAML.idpExtraInfo . oldIssuers) (flip IdPConfigStore.deleteIssuer mbteamid) - logIdPUpdate idp'' previousIdP + when (SAML.isMultiIngressConfig samlConfig) $ + BrigAccess.sendSAMLIdPChangedEmail $ + IdPUpdated zUsr previousIdP idp'' + logIdPUpdate zUsr idp'' previousIdP pure idp'' where -- Ensure that the domain is not in use by an existing IDP @@ -896,8 +908,8 @@ idpUpdateXML zusr mDomain raw idpmeta idpid mHandle = withDebugLog "idpUpdateXML -- We cannot simply call `logIdPAction` here, because we need diffs for -- some values (old vs. new) - logIdPUpdate :: (Member (Logger (Msg -> Msg)) r) => IdP -> IdP -> Sem r () - logIdPUpdate idp previousIdP = + logIdPUpdate :: (Member (Logger (Msg -> Msg)) r) => UserId -> IdP -> IdP -> Sem r () + logIdPUpdate zUsr idp previousIdP = let (removedCerts, newCerts) = compareNonEmpty (previousIdP ^. SAML.idpMetadata . SAML.edCertAuthnResponse) @@ -916,7 +928,7 @@ idpUpdateXML zusr mDomain raw idpmeta idpid mHandle = withDebugLog "idpUpdateXML (fromMaybe "None") (previousIdP ^. SAML.idpExtraInfo . domain) (idp ^. SAML.idpExtraInfo . domain) - . Log.field "user" (maybe "None" idToText zusr) + . Log.field "user" (idToText zUsr) . logChangeableScalar "idp-endpoint" URI.serializeURIRef' @@ -965,10 +977,10 @@ validateIdPUpdate :: Maybe UserId -> SAML.IdPMetadata -> SAML.IdPId -> - m (TeamId, IdP, IdP) -validateIdPUpdate zusr _idpMetadata _idpId = withDebugLog "validateIdPUpdate" (Just . show . (_2 %~ (^. SAML.idpId))) $ do + m (UserId, TeamId, IdP, IdP) +validateIdPUpdate mbZUsr _idpMetadata _idpId = withDebugLog "validateIdPUpdate" (Just . show . (_3 %~ (^. SAML.idpId))) $ do previousIdP <- IdPConfigStore.getConfig _idpId - (_, teamId) <- authorizeIdP zusr previousIdP + (zusr, teamId) <- authorizeIdP mbZUsr previousIdP unless (previousIdP ^. SAML.idpExtraInfo . team == teamId) $ throw errUnknownIdP _idpExtraInfo <- do @@ -998,7 +1010,7 @@ validateIdPUpdate zusr _idpMetadata _idpId = withDebugLog "validateIdPUpdate" (J let requri = _idpMetadata ^. SAML.edRequestURI enforceHttps requri - pure (teamId, SAML.IdPConfig {..}, previousIdP) + pure (zusr, teamId, SAML.IdPConfig {..}, previousIdP) where -- If the new issuer was previously used, it has to be removed from the list of old issuers, -- to prevent it from getting deleted in a later step diff --git a/services/spar/src/Spar/Intra/Brig.hs b/services/spar/src/Spar/Intra/Brig.hs index fee2e54616f..1f52cc05cdb 100644 --- a/services/spar/src/Spar/Intra/Brig.hs +++ b/services/spar/src/Spar/Intra/Brig.hs @@ -43,6 +43,7 @@ module Spar.Intra.Brig setStatus, getDefaultUserLocale, checkAdminGetTeamId, + sendSAMLIdPChangedEmail, ) where @@ -64,6 +65,7 @@ import Spar.Error import qualified System.Logger.Class as Log import Web.Cookie import Wire.API.Locale +import Wire.API.Routes.Internal.Brig (IdpChangedNotification) import Wire.API.Team.Role (Role) import Wire.API.User import Wire.API.User.Auth.ReAuth @@ -453,3 +455,9 @@ checkAdminGetTeamId uid = do case statusCode resp of 200 -> parseResponse @TeamId "brig" resp _ -> rethrow "brig" resp + +sendSAMLIdPChangedEmail :: (HasCallStack, MonadSparToBrig m) => IdpChangedNotification -> m () +sendSAMLIdPChangedEmail notif = do + resp <- call $ method POST . path "/i/idp/send-idp-changed-email" . json notif + unless (statusCode resp == 200) $ + rethrow "brig" resp diff --git a/services/spar/src/Spar/Sem/BrigAccess.hs b/services/spar/src/Spar/Sem/BrigAccess.hs index 85307863593..1d82622eecd 100644 --- a/services/spar/src/Spar/Sem/BrigAccess.hs +++ b/services/spar/src/Spar/Sem/BrigAccess.hs @@ -41,6 +41,7 @@ module Spar.Sem.BrigAccess setStatus, getDefaultUserLocale, checkAdminGetTeamId, + sendSAMLIdPChangedEmail, ) where @@ -55,6 +56,7 @@ import Polysemy import qualified SAML2.WebSSO as SAML import Web.Cookie import Wire.API.Locale +import Wire.API.Routes.Internal.Brig (IdpChangedNotification) import Wire.API.Team.Role import Wire.API.User import Wire.API.User.RichInfo as RichInfo @@ -82,5 +84,6 @@ data BrigAccess m a where SetStatus :: UserId -> AccountStatus -> BrigAccess m () GetDefaultUserLocale :: BrigAccess m Locale CheckAdminGetTeamId :: UserId -> BrigAccess m TeamId + SendSAMLIdPChangedEmail :: IdpChangedNotification -> BrigAccess m () makeSem ''BrigAccess diff --git a/services/spar/src/Spar/Sem/BrigAccess/Http.hs b/services/spar/src/Spar/Sem/BrigAccess/Http.hs index b3623597d39..b2f8adaaf66 100644 --- a/services/spar/src/Spar/Sem/BrigAccess/Http.hs +++ b/services/spar/src/Spar/Sem/BrigAccess/Http.hs @@ -65,3 +65,4 @@ brigAccessToHttp mgr req = SetStatus itlu a -> Intra.setStatus itlu a GetDefaultUserLocale -> Intra.getDefaultUserLocale CheckAdminGetTeamId itlu -> Intra.checkAdminGetTeamId itlu + SendSAMLIdPChangedEmail notif -> Intra.sendSAMLIdPChangedEmail notif diff --git a/services/spar/test/Test/Spar/Saml/IdPSpec.hs b/services/spar/test/Test/Spar/Saml/IdPSpec.hs index ac0c67cf8e7..fa58c826602 100644 --- a/services/spar/test/Test/Spar/Saml/IdPSpec.hs +++ b/services/spar/test/Test/Spar/Saml/IdPSpec.hs @@ -12,6 +12,7 @@ import qualified Data.Text.Lazy.IO as TL import Imports import Polysemy import qualified Polysemy.Error +import Polysemy.State import Polysemy.TinyLog import SAML2.WebSSO import qualified SAML2.WebSSO as SAML @@ -35,6 +36,7 @@ import Test.QuickCheck import qualified Text.XML.DSig as DSig import URI.ByteString (parseURI, strictURIParserOptions) import URI.ByteString.QQ (uri) +import Wire.API.Routes.Internal.Brig (IdpChangedNotification (..)) import Wire.API.User (User (..)) import Wire.API.User.IdentityProvider (IdPMetadataInfo (..), WireIdPAPIVersion (..)) import Wire.Sem.Logger.TinyLog (LogRecorder (..), newLogRecorder, recordLogs) @@ -94,315 +96,411 @@ spec = . parseURI strictURIParserOptions . fromString $ idpEndpointString - in describe "SAML IdP change logging" $ do - describe "idp-create" $ do - it "should log IdP creation" $ do - idPMetadataInfo :: IdPMetadataInfo <- generate arbitrary - let idPMetadataInfo' = - idPMetadataInfo - { _idpMetadataRecord = - (idPMetadataInfo._idpMetadataRecord) - { SAML._edIssuer = issuer, - SAML._edRequestURI = idpEndpoint - } - } - - expectedLogLine = - ( Info, - "IdP created, team=" - <> (TL.encodeUtf8 . TL.fromStrict . idToText) tid - <> ", idpId=00000000-0000-0000-0000-000000000000, issuer=" - <> fromString issuerString - <> ", domain=None, user=" - <> (TL.encodeUtf8 . TL.fromStrict . idToText . fromJust) zUser - <> ", certificates=Issuer: CN=accounts.accesscontrol.windows.net; Subject: CN=accounts.accesscontrol.windows.net; SHA1 Fingerprint: 15:28:A6:B8:5A:C5:36:80:B4:B0:95:C6:9A:FD:77:9C:D6:5C:78:37" - <> ", idp-endpoint=" - <> fromString idpEndpointString - <> ", replaces=None" - <> "\n" - ) - - forM_ [(minBound :: WireIdPAPIVersion) .. maxBound] $ \apiVersion -> do - (logs, _res) <- - interpretWithLoggingMock - Nothing - (idpCreate singleIngressSamlConfig tid zUser host idPMetadataInfo' Nothing (Just apiVersion) idpHandle) + in do + describe "SAML IdP change logging" $ do + describe "idp-create" $ do + it "should log IdP creation" $ do + idPMetadataInfo :: IdPMetadataInfo <- generate arbitrary + let idPMetadataInfo' = + idPMetadataInfo + { _idpMetadataRecord = + (idPMetadataInfo._idpMetadataRecord) + { SAML._edIssuer = issuer, + SAML._edRequestURI = idpEndpoint + } + } + + expectedLogLine = + ( Info, + "IdP created, team=" + <> (TL.encodeUtf8 . TL.fromStrict . idToText) tid + <> ", idpId=00000000-0000-0000-0000-000000000000, issuer=" + <> fromString issuerString + <> ", domain=None, user=" + <> (TL.encodeUtf8 . TL.fromStrict . idToText . fromJust) zUser + <> ", certificates=Issuer: CN=accounts.accesscontrol.windows.net; Subject: CN=accounts.accesscontrol.windows.net; SHA1 Fingerprint: 15:28:A6:B8:5A:C5:36:80:B4:B0:95:C6:9A:FD:77:9C:D6:5C:78:37" + <> ", idp-endpoint=" + <> fromString idpEndpointString + <> ", replaces=None" + <> "\n" + ) + + forM_ [(minBound :: WireIdPAPIVersion) .. maxBound] $ \apiVersion -> do + (logs, _notifs, _res) <- + interpretWithLoggingMock + Nothing + (idpCreate singleIngressSamlConfig tid zUser host idPMetadataInfo' Nothing (Just apiVersion) idpHandle) + logs `shouldContain` [expectedLogLine] + + (logsV7, _notifs, _res) <- + interpretWithLoggingMock + Nothing + (idpCreateV7 singleIngressSamlConfig tid zUser idPMetadataInfo' Nothing (Just apiVersion) idpHandle) + logsV7 `shouldContain` [expectedLogLine] + + it "should log IdP creation with domain for multi-ingress" $ do + idPMetadataInfo :: IdPMetadataInfo <- generate arbitrary + let idPMetadataInfo' = + idPMetadataInfo + { _idpMetadataRecord = + (idPMetadataInfo._idpMetadataRecord) + { SAML._edIssuer = issuer, + SAML._edRequestURI = idpEndpoint + } + } + + expectedLogLine :: LByteString -> LogLine + expectedLogLine domainPart = + ( Info, + "IdP created, team=" + <> (TL.encodeUtf8 . TL.fromStrict . idToText) tid + <> ", idpId=00000000-0000-0000-0000-000000000000, issuer=" + <> fromString issuerString + <> ", domain=" + <> domainPart + <> ", user=" + <> (TL.encodeUtf8 . TL.fromStrict . idToText . fromJust) zUser + <> ", certificates=Issuer: CN=accounts.accesscontrol.windows.net; Subject: CN=accounts.accesscontrol.windows.net; SHA1 Fingerprint: 15:28:A6:B8:5A:C5:36:80:B4:B0:95:C6:9A:FD:77:9C:D6:5C:78:37" + <> ", idp-endpoint=" + <> fromString idpEndpointString + <> ", replaces=None" + <> "\n" + ) + expectedLogLineWithDomain = expectedLogLine . TL.encodeUtf8 . TL.fromStrict $ miHost1AsText + expectedLogLineWithoutDomain = expectedLogLine "None" + + forM_ [(minBound :: WireIdPAPIVersion) .. maxBound] $ \apiVersion -> do + (logs, _notifs, _res) <- + interpretWithLoggingMock + Nothing + (idpCreate multiIngressSamlConfig tid zUser miHost1 idPMetadataInfo' Nothing (Just apiVersion) idpHandle) + logs `shouldContain` [expectedLogLineWithDomain] + + -- >=V7 does not bother with multi-ingress domains for IdPs as it can + -- only have one IdP per team anyways. + (logsV7, _notifs, _res) <- + interpretWithLoggingMock + Nothing + (idpCreateV7 multiIngressSamlConfig tid zUser idPMetadataInfo' Nothing (Just apiVersion) idpHandle) + logsV7 `shouldContain` [expectedLogLineWithoutDomain] + + describe "idp-delete" $ do + it "should log IdP deletion" $ do + idPMetadataInfo :: IdPMetadataInfo <- generate arbitrary + user :: User <- generate arbitrary + let idPMetadataInfo' = + idPMetadataInfo + { _idpMetadataRecord = + (idPMetadataInfo._idpMetadataRecord) + { SAML._edIssuer = issuer, + SAML._edRequestURI = idpEndpoint + } + } + + expectedLogLine = + ( Info, + "IdP deleted, team=" + <> (TL.encodeUtf8 . TL.fromStrict . idToText) tid + <> ", idpId=00000000-0000-0000-0000-000000000000, issuer=" + <> fromString issuerString + <> ", domain=None, user=" + <> (TL.encodeUtf8 . TL.fromStrict . idToText . fromJust) zUser + <> ", certificates=Issuer: CN=accounts.accesscontrol.windows.net; Subject: CN=accounts.accesscontrol.windows.net; SHA1 Fingerprint: 15:28:A6:B8:5A:C5:36:80:B4:B0:95:C6:9A:FD:77:9C:D6:5C:78:37" + <> ", idp-endpoint=" + <> fromString idpEndpointString + <> "\n" + ) + + (logs, _notifs, _res) <- interpretWithLoggingMock (Just user) $ do + idp <- idpCreate singleIngressSamlConfig tid zUser host idPMetadataInfo' Nothing apiVersionV2 idpHandle + idpDelete singleIngressSamlConfig zUser (idp._idpId) Nothing logs `shouldContain` [expectedLogLine] - (logsV7, _res) <- - interpretWithLoggingMock - Nothing - (idpCreateV7 singleIngressSamlConfig tid zUser idPMetadataInfo' Nothing (Just apiVersion) idpHandle) - logsV7 `shouldContain` [expectedLogLine] - - it "should log IdP creation with domain for multi-ingress" $ do - idPMetadataInfo :: IdPMetadataInfo <- generate arbitrary - let idPMetadataInfo' = - idPMetadataInfo - { _idpMetadataRecord = - (idPMetadataInfo._idpMetadataRecord) - { SAML._edIssuer = issuer, - SAML._edRequestURI = idpEndpoint - } - } - - expectedLogLine :: LByteString -> LogLine - expectedLogLine domainPart = - ( Info, - "IdP created, team=" - <> (TL.encodeUtf8 . TL.fromStrict . idToText) tid - <> ", idpId=00000000-0000-0000-0000-000000000000, issuer=" - <> fromString issuerString - <> ", domain=" - <> domainPart - <> ", user=" - <> (TL.encodeUtf8 . TL.fromStrict . idToText . fromJust) zUser - <> ", certificates=Issuer: CN=accounts.accesscontrol.windows.net; Subject: CN=accounts.accesscontrol.windows.net; SHA1 Fingerprint: 15:28:A6:B8:5A:C5:36:80:B4:B0:95:C6:9A:FD:77:9C:D6:5C:78:37" - <> ", idp-endpoint=" - <> fromString idpEndpointString - <> ", replaces=None" - <> "\n" - ) - expectedLogLineWithDomain = expectedLogLine . TL.encodeUtf8 . TL.fromStrict $ miHost1AsText - expectedLogLineWithoutDomain = expectedLogLine "None" - - forM_ [(minBound :: WireIdPAPIVersion) .. maxBound] $ \apiVersion -> do - (logs, _res) <- - interpretWithLoggingMock - Nothing - (idpCreate multiIngressSamlConfig tid zUser miHost1 idPMetadataInfo' Nothing (Just apiVersion) idpHandle) - logs `shouldContain` [expectedLogLineWithDomain] - - -- >=V7 does not bother with multi-ingress domains for IdPs as it can - -- only have one IdP per team anyways. - (logsV7, _res) <- - interpretWithLoggingMock - Nothing - (idpCreateV7 multiIngressSamlConfig tid zUser idPMetadataInfo' Nothing (Just apiVersion) idpHandle) - logsV7 `shouldContain` [expectedLogLineWithoutDomain] - - describe "idp-delete" $ do - it "should log IdP deletion" $ do - idPMetadataInfo :: IdPMetadataInfo <- generate arbitrary - user :: User <- generate arbitrary - let idPMetadataInfo' = - idPMetadataInfo - { _idpMetadataRecord = - (idPMetadataInfo._idpMetadataRecord) - { SAML._edIssuer = issuer, - SAML._edRequestURI = idpEndpoint - } - } - - expectedLogLine = - ( Info, - "IdP deleted, team=" - <> (TL.encodeUtf8 . TL.fromStrict . idToText) tid - <> ", idpId=00000000-0000-0000-0000-000000000000, issuer=" - <> fromString issuerString - <> ", domain=None, user=" - <> (TL.encodeUtf8 . TL.fromStrict . idToText . fromJust) zUser - <> ", certificates=Issuer: CN=accounts.accesscontrol.windows.net; Subject: CN=accounts.accesscontrol.windows.net; SHA1 Fingerprint: 15:28:A6:B8:5A:C5:36:80:B4:B0:95:C6:9A:FD:77:9C:D6:5C:78:37" - <> ", idp-endpoint=" - <> fromString idpEndpointString - <> "\n" - ) - - (logs, _res) <- interpretWithLoggingMock (Just user) $ do - idp <- idpCreate singleIngressSamlConfig tid zUser host idPMetadataInfo' Nothing apiVersionV2 idpHandle - idpDelete zUser (idp._idpId) Nothing - logs `shouldContain` [expectedLogLine] - - it "should log IdP deletion with domain for multi-ingress" $ do - idPMetadataInfo :: IdPMetadataInfo <- generate arbitrary - user :: User <- generate arbitrary - let idPMetadataInfo' = - idPMetadataInfo - { _idpMetadataRecord = - (idPMetadataInfo._idpMetadataRecord) - { SAML._edIssuer = issuer, - SAML._edRequestURI = idpEndpoint - } - } - - expectedLogLine = - ( Info, - "IdP deleted, team=" - <> (TL.encodeUtf8 . TL.fromStrict . idToText) tid - <> ", idpId=00000000-0000-0000-0000-000000000000, issuer=" - <> fromString issuerString - <> ", domain=" - <> (TL.encodeUtf8 . TL.fromStrict) miHost1AsText - <> ", user=" - <> (TL.encodeUtf8 . TL.fromStrict . idToText . fromJust) zUser - <> ", certificates=Issuer: CN=accounts.accesscontrol.windows.net; Subject: CN=accounts.accesscontrol.windows.net; SHA1 Fingerprint: 15:28:A6:B8:5A:C5:36:80:B4:B0:95:C6:9A:FD:77:9C:D6:5C:78:37" - <> ", idp-endpoint=" - <> fromString idpEndpointString - <> "\n" - ) - - (logs, _res) <- interpretWithLoggingMock (Just user) $ do - idp <- idpCreate multiIngressSamlConfig tid zUser miHost1 idPMetadataInfo' Nothing apiVersionV2 idpHandle - idpDelete zUser (idp._idpId) Nothing - logs `shouldContain` [expectedLogLine] - - describe "idp-update" $ do - it "should log IdP update" $ do - idPMetadataInfo :: IdPMetadataInfo <- generate arbitrary - user :: User <- generate arbitrary - let idPMetadataInfo' = - idPMetadataInfo - { _idpMetadataRecord = - (idPMetadataInfo._idpMetadataRecord) - { SAML._edIssuer = issuer, - SAML._edRequestURI = idpEndpoint - } - } - - expectedLogLine = - ( Info, - "IdP updated, team=" - <> (TL.encodeUtf8 . TL.fromStrict . idToText) tid - <> ", idpId=00000000-0000-0000-0000-000000000000, issuer=" - <> fromString issuerString - <> ", domain=None, user=" - <> (TL.encodeUtf8 . TL.fromStrict . idToText . fromJust) zUser - <> ", idp-endpoint=" - <> fromString idpEndpointString - <> ", certificates=Issuer: CN=accounts.accesscontrol.windows.net; Subject: CN=accounts.accesscontrol.windows.net; SHA1 Fingerprint: 15:28:A6:B8:5A:C5:36:80:B4:B0:95:C6:9A:FD:77:9C:D6:5C:78:37" - <> "\n" - ) - - (logs, _res) <- interpretWithLoggingMock (Just user) $ do - idp <- idpCreate singleIngressSamlConfig tid zUser host idPMetadataInfo' Nothing apiVersionV2 idpHandle - idpUpdate singleIngressSamlConfig zUser host idPMetadataInfo' (idp._idpId) Nothing - logs `shouldContain` [expectedLogLine] - - it "should log IdP update with domain for multi-ingress" $ do - idPMetadataInfo :: IdPMetadataInfo <- generate arbitrary - user :: User <- generate arbitrary - let idPMetadataInfo' = - idPMetadataInfo - { _idpMetadataRecord = - (idPMetadataInfo._idpMetadataRecord) - { SAML._edIssuer = issuer, - SAML._edRequestURI = idpEndpoint - } - } - - expectedLogLine = - ( Info, - "IdP updated, team=" - <> (TL.encodeUtf8 . TL.fromStrict . idToText) tid - <> ", idpId=00000000-0000-0000-0000-000000000000, issuer=" - <> fromString issuerString - <> ", domain=" - <> (TL.encodeUtf8 . TL.fromStrict) miHost1AsText - <> ", user=" - <> (TL.encodeUtf8 . TL.fromStrict . idToText . fromJust) zUser - <> ", idp-endpoint=" - <> fromString idpEndpointString - <> ", certificates=Issuer: CN=accounts.accesscontrol.windows.net; Subject: CN=accounts.accesscontrol.windows.net; SHA1 Fingerprint: 15:28:A6:B8:5A:C5:36:80:B4:B0:95:C6:9A:FD:77:9C:D6:5C:78:37" - <> "\n" - ) - - (logs, _res) <- interpretWithLoggingMock (Just user) $ do - idp <- idpCreate multiIngressSamlConfig tid zUser miHost1 idPMetadataInfo' Nothing apiVersionV2 idpHandle - idpUpdate multiIngressSamlConfig zUser miHost1 idPMetadataInfo' (idp._idpId) Nothing - logs `shouldContain` [expectedLogLine] - - it "should log IdP update with changed domain for multi-ingress" $ do - idPMetadataInfo :: IdPMetadataInfo <- generate arbitrary - user :: User <- generate arbitrary - let idPMetadataInfo' = - idPMetadataInfo - { _idpMetadataRecord = - (idPMetadataInfo._idpMetadataRecord) - { SAML._edIssuer = issuer, - SAML._edRequestURI = idpEndpoint - } - } - - expectedLogLine = - ( Info, - "IdP updated, team=" - <> (TL.encodeUtf8 . TL.fromStrict . idToText) tid - <> ", idpId=00000000-0000-0000-0000-000000000000, issuer=" - <> fromString issuerString - <> ", old-domain=" - <> (TL.encodeUtf8 . TL.fromStrict) miHost1AsText - <> ", new-domain=" - <> (TL.encodeUtf8 . TL.fromStrict) miHost2AsText - <> ", user=" - <> (TL.encodeUtf8 . TL.fromStrict . idToText . fromJust) zUser - <> ", idp-endpoint=" - <> fromString idpEndpointString - <> ", certificates=Issuer: CN=accounts.accesscontrol.windows.net; Subject: CN=accounts.accesscontrol.windows.net; SHA1 Fingerprint: 15:28:A6:B8:5A:C5:36:80:B4:B0:95:C6:9A:FD:77:9C:D6:5C:78:37" - <> "\n" - ) - - (logs, _res) <- interpretWithLoggingMock (Just user) $ do - idp <- idpCreate multiIngressSamlConfig tid zUser miHost1 idPMetadataInfo' Nothing apiVersionV2 idpHandle - idpUpdate multiIngressSamlConfig zUser miHost2 idPMetadataInfo' (idp._idpId) Nothing - logs `shouldContain` [expectedLogLine] - - it "should log IdP update (changed cert)" $ do - idPMetadataInfo :: IdPMetadataInfo <- generate arbitrary - user :: User <- generate arbitrary - newKeyInfo <- readSampleIO "okta-keyinfo-1.xml" - let newIssuerString = "https://new.idp.example.com/auth" - newIssuer = Issuer . (either (error . show) id) . parseURI strictURIParserOptions . fromString $ newIssuerString - newIdpEndpointString = "https://new.idp.example.com/login" - newRequestURI = either (error . show) id . parseURI strictURIParserOptions . fromString $ newIdpEndpointString - idPMetadataInfo' = - idPMetadataInfo - { _idpMetadataRecord = - (idPMetadataInfo._idpMetadataRecord) - { SAML._edIssuer = issuer, - SAML._edRequestURI = idpEndpoint - } - } - - newCert = either (error . show) id $ DSig.parseKeyInfo False newKeyInfo - newIdPMetadata :: IdPMetadata = - IdPMetadata - { _edIssuer = newIssuer, - _edRequestURI = newRequestURI, - _edCertAuthnResponse = NonEmptyL.singleton newCert - } - idPMetadataInfo'' = IdPMetadataValue ((TL.toStrict . encode) newIdPMetadata) newIdPMetadata - expectedLogLine = - ( Info, - "IdP updated, team=" - <> (TL.encodeUtf8 . TL.fromStrict . idToText) tid - <> ", idpId=00000000-0000-0000-0000-000000000000" - <> ", old-issuer=" - <> fromString issuerString - <> ", new-issuer=" - <> fromString newIssuerString - <> ", domain=None, user=" - <> (TL.encodeUtf8 . TL.fromStrict . idToText . fromJust) zUser - <> ", old-idp-endpoint=" - <> fromString idpEndpointString - <> ", new-idp-endpoint=" - <> fromString newIdpEndpointString - <> ", certificates=Issuer: Country=US,O=Okta,OU=SSOProvider,CN=dev-500508,Email Address=info@okta.com; Subject: Country=US,O=Okta,OU=SSOProvider,CN=dev-500508,Email Address=info@okta.com; SHA1 Fingerprint: 5C:42:5B:27:B3:96:CC:9D:1B:1F:0E:4F:2B:8A:B8:E4:3C:9E:96:34" - <> ", new-certificates=Issuer: Country=US,O=Okta,OU=SSOProvider,CN=dev-500508,Email Address=info@okta.com; Subject: Country=US,O=Okta,OU=SSOProvider,CN=dev-500508,Email Address=info@okta.com; SHA1 Fingerprint: 5C:42:5B:27:B3:96:CC:9D:1B:1F:0E:4F:2B:8A:B8:E4:3C:9E:96:34" - <> ", removed-certificates=Issuer: CN=accounts.accesscontrol.windows.net; Subject: CN=accounts.accesscontrol.windows.net; SHA1 Fingerprint: 15:28:A6:B8:5A:C5:36:80:B4:B0:95:C6:9A:FD:77:9C:D6:5C:78:37" - <> "\n" - ) - - (logs, _res) <- interpretWithLoggingMock (Just user) $ do - idp <- idpCreate singleIngressSamlConfig tid zUser host idPMetadataInfo' Nothing apiVersionV2 idpHandle - idpUpdate singleIngressSamlConfig zUser host idPMetadataInfo'' (idp._idpId) Nothing - logs `shouldContain` [expectedLogLine] + it "should log IdP deletion with domain for multi-ingress" $ do + idPMetadataInfo :: IdPMetadataInfo <- generate arbitrary + user :: User <- generate arbitrary + let idPMetadataInfo' = + idPMetadataInfo + { _idpMetadataRecord = + (idPMetadataInfo._idpMetadataRecord) + { SAML._edIssuer = issuer, + SAML._edRequestURI = idpEndpoint + } + } + + expectedLogLine = + ( Info, + "IdP deleted, team=" + <> (TL.encodeUtf8 . TL.fromStrict . idToText) tid + <> ", idpId=00000000-0000-0000-0000-000000000000, issuer=" + <> fromString issuerString + <> ", domain=" + <> (TL.encodeUtf8 . TL.fromStrict) miHost1AsText + <> ", user=" + <> (TL.encodeUtf8 . TL.fromStrict . idToText . fromJust) zUser + <> ", certificates=Issuer: CN=accounts.accesscontrol.windows.net; Subject: CN=accounts.accesscontrol.windows.net; SHA1 Fingerprint: 15:28:A6:B8:5A:C5:36:80:B4:B0:95:C6:9A:FD:77:9C:D6:5C:78:37" + <> ", idp-endpoint=" + <> fromString idpEndpointString + <> "\n" + ) + + (logs, _notifs, _res) <- interpretWithLoggingMock (Just user) $ do + idp <- idpCreate multiIngressSamlConfig tid zUser miHost1 idPMetadataInfo' Nothing apiVersionV2 idpHandle + idpDelete multiIngressSamlConfig zUser (idp._idpId) Nothing + logs `shouldContain` [expectedLogLine] + + describe "idp-update" $ do + it "should log IdP update" $ do + idPMetadataInfo :: IdPMetadataInfo <- generate arbitrary + user :: User <- generate arbitrary + let idPMetadataInfo' = + idPMetadataInfo + { _idpMetadataRecord = + (idPMetadataInfo._idpMetadataRecord) + { SAML._edIssuer = issuer, + SAML._edRequestURI = idpEndpoint + } + } + + expectedLogLine = + ( Info, + "IdP updated, team=" + <> (TL.encodeUtf8 . TL.fromStrict . idToText) tid + <> ", idpId=00000000-0000-0000-0000-000000000000, issuer=" + <> fromString issuerString + <> ", domain=None, user=" + <> (TL.encodeUtf8 . TL.fromStrict . idToText . fromJust) zUser + <> ", idp-endpoint=" + <> fromString idpEndpointString + <> ", certificates=Issuer: CN=accounts.accesscontrol.windows.net; Subject: CN=accounts.accesscontrol.windows.net; SHA1 Fingerprint: 15:28:A6:B8:5A:C5:36:80:B4:B0:95:C6:9A:FD:77:9C:D6:5C:78:37" + <> "\n" + ) + + (logs, _notifs, _res) <- interpretWithLoggingMock (Just user) $ do + idp <- idpCreate singleIngressSamlConfig tid zUser host idPMetadataInfo' Nothing apiVersionV2 idpHandle + idpUpdate singleIngressSamlConfig zUser host idPMetadataInfo' (idp._idpId) Nothing + logs `shouldContain` [expectedLogLine] + + it "should log IdP update with domain for multi-ingress" $ do + idPMetadataInfo :: IdPMetadataInfo <- generate arbitrary + user :: User <- generate arbitrary + let idPMetadataInfo' = + idPMetadataInfo + { _idpMetadataRecord = + (idPMetadataInfo._idpMetadataRecord) + { SAML._edIssuer = issuer, + SAML._edRequestURI = idpEndpoint + } + } + + expectedLogLine = + ( Info, + "IdP updated, team=" + <> (TL.encodeUtf8 . TL.fromStrict . idToText) tid + <> ", idpId=00000000-0000-0000-0000-000000000000, issuer=" + <> fromString issuerString + <> ", domain=" + <> (TL.encodeUtf8 . TL.fromStrict) miHost1AsText + <> ", user=" + <> (TL.encodeUtf8 . TL.fromStrict . idToText . fromJust) zUser + <> ", idp-endpoint=" + <> fromString idpEndpointString + <> ", certificates=Issuer: CN=accounts.accesscontrol.windows.net; Subject: CN=accounts.accesscontrol.windows.net; SHA1 Fingerprint: 15:28:A6:B8:5A:C5:36:80:B4:B0:95:C6:9A:FD:77:9C:D6:5C:78:37" + <> "\n" + ) + + (logs, _notifs, _res) <- interpretWithLoggingMock (Just user) $ do + idp <- idpCreate multiIngressSamlConfig tid zUser miHost1 idPMetadataInfo' Nothing apiVersionV2 idpHandle + idpUpdate multiIngressSamlConfig zUser miHost1 idPMetadataInfo' (idp._idpId) Nothing + logs `shouldContain` [expectedLogLine] + + it "should log IdP update with changed domain for multi-ingress" $ do + idPMetadataInfo :: IdPMetadataInfo <- generate arbitrary + user :: User <- generate arbitrary + let idPMetadataInfo' = + idPMetadataInfo + { _idpMetadataRecord = + (idPMetadataInfo._idpMetadataRecord) + { SAML._edIssuer = issuer, + SAML._edRequestURI = idpEndpoint + } + } + + expectedLogLine = + ( Info, + "IdP updated, team=" + <> (TL.encodeUtf8 . TL.fromStrict . idToText) tid + <> ", idpId=00000000-0000-0000-0000-000000000000, issuer=" + <> fromString issuerString + <> ", old-domain=" + <> (TL.encodeUtf8 . TL.fromStrict) miHost1AsText + <> ", new-domain=" + <> (TL.encodeUtf8 . TL.fromStrict) miHost2AsText + <> ", user=" + <> (TL.encodeUtf8 . TL.fromStrict . idToText . fromJust) zUser + <> ", idp-endpoint=" + <> fromString idpEndpointString + <> ", certificates=Issuer: CN=accounts.accesscontrol.windows.net; Subject: CN=accounts.accesscontrol.windows.net; SHA1 Fingerprint: 15:28:A6:B8:5A:C5:36:80:B4:B0:95:C6:9A:FD:77:9C:D6:5C:78:37" + <> "\n" + ) + + (logs, _notifs, _res) <- interpretWithLoggingMock (Just user) $ do + idp <- idpCreate multiIngressSamlConfig tid zUser miHost1 idPMetadataInfo' Nothing apiVersionV2 idpHandle + idpUpdate multiIngressSamlConfig zUser miHost2 idPMetadataInfo' (idp._idpId) Nothing + logs `shouldContain` [expectedLogLine] + + it "should log IdP update (changed cert)" $ do + idPMetadataInfo :: IdPMetadataInfo <- generate arbitrary + user :: User <- generate arbitrary + newKeyInfo <- readSampleIO "okta-keyinfo-1.xml" + let newIssuerString = "https://new.idp.example.com/auth" + newIssuer = Issuer . (either (error . show) id) . parseURI strictURIParserOptions . fromString $ newIssuerString + newIdpEndpointString = "https://new.idp.example.com/login" + newRequestURI = either (error . show) id . parseURI strictURIParserOptions . fromString $ newIdpEndpointString + idPMetadataInfo' = + idPMetadataInfo + { _idpMetadataRecord = + (idPMetadataInfo._idpMetadataRecord) + { SAML._edIssuer = issuer, + SAML._edRequestURI = idpEndpoint + } + } + + newCert = either (error . show) id $ DSig.parseKeyInfo False newKeyInfo + newIdPMetadata :: IdPMetadata = + IdPMetadata + { _edIssuer = newIssuer, + _edRequestURI = newRequestURI, + _edCertAuthnResponse = NonEmptyL.singleton newCert + } + idPMetadataInfo'' = IdPMetadataValue ((TL.toStrict . encode) newIdPMetadata) newIdPMetadata + expectedLogLine = + ( Info, + "IdP updated, team=" + <> (TL.encodeUtf8 . TL.fromStrict . idToText) tid + <> ", idpId=00000000-0000-0000-0000-000000000000" + <> ", old-issuer=" + <> fromString issuerString + <> ", new-issuer=" + <> fromString newIssuerString + <> ", domain=None, user=" + <> (TL.encodeUtf8 . TL.fromStrict . idToText . fromJust) zUser + <> ", old-idp-endpoint=" + <> fromString idpEndpointString + <> ", new-idp-endpoint=" + <> fromString newIdpEndpointString + <> ", certificates=Issuer: Country=US,O=Okta,OU=SSOProvider,CN=dev-500508,Email Address=info@okta.com; Subject: Country=US,O=Okta,OU=SSOProvider,CN=dev-500508,Email Address=info@okta.com; SHA1 Fingerprint: 5C:42:5B:27:B3:96:CC:9D:1B:1F:0E:4F:2B:8A:B8:E4:3C:9E:96:34" + <> ", new-certificates=Issuer: Country=US,O=Okta,OU=SSOProvider,CN=dev-500508,Email Address=info@okta.com; Subject: Country=US,O=Okta,OU=SSOProvider,CN=dev-500508,Email Address=info@okta.com; SHA1 Fingerprint: 5C:42:5B:27:B3:96:CC:9D:1B:1F:0E:4F:2B:8A:B8:E4:3C:9E:96:34" + <> ", removed-certificates=Issuer: CN=accounts.accesscontrol.windows.net; Subject: CN=accounts.accesscontrol.windows.net; SHA1 Fingerprint: 15:28:A6:B8:5A:C5:36:80:B4:B0:95:C6:9A:FD:77:9C:D6:5C:78:37" + <> "\n" + ) + + (logs, _notifs, _res) <- interpretWithLoggingMock (Just user) $ do + idp <- idpCreate singleIngressSamlConfig tid zUser host idPMetadataInfo' Nothing apiVersionV2 idpHandle + idpUpdate singleIngressSamlConfig zUser host idPMetadataInfo'' (idp._idpId) Nothing + logs `shouldContain` [expectedLogLine] + describe "SAML IdP change notification emails" $ do + context "when multi-ingress is configured" $ do + describe "idp-create" $ do + it "should send" $ do + idPMetadataInfo :: IdPMetadataInfo <- generate arbitrary + + forM_ [(minBound :: WireIdPAPIVersion) .. maxBound] $ \apiVersion -> do + (_logs, notifs, idp) <- + interpretWithLoggingMock + Nothing + (idpCreate multiIngressSamlConfig tid zUser miHost1 idPMetadataInfo Nothing (Just apiVersion) idpHandle) + notifs `shouldBe` [IdPCreated zUser idp] + + -- >=V7 does not bother with multi-ingress domains for IdPs as it can + -- only have one IdP per team anyways. + (_logs, notifsV7, idpV7) <- + interpretWithLoggingMock + Nothing + (idpCreateV7 multiIngressSamlConfig tid zUser idPMetadataInfo Nothing (Just apiVersion) idpHandle) + notifsV7 `shouldBe` [IdPCreated zUser idpV7] + it "should send without zUser if none is given" $ do + idPMetadataInfo :: IdPMetadataInfo <- generate arbitrary + + forM_ [(minBound :: WireIdPAPIVersion) .. maxBound] $ \apiVersion -> do + (_logs, notifs, idp) <- + interpretWithLoggingMock + Nothing + (idpCreate multiIngressSamlConfig tid Nothing miHost1 idPMetadataInfo Nothing (Just apiVersion) idpHandle) + notifs `shouldBe` [IdPCreated Nothing idp] + + -- >=V7 does not bother with multi-ingress domains for IdPs as it can + -- only have one IdP per team anyways. + (_logs, notifsV7, idpV7) <- + interpretWithLoggingMock + Nothing + (idpCreateV7 multiIngressSamlConfig tid Nothing idPMetadataInfo Nothing (Just apiVersion) idpHandle) + notifsV7 `shouldBe` [IdPCreated Nothing idpV7] + describe "idp-delete" $ do + it "should send" $ do + idPMetadataInfo :: IdPMetadataInfo <- generate arbitrary + user :: User <- generate arbitrary + + (_logs, notifs, idp) <- interpretWithLoggingMock (Just user) $ do + idp <- idpCreate multiIngressSamlConfig tid zUser miHost1 idPMetadataInfo Nothing apiVersionV2 idpHandle + void $ idpDelete multiIngressSamlConfig zUser (idp._idpId) Nothing + pure idp + notifs `shouldBe` [IdPDeleted (fromJust zUser) idp, IdPCreated zUser idp] + describe "idp-update" $ do + it "should send" $ do + idPMetadataInfo :: IdPMetadataInfo <- generate arbitrary + user :: User <- generate arbitrary + + (_logs, notifs, (oldIdP, newIdP)) <- interpretWithLoggingMock (Just user) $ do + idp <- idpCreate multiIngressSamlConfig tid zUser miHost1 idPMetadataInfo Nothing apiVersionV2 idpHandle + updatedIdP <- idpUpdate multiIngressSamlConfig zUser miHost1 idPMetadataInfo (idp._idpId) Nothing + pure (idp, updatedIdP) + notifs `shouldBe` [IdPUpdated (fromJust zUser) oldIdP newIdP, IdPCreated zUser oldIdP] + + context "when multi-ingress is NOT configured (common case)" $ do + describe "idp-create" $ do + it "should send" $ do + idPMetadataInfo :: IdPMetadataInfo <- generate arbitrary + + forM_ [(minBound :: WireIdPAPIVersion) .. maxBound] $ \apiVersion -> do + (_logs, notifs, _idp) <- + interpretWithLoggingMock + Nothing + (idpCreate singleIngressSamlConfig tid zUser miHost1 idPMetadataInfo Nothing (Just apiVersion) idpHandle) + notifs `shouldBe` mempty + + -- >=V7 does not bother with multi-ingress domains for IdPs as it can + -- only have one IdP per team anyways. + (_logs, notifsV7, _idp) <- + interpretWithLoggingMock + Nothing + (idpCreateV7 singleIngressSamlConfig tid zUser idPMetadataInfo Nothing (Just apiVersion) idpHandle) + notifsV7 `shouldBe` mempty + describe "idp-delete" $ do + it "should send" $ do + idPMetadataInfo :: IdPMetadataInfo <- generate arbitrary + user :: User <- generate arbitrary + + (_logs, notifs, _) <- interpretWithLoggingMock (Just user) $ do + idp <- idpCreate singleIngressSamlConfig tid zUser miHost1 idPMetadataInfo Nothing apiVersionV2 idpHandle + idpDelete singleIngressSamlConfig zUser (idp._idpId) Nothing + notifs `shouldBe` mempty + describe "idp-update" $ do + it "should send" $ do + idPMetadataInfo :: IdPMetadataInfo <- generate arbitrary + user :: User <- generate arbitrary + + (_logs, notifs, _) <- interpretWithLoggingMock (Just user) $ do + idp <- idpCreate singleIngressSamlConfig tid zUser miHost1 idPMetadataInfo Nothing apiVersionV2 idpHandle + idpUpdate singleIngressSamlConfig zUser miHost1 idPMetadataInfo (idp._idpId) Nothing + notifs `shouldBe` mempty type LogLine = (Level, LByteString) interpretWithLoggingMock :: Maybe User -> Sem (Effs) a -> - IO ([LogLine], a) + IO ([LogLine], [IdpChangedNotification], a) interpretWithLoggingMock mbAccount action = do lr <- newLogRecorder a <- @@ -419,7 +517,8 @@ interpretWithLoggingMock mbAccount action = do . randomToNull $ action logs <- readIORef lr.recordedLogs - pure (logs, either (error . show) id a) + let (notifs, res) = either (error . show) id a + pure (logs, notifs, res) galleyAccessMock :: Sem (GalleyAccess ': r) a -> Sem r a galleyAccessMock = interpret $ \case @@ -430,30 +529,32 @@ galleyAccessMock = interpret $ \case IsEmailValidationEnabledTeam _teamId -> undefined UpdateTeamMember _userId _teamId _role -> undefined -brigAccessMock :: Maybe User -> Sem (BrigAccess ': r) a -> Sem r a -brigAccessMock mbAccount = interpret $ \case - CreateSAML _userRef _userId _teamId _name _managedBy _mHandle _mRichInfo _mLocale _role -> undefined - CreateNoSAML _txt _email _userId _teamId _name _mLocale _role -> undefined - UpdateEmail _userId _email _activation -> undefined - GetAccount _havePendingInvitations _userId -> pure mbAccount - GetByHandle _handle -> undefined - GetByEmail _email -> undefined - SetName _userId _name -> undefined - SetHandle _userId _handle -> undefined - SetManagedBy _userId _managedBy -> undefined - SetSSOId _userId _ssoId -> undefined - SetRichInfo _userId _richInfo -> undefined - SetLocale _userId _mLocale -> undefined - GetRichInfo _userId -> undefined - CheckHandleAvailable _handle -> undefined - DeleteUser _userId -> undefined - EnsureReAuthorised _mUserId _mPassword _mCode _mAction -> undefined - SsoLogin _userId -> undefined - GetStatus _userId -> undefined - GetStatusMaybe _userId -> undefined - SetStatus _userId _status -> undefined - GetDefaultUserLocale -> undefined - CheckAdminGetTeamId _userId -> undefined +brigAccessMock :: Maybe User -> Sem (BrigAccess ': r) a -> Sem r ([IdpChangedNotification], a) +brigAccessMock mbAccount = (runState @([IdpChangedNotification]) mempty .) $ + reinterpret $ \case + CreateSAML _userRef _userId _teamId _name _managedBy _mHandle _mRichInfo _mLocale _role -> undefined + CreateNoSAML _txt _email _userId _teamId _name _mLocale _role -> undefined + UpdateEmail _userId _email _activation -> undefined + GetAccount _havePendingInvitations _userId -> pure mbAccount + GetByHandle _handle -> undefined + GetByEmail _email -> undefined + SetName _userId _name -> undefined + SetHandle _userId _handle -> undefined + SetManagedBy _userId _managedBy -> undefined + SetSSOId _userId _ssoId -> undefined + SetRichInfo _userId _richInfo -> undefined + SetLocale _userId _mLocale -> undefined + GetRichInfo _userId -> undefined + CheckHandleAvailable _handle -> undefined + DeleteUser _userId -> undefined + EnsureReAuthorised _mUserId _mPassword _mCode _mAction -> undefined + SsoLogin _userId -> undefined + GetStatus _userId -> undefined + GetStatusMaybe _userId -> undefined + SetStatus _userId _status -> undefined + GetDefaultUserLocale -> undefined + CheckAdminGetTeamId _userId -> undefined + SendSAMLIdPChangedEmail notif -> modify (notif :) ignoringState :: (Functor f) => (a -> f (c, b)) -> a -> f b ignoringState f = fmap snd . f