Skip to content
Draft
Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
60 commits
Select commit Hold shift + click to select a range
b5869e0
Import changes of #4926
supersven Jan 21, 2026
bc79be2
Add missing case to mock
supersven Jan 21, 2026
f66a2cb
Prepare to assert notifications
supersven Jan 21, 2026
7baf06e
Add test for mi idpCreate
supersven Jan 21, 2026
d58d0cb
Add mi delete test
supersven Jan 21, 2026
a3997ac
Add mi update test
supersven Jan 21, 2026
b3f78ff
Implement the single ingress case
supersven Jan 21, 2026
a909b75
Add initiating user to message
supersven Jan 22, 2026
a477010
Drop unnecessary UserId Maybes
supersven Jan 22, 2026
f94a869
Add test when Maybe UserId is empty for idpCreate
supersven Jan 22, 2026
7842ad3
Add email (draft) templates
supersven Jan 22, 2026
29d4d74
fill email template
supersven Jan 22, 2026
7d17ba6
Add TODO
supersven Jan 22, 2026
c9262ba
Update email templates
supersven Jan 22, 2026
98535ab
Add unit test for certDescription
supersven Jan 22, 2026
f2b961c
Update templates
supersven Jan 26, 2026
de91711
Move template localization to EmailSubsystem
supersven Jan 26, 2026
5e2c2e8
Snake case templates
supersven Jan 26, 2026
c0742ef
SAMLEmailSubsystem InterpreterSpec
supersven Jan 23, 2026
d236eac
Cleanup
supersven Jan 27, 2026
88272a4
Fix fingerprint
supersven Jan 27, 2026
321ea5f
Configure IdPConfigChangeEmailTemplate
supersven Jan 27, 2026
3956ae0
Initialize test team templates with prod code
supersven Jan 27, 2026
fa10146
Refactor
supersven Jan 27, 2026
5991e9d
Update German templates
supersven Jan 27, 2026
79f5a49
Test locals
supersven Jan 27, 2026
78ef42b
Extract test data to files
supersven Jan 27, 2026
ec251af
Reduce duplication
supersven Jan 27, 2026
1bbf494
Extract assertCommmonMailAttributes
supersven Jan 27, 2026
d2753c7
Extract assertMailTextPartWithFile
supersven Jan 27, 2026
9e49465
Reduce duplication
supersven Jan 27, 2026
8a1a1e4
Reduce duplication
supersven Jan 27, 2026
2929da0
Formatting
supersven Jan 27, 2026
f40d874
Fix locale string
supersven Jan 27, 2026
5cf9396
WIP: Update test
supersven Jan 27, 2026
c505bbf
Test update
supersven Jan 27, 2026
5275938
Update certs
supersven Jan 27, 2026
2549a67
Speed up test
supersven Jan 27, 2026
1df3ffd
Cleanup templates folder
supersven Jan 28, 2026
8d5af48
Update German templates
supersven Jan 28, 2026
5dca7e7
Test with German Templates
supersven Jan 28, 2026
83f8df9
Add test to send not send to usual members
supersven Jan 28, 2026
aa4da6f
Test allowed receivers
supersven Jan 28, 2026
de342f5
Delete done TODO
supersven Jan 28, 2026
b2204f7
Test multiple receivers
supersven Jan 28, 2026
98c6f45
Add property tests to excercise the logic a bit more
supersven Jan 28, 2026
581c317
Cleanup
supersven Jan 28, 2026
353cf4d
Same assertions levels
supersven Jan 28, 2026
6fc7af7
Fix scopes of bindings
supersven Jan 28, 2026
eebd7ad
Add changelog
supersven Jan 28, 2026
afcc4bf
Rename: IdPDescription -> IdPDetails
supersven Jan 28, 2026
ce9bc06
Move function down in file
supersven Jan 28, 2026
c92c3a5
Remove re-exports of Brig.Template
supersven Jan 28, 2026
4cb4f24
Delete now used action
supersven Jan 28, 2026
3e9bb52
Replace trivial lens usage
supersven Jan 28, 2026
9a1324a
Remove obsolete type
supersven Jan 28, 2026
bf876ad
Add missing action to noop interpreter
supersven Jan 28, 2026
b2be718
Remove superfluos data type
supersven Jan 28, 2026
f47d6bc
Fix empty newlines in text mails
supersven Jan 28, 2026
4407ad5
Fix typo
supersven Jan 28, 2026
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
3 changes: 3 additions & 0 deletions changelog.d/2-features/send-email-on-idp-change
Original file line number Diff line number Diff line 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.
37 changes: 27 additions & 10 deletions libs/extended/src/Data/X509/Extended.hs
Original file line number Diff line number Diff line change
@@ -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
Expand All @@ -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) =
Expand Down
42 changes: 37 additions & 5 deletions libs/extended/test/Test/Data/X509/ExtendedSpec.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
2 changes: 2 additions & 0 deletions libs/saml2-web-sso/default.nix
Original file line number Diff line number Diff line change
Expand Up @@ -48,6 +48,7 @@
, memory
, mtl
, network-uri
, openapi3
, pretty-show
, process
, QuickCheck
Expand Down Expand Up @@ -127,6 +128,7 @@ mkDerivation {
memory
mtl
network-uri
openapi3
pretty-show
process
QuickCheck
Expand Down
1 change: 1 addition & 0 deletions libs/saml2-web-sso/saml2-web-sso.cabal
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
4 changes: 4 additions & 0 deletions libs/saml2-web-sso/src/SAML2/WebSSO/Config.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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

Expand Down
28 changes: 23 additions & 5 deletions libs/saml2-web-sso/src/SAML2/WebSSO/Orphans.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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)
Expand All @@ -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.
Expand Down Expand Up @@ -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
62 changes: 41 additions & 21 deletions libs/saml2-web-sso/src/SAML2/WebSSO/Types.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand All @@ -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)
Expand Down Expand Up @@ -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]
Expand Down Expand Up @@ -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 ()

Expand All @@ -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
Expand Down Expand Up @@ -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

Expand Down
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
Loading